#!/usr/bin/perl
#
# Copyright (c) 1996, 1997 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 20-Jan-98
#
$com = $0;
$com =~ s/.*\///;
$usage = "usage: $com [-a][-f][-l][-n][-v][-w][-t title][-d tagdir][dir]\n";
#-------------------------------------------------------------------------
# CONFIGURATION
#-------------------------------------------------------------------------
# columns of line number
$ncol = 4;
# font
$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 = '';
# reserved words
$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";
# temporary directory
$tmp = '/tmp';
if (defined($ENV{'TMPDIR'}) && -d $ENV{'TMPDIR'}) {
$tmp = $ENV{'TMPDIR'};
}
#-------------------------------------------------------------------------
# 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('>'));
# frame name
$f_mains = 'mains'; # for main view
$f_funcs = 'funcs'; # for function index
$f_files = 'files'; # for file index
$begin_script="\n";
$defaultview=
"// if your browser doesn't support javascript, write a BASE tag statically.\n" .
"if (parent.frames.length)\n" .
" document.write($langle+'BASE TARGET=$f_mains'+$rangle)\n";
$rewrite_href_funcs =
"if (parent.frames.length && parent.$f_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.$f_files == self) {\n" .
" document.links[0].href = '../files.html';\n" .
" document.links[document.links.length - 1].href = '../files.html';\n" .
"}\n";
#-------------------------------------------------------------------------
# UTIRITIES
#-------------------------------------------------------------------------
$findcom = "find . \\( -type f -o -type l \\) -name '*.[chysS]' -print";
sub getcwd {
local($dir) = `/bin/pwd`;
chop($dir);
$dir;
}
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($com) = @_;
foreach (split(/:/, $ENV{'PATH'})) {
return 1 if (-x "$_/$com");
}
return 0;
}
sub copy {
local($from, $to) = @_;
local($ret) = system("cp $from $to");
$ret = $ret / 256;
$ret = ($ret == 0) ? 1 : 0;
$ret;
}
#-------------------------------------------------------------------------
# PROCESS START
#-------------------------------------------------------------------------
#
# options check.
#
$aflag = $fflag = $lflag = $nflag = $vflag = $wflag = '';
while ($ARGV[0] =~ /^-/) {
$opt = shift;
if ($opt =~ /[^-aflnvwtd]/) {
print STDERR $usage;
exit 1;
}
if ($opt =~ /a/) { $aflag = 'a'; }
if ($opt =~ /f/) { $fflag = 'f'; }
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 (!$title) {
@cwd = split('/', &getcwd);
$title = $cwd[$#cwd];
}
$dbpath = &getcwd() if (!$dbpath);
unless (-r "$dbpath/GTAGS" && -r "$dbpath/GRTAGS") {
&error("GTAGS and GRTAGS not found. please type 'gtags[RET]'");
}
#
# recognize format version
# if version record is not found, it's assumed version 1.
#
$support_version = 1; # I can understand this format version
#
open(GTAGS, "btreeop -K ' __.VERSION' $dbpath/GTAGS |") || &error("GTAGS not found.");
$rec = ;
close(GTAGS);
if ($rec =~ /^ __\.VERSION[ \t]+([0-9]+)$/) {
$format_version = $1;
} else {
$format_version = 1;
}
if ($format_version != $support_version) {
&error("GTAGS format version unmatched. Please remake it.");
}
#
# check directories
#
$html = &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.");
$html = &getcwd() . '/HTML';
chdir($cwd) || &error("cannot return to original directory.");
}
#
# check if GTAGS, GRTAGS is the latest.
#
$gtags_ctime = (stat("$dbpath/GTAGS"))[10];
open(FIND, "$findcom |") || &error("cannot exec find.");
while () {
chop;
next if /(y\.tab\.c|y\.tab\.h)$/;
next if /(\/SCCS\/|\/RCS\/)/;
if ($gtags_ctime < (stat($_))[10]) {
&error("GTAGS is not the latest one. Please remake it.");
}
}
close(FIND);
#-------------------------------------------------------------------------
# MAKE FILES
#-------------------------------------------------------------------------
# HTML/cgi-bin/global.cgi ... CGI program (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/$SRCS/ ... source files (8)
# HTML/$INCS/ ... include file index (9)
#-------------------------------------------------------------------------
print STDERR "[", &date, "] ", "Htags started\n" if ($vflag);
#
# (0) make directories
#
print STDERR "[", &date, "] ", "(0) making directories ...\n" if ($vflag);
mkdir($html, 0777) || &error("cannot make directory '$html'.") if (! -d $html);
foreach $d ($SRCS, $INCS, $DEFS, $REFS, files, funcs) {
mkdir("$html/$d", 0775) || &error("cannot make HTML directory") if (! -d "$html/$d");
}
if ($fflag) {
mkdir("$html/cgi-bin", 0775) || &error("cannot make cgi-bin directory") if (! -d "$html/cgi-bin");
}
#
# (1) make CGI program
#
if ($fflag) {
print STDERR "[", &date, "] ", "(1) making CGI program ...\n" if ($vflag);
&makeprogram("$html/cgi-bin/global.cgi") || &error("cannot make CGI program.");
chmod(0755, "$html/cgi-bin/global.cgi") || &error("cannot chmod CGI program.");
unlink("$html/cgi-bin/GTAGS", "$html/cgi-bin/GRTAGS");
link("$dbpath/GTAGS", "$html/cgi-bin/GTAGS") || ©("$dbpath/GTAGS", "$html/cgi-bin/GTAGS") || &error("cannot copy GTAGS.");
link("$dbpath/GRTAGS", "$html/cgi-bin/GRTAGS") || ©("$dbpath/GRTAGS", "$html/cgi-bin/GRTAGS") || &error("cannot copy GRTAGS.");
}
#
# (2) make help file
#
print STDERR "[", &date, "] ", "(2) making help.html ...\n" if ($vflag);
&makehelp("$html/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();
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("$html/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("$html/files.html", "$html/$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("$html/index.html", $title, $index);
#
# (7) make main index (mains.html)
#
print STDERR "[", &date, "] ", "(7) making main index ...\n" if ($vflag);
&makemainindex("$html/mains.html", $index);
#
# (#) 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($file_total);
&clean();
print STDERR "[", &date, "] ", "Done.\n" if ($vflag);
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';
$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 "