#!/usr/bin/perl
#
# Copyright (c) 1996, 1997, 1998 Shigio Yamaguchi. All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
# 3. All advertising materials mentioning features or use of this software
# must display the following acknowledgement:
# This product includes software developed by Shigio Yamaguchi.
# 4. Neither the name of the author nor the names of any co-contributors
# may be used to endorse or promote products derived from this software
# without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#
# htags.pl 10-Nov-98
#
$com = $0;
$com =~ s/.*\///;
$usage = "usage: $com [-a][-c][-f][-h][-l][-n][-v][-w][-t title][-d tagdir][dir]\n";
#-------------------------------------------------------------------------
# COMMAND EXISTENCE CHECK
#-------------------------------------------------------------------------
foreach $c ('sort', 'gtags', 'global', 'btreeop') {
if (!&'usable($c)) {
&'error("'$c' command is required but not found.");
}
}
#-------------------------------------------------------------------------
# CONFIGURATION
#-------------------------------------------------------------------------
# temporary directory
$'tmp = '/tmp';
if (defined($ENV{'TMPDIR'}) && -d $ENV{'TMPDIR'}) {
$tmp = $ENV{'TMPDIR'};
}
$'ncol = 4; # columns of line number
$'tabs = 8; # tab skip
$'gzipped_suffix = 'ghtml'; # suffix of gzipped html file
#
# font
#
$'title_begin = '';
$'title_end = '';
$'comment_begin = ''; # /* ... */
$'comment_end = '';
$'sharp_begin = ''; # #define, #include or so on
$'sharp_end = '';
$'brace_begin = ''; # { ... }
$'brace_end = '';
$'reserved_begin = ''; # if, while, for or so on
$'reserved_end = '';
#
# color
#
$'body_bgcolor = '';
$'body_text = '';
$'body_link = '';
$'body_vlink = '';
$'body_alink = '';
#
# Reserved words for C and Java are hard coded.
# (configuration parameter 'reserved_words' was deleted.)
#
$'c_reserved_words = "auto,break,case,char,continue,default,do,double,else," .
"extern,float,for,goto,if,int,long,register,return," .
"short,sizeof,static,struct,switch,typedef,union," .
"unsigned,void,while";
$'java_reserved_words = "abstract,boolean,break,byte,case,catch,char,class," .
"const,continue,default,do,double,else,extends,false," .
"final,finally,float,for,goto,if,implements,import," .
"instanceof,int,interface,long,native,new,null," .
"package,private,protected,public,return,short," .
"static,super,switch,synchronized,this,throw,throws," .
"union,transient,true,try,void,volatile,while";
$'c_reserved_words =~ s/,/|/g;
$'java_reserved_words =~ s/,/|/g;
#
# read values from global.conf
#
chop($config = `gtags --config`);
if ($config) {
if ($var1 = &'getconf('ncol')) {
if ($var1 < 1 || $var1 > 10) {
print STDERR "Warning: parameter 'ncol' ignored becase the value is too large or too small.\n";
} else {
$ncol = $var1;
}
}
if ($var1 = &'getconf('tabs')) {
if ($var1 < 1 || $var1 > 32) {
print STDERR "Warning: parameter 'tabs' ignored becase the value is too large or too small.\n";
} else {
$tabs = $var1;
}
}
if ($var1 = &'getconf('gzipped_suffix')) {
$gzipped_suffix = $var1;
}
if (($var1 = &'getconf('title_begin')) && ($var2 = &'getconf('title_end'))) {
$title_begin = $var1;
$title_end = $var2;
}
if (($var1 = &'getconf('comment_begin')) && ($var2 = &'getconf('comment_end'))) {
$comment_begin = $var1;
$comment_end = $var2;
}
if (($var1 = &'getconf('sharp_begin')) && ($var2 = &'getconf('sharp_end'))) {
$sharp_begin = $var1;
$sharp_end = $var2;
}
if (($var1 = &'getconf('brace_begin')) && ($var2 = &'getconf('brace_end'))) {
$brace_begin = $var1;
$brace_end = $var2;
}
if (($var1 = &'getconf('reserved_begin')) && ($var2 = &'getconf('reserved_end'))) {
$reserved_begin = $var1;
$reserved_end = $var2;
}
$body_bgcolor = $var1 if ($var1 = &'getconf('bgcolor'));
$body_text = $var1 if ($var1 = &'getconf('text'));
$body_link = $var1 if ($var1 = &'getconf('link'));
$body_vlink = $var1 if ($var1 = &'getconf('vlink'));
$body_alink = $var1 if ($var1 = &'getconf('alink'));
}
# HTML tag
$'begin_html = "\n";
$'end_html = "\n";
$'begin_body = '
\n";
#-------------------------------------------------------------------------
# DEFINITION
#-------------------------------------------------------------------------
# unit for a path
$'SEP = ' '; # source file path must not include $SEP charactor
$'ESCSEP = &'escape($SEP);
$'SRCS = 'S';
$'DEFS = 'D';
$'REFS = 'R';
$'INCS = 'I';
#-------------------------------------------------------------------------
# JAVASCRIPT PARTS
#-------------------------------------------------------------------------
# escaped angle
$'langle = sprintf("unescape('%s')", &'escape('<'));
$'rangle = sprintf("unescape('%s')", &'escape('>'));
$'begin_script="\n";
$'default_view=
"// if your browser doesn't support javascript, write a BASE tag statically.\n" .
"if (parent.frames.length)\n" .
" document.write($langle+'BASE TARGET=mains'+$rangle)\n";
$'rewrite_href_funcs =
"if (parent.frames.length && parent.funcs == self) {\n" .
" document.links[0].href = '../funcs.html';\n" .
" document.links[document.links.length - 1].href = '../funcs.html';\n" .
"}\n";
$'rewrite_href_files =
"if (parent.frames.length && parent.files == self) {\n" .
" document.links[0].href = '../files.html';\n" .
" document.links[document.links.length - 1].href = '../files.html';\n" .
"}\n";
sub set_header {
local($display, $title, $script) = @_;
local($head) = "$title";
if ($script || ($'hflag && $display)) {
$head .= "\n";
$head .= $'begin_script;
$head .= $script if ($script);
if ($'hflag && $display) {
$title = '[' . $title . ']' if ($title);
$head .= "if (parent.frames.length && parent.mains == self) {\n";
$head .= " parent.title.document.open();\n";
$head .= " parent.title.document.write('$title
');\n";
$head .= " parent.title.document.close();\n";
$head .= "}\n";
}
$head .= $'end_script;
}
$head .= "\n";
$head;
}
#-------------------------------------------------------------------------
# UTIRITIES
#-------------------------------------------------------------------------
sub getcwd {
local($dir) = `/bin/pwd`;
chop($dir);
$dir;
}
sub realpath {
local($dir) = @_;
local($cwd) = &getcwd;
chdir($dir) || &'error("cannot change directory '$dir'.");
local($new) = &getcwd;
chdir($cwd) || &'error("cannot recover current directory '$cwd'.");
$new;
}
sub date {
local($date) = `date`;
chop($date);
$date;
}
sub error {
&clean();
printf STDERR "$com: $_[0]\n";
exit 1;
}
sub clean {
&anchor'finish();
&cache'close();
}
sub escape {
local($c) = @_;
'%' . sprintf("%x", ord($c));
}
sub usable {
local($command) = @_;
foreach (split(/:/, $ENV{'PATH'})) {
return 1 if (-x "$_/$command");
}
return 0;
}
sub copy {
local($from, $to) = @_;
local($ret) = system("cp $from $to");
$ret = $ret / 256;
$ret = ($ret == 0) ? 1 : 0;
$ret;
}
sub getconf {
local($name) = @_;
local($val);
chop($val = `gtags --config $name`);
if ($? != 0) { $val = ''; }
$val;
}
sub path2file {
local($path) = @_;
$path =~ s/^\.\///;
$path =~ s!/!$'SEP!g;
$path . '.' . $'HTML;
}
sub path2url {
local($path) = @_;
$path =~ s/^\.\///;
$path =~ s!/!$'ESCSEP!g;
$path . '.' . $'HTML;
}
#-------------------------------------------------------------------------
# PROCESS START
#-------------------------------------------------------------------------
#
# options check.
#
$'aflag = $'cflag = $'fflag = $'hflag = $'lflag = $'nflag = $'vflag = $'wflag = '';
while ($ARGV[0] =~ /^-/) {
$opt = shift;
if ($opt =~ /[^-acfhlnvwtd]/) {
print STDERR $usage;
exit 1;
}
if ($opt =~ /a/) { $'aflag = 'a'; }
if ($opt =~ /c/) { $'cflag = 'c'; }
if ($opt =~ /f/) { $'fflag = 'f'; }
if ($opt =~ /h/) { $'hflag = 'h'; }
if ($opt =~ /l/) { $'lflag = 'l'; }
if ($opt =~ /n/) { $'nflag = 'n'; }
if ($opt =~ /v/) { $'vflag = 'v'; }
if ($opt =~ /w/) { $'wflag = 'w'; }
if ($opt =~ /t/) {
$opt = shift;
last if ($opt eq '');
$title = $opt;
} elsif ($opt =~ /d/) {
$opt = shift;
last if ($opt eq '');
$dbpath = $opt;
}
}
if ($'cflag && !&'usable('gzip')) {
print STDERR "Warning: 'gzip' command not found. -c option ignored.\n";
$'cflag = '';
}
if (!$title) {
@cwd = split('/', &'getcwd);
$title = $cwd[$#cwd];
}
$dbpath = '.' if (!$dbpath);
unless (-r "$dbpath/GTAGS" && -r "$dbpath/GRTAGS") {
&'error("GTAGS and GRTAGS not found. Please make them.");
}
$dbpath = &'realpath($dbpath);
#
# for global(1)
#
$ENV{'GTAGSROOT'} = &'getcwd();
$ENV{'GTAGSDBPATH'} = $dbpath;
delete $ENV{'GTAGSLIBPATH'};
#
# check directories
#
$dist = &'getcwd() . '/HTML';
if ($ARGV[0]) {
$cwd = &'getcwd();
unless (-w $ARGV[0]) {
&'error("'$ARGV[0]' is not writable directory.");
}
chdir($ARGV[0]) || &'error("directory '$ARGV[0]' not found.");
$dist = &'getcwd() . '/HTML';
chdir($cwd) || &'error("cannot return to original directory.");
}
#
# find filter
#
$'findcom = "gtags --find";
#
# check if GTAGS, GRTAGS is the latest.
#
$gtags_ctime = (stat("$dbpath/GTAGS"))[10];
open(FIND, "$'findcom |") || &'error("cannot fork.");
while () {
chop;
if ($gtags_ctime < (stat($_))[10]) {
&'error("GTAGS is not the latest one. Please remake it.");
}
}
close(FIND);
if ($?) { &'error("cannot traverse directory."); }
#-------------------------------------------------------------------------
# MAKE FILES
#-------------------------------------------------------------------------
# HTML/cgi-bin/global.cgi ... CGI program (1)
# HTML/cgi-bin/ghtml.cgi ... unzip script (1)
# HTML/.htaccess.skel ... skelton of .htaccess (1)
# HTML/help.html ... help file (2)
# HTML/$REFS/* ... referencies (3)
# HTML/$DEFS/* ... definitions (3)
# HTML/funcs.html ... function index (4)
# HTML/funcs/* ... function index (4)
# HTML/files.html ... file index (5)
# HTML/files/* ... file index (5)
# HTML/index.html ... index file (6)
# HTML/mains.html ... main index (7)
# HTML/null.html ... main null html (7)
# HTML/$SRCS/ ... source files (8)
# HTML/$INCS/ ... include file index (9)
#-------------------------------------------------------------------------
$'HTML = ($'cflag) ? $gzipped_suffix : 'html';
print STDERR "[", &'date, "] ", "Htags started\n" if ($'vflag);
#
# (0) make directories
#
print STDERR "[", &'date, "] ", "(0) making directories ...\n" if ($'vflag);
mkdir($dist, 0777) || &'error("cannot make directory '$dist'.") if (! -d $dist);
foreach $d ($SRCS, $INCS, $DEFS, $REFS, files, funcs) {
mkdir("$dist/$d", 0775) || &'error("cannot make HTML directory") if (! -d "$dist/$d");
}
if ($'fflag || $'cflag) {
mkdir("$dist/cgi-bin", 0775) || &'error("cannot make cgi-bin directory") if (! -d "$dist/cgi-bin");
}
#
# (1) make CGI program
#
if ($'fflag) {
print STDERR "[", &'date, "] ", "(1) making CGI program ...\n" if ($'vflag);
&makeprogram("$dist/cgi-bin/global.cgi") || &'error("cannot make CGI program.");
chmod(0755, "$dist/cgi-bin/global.cgi") || &'error("cannot chmod CGI program.");
unlink("$dist/cgi-bin/GTAGS", "$dist/cgi-bin/GRTAGS", "$dist/cgi-bin/GPATH");
link("$dbpath/GTAGS", "$dist/cgi-bin/GTAGS") || &'copy("$dbpath/GTAGS", "$dist/cgi-bin/GTAGS") || &'error("cannot copy GTAGS.");
link("$dbpath/GRTAGS", "$dist/cgi-bin/GRTAGS") || &'copy("$dbpath/GRTAGS", "$dist/cgi-bin/GRTAGS") || &'error("cannot copy GRTAGS.");
link("$dbpath/GPATH", "$dist/cgi-bin/GPATH") || &'copy("$dbpath/GPATH", "$dist/cgi-bin/GPATH") || &'error("cannot copy GPATH.");
}
if ($'cflag) {
&makehtaccess("$dist/.htaccess.skel") || &'error("cannot make .htaccess skelton.");
&makeghtml("$dist/cgi-bin/ghtml.cgi") || &'error("cannot make unzip script.");
chmod(0755, "$dist/cgi-bin/ghtml.cgi") || &'error("cannot chmod unzip script.");
}
#
# (2) make help file
#
print STDERR "[", &'date, "] ", "(2) making help.html ...\n" if ($'vflag);
&makehelp("$dist/help.html");
#
# (3) make function entries ($DEFS/* and $REFS/*)
# MAKING TAG CACHE
#
print STDERR "[", &'date, "] ", "(3) making duplicate entries ...\n" if ($'vflag);
sub suddenly { &'clean(); exit 1}
$SIG{'INT'} = 'suddenly';
$SIG{'QUIT'} = 'suddenly';
$SIG{'TERM'} = 'suddenly';
&cache'open(100000);
$func_total = &makedupindex($dist);
print STDERR "Total $func_total functions.\n" if ($'vflag);
#
# (4) make function index (funcs.html and funcs/*)
# PRODUCE @funcs
#
print STDERR "[", &'date, "] ", "(4) making function index ...\n" if ($'vflag);
$func_total = &makefuncindex($dist, "$dist/funcs.html", $func_total);
print STDERR "Total $func_total functions.\n" if ($'vflag);
#
# (5) make file index (files.html and files/*)
# PRODUCE @files %includes
#
print STDERR "[", &'date, "] ", "(5) making file index ...\n" if ($'vflag);
$file_total = &makefileindex($dist, "$dist/files.html", "$dist/$INCS");
print STDERR "Total $file_total files.\n" if ($'vflag);
#
# [#] make a common part for mains.html and index.html
# USING @funcs @files
#
print STDERR "[", &'date, "] ", "(#) making a common part ...\n" if ($'vflag);
$index = &makecommonpart($title);
#
# (6)make index file (index.html)
#
print STDERR "[", &'date, "] ", "(6) making index file ...\n" if ($'vflag);
&makeindex("$dist/index.html", $title, $index);
#
# (7) make main index (mains.html)
#
print STDERR "[", &'date, "] ", "(7) making main index ...\n" if ($'vflag);
&makemainindex("$dist/mains.html", $index);
&makenullhtml("$dist/null.html") if ($'hflag);
#
# (#) make anchor database
#
print STDERR "[", &'date, "] ", "(#) making temporary database ...\n" if ($'vflag);
&anchor'create();
#
# (8) make HTML files ($SRCS/*)
# USING TAG CACHE, %includes and anchor database.
#
print STDERR "[", &'date, "] ", "(8) making hypertext from source code ...\n" if ($'vflag);
&makehtml($dist, $file_total);
&'clean();
print STDERR "[", &'date, "] ", "Done.\n" if ($'vflag);
if ($'cflag && $'vflag) {
print STDERR "\n";
print STDERR "[Information]\n";
print STDERR "\n";
print STDERR " You need to setup http server so that '*.ghtml' are treated\n";
print STDERR " as gzipped files. Please see 'HTML/.htaccess.skel'.\n";
print STDERR " Good luck!\n";
print STDERR "\n";
}
exit 0;
#-------------------------------------------------------------------------
# SUBROUTINES
#-------------------------------------------------------------------------
#
# makeprogram: make CGI program
#
sub makeprogram {
local($file) = @_;
open(PROGRAM, ">$file") || &'error("cannot make CGI program.");
$program = <<'END_OF_SCRIPT';
#!/usr/bin/perl
#------------------------------------------------------------------
# SORRY TO HAVE SURPRISED YOU!
# IF YOU SEE THIS UNREASONABLE FILE WHILE BROUSING, FORGET PLEASE.
# IF YOU ARE A ADMINISTRATOR OF THIS SITE, PLEASE SETUP HTTP SERVER
# SO THAT THIS SCRIPT CAN BE EXECUTED AS A CGI COMMAND. THANK YOU.
#------------------------------------------------------------------
$SRCS = 'S';
$HTML = '@HTML@';
$SEP = ' '; # source file path must not include $SEP charactor
$ESCSEP = &escape($SEP);
sub escape {
local($c) = @_;
'%' . sprintf("%x", ord($c));
}
print "Content-type: text/html\n\n";
print "\n";
@pairs = split (/&/, $ENV{'QUERY_STRING'});
foreach $p (@pairs) {
($name, $value) = split(/=/, $p);
$value =~ tr/+/ /;
$value =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack("C", hex($1))/eg;
$form{$name} = $value;
}
if ($form{'pattern'} eq '') {
print "Pattern not specified. [return]
\n";
print "\n";
exit 0;
}
$pattern = $form{'pattern'};
$flag = ($form{'type'} eq 'definition') ? '' : 'r';
$words = ($form{'type'} eq 'definition') ? 'definitions' : 'referencies';
print "\"$pattern\"
\n";
print "Following $words are matched to above pattern.
\n";
$pattern =~ s/'//g; # to shut security hole
unless (open(PIPE, "/usr/bin/global -x$flag '$pattern' |")) {
print "Cannot execute global. [return]
\n";
print "