[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
PATCH htags improvements.
|
From: |
Bakken, Luke |
|
Subject: |
PATCH htags improvements. |
|
Date: |
Thu, 22 Jan 2004 16:21:20 -0800 |
I apologize if you've recieved this before, I keep getting messages from
"bounce" at gnu.org. I'm going to paste the patch in the email.
> Hello,
>
> Attached is a diff containing some changes I've made to
> htags. Specifically, htags now runs under "use strict;",
> which is pretty conventional. On a small source site, it
> shaved an average of 2 seconds off of a 23 second web site build time.
>
> I also have updated the syntax to reflect more contemporary
> (and correct) perl coding style, and have made a small change
> to the anchor package. The anchors are stored as array
> references in the ANCHORS array, which eliminates the need
> for so many split() calls in that package.
>
> Thanks for a great software system! I couldn't work
> productively without it.
> Luke Bakken
>
diff -ru global-4.6.1/convert.pl global-4.6.1-new/convert.pl
--- global-4.6.1/convert.pl 2003-10-03 03:15:29.000000000 -0700
+++ global-4.6.1-new/convert.pl 2004-01-22 12:10:52.000000000 -0800
@@ -166,15 +166,16 @@
sub gen {
local($help_const) = 0;
print "# This part is generated automatically by $'com from
$'infile.\n";
+ print "use strict;\n";
while (&'getline()) {
if (/address@hidden(.*)\s+-/) {
- print "\$program = '$1';\n";
+ print "my \$program = '$1';\n";
} elsif (/address@hidden/) {
&'getline();
convert();
- print "\$usage_const = \"Usage: $_\";\n";
+ print "my \$usage_const = \"Usage: $_\";\n";
} elsif (/address@hidden/) {
- print "\$help_const =
\"\$usage_const\\\nOptions:\\\n";
+ print "my \$help_const =
\"\$usage_const\\\nOptions:\\\n";
while (&'getline()) {
if (/^\@/) {
&'ungetline();
diff -ru global-4.6.1/gctags/htags_res.pl
global-4.6.1-new/gctags/htags_res.pl
--- global-4.6.1/gctags/htags_res.pl 2003-10-03 03:15:30.000000000
-0700
+++ global-4.6.1-new/gctags/htags_res.pl 2004-01-22
12:32:31.000000000 -0800
@@ -1,15 +1,15 @@
# This part is generated automatically by reserved.pl from 'c_res.in'.
-$'sharp_macros =
"(include|warning|assert|define|ifndef|pragma|ident|ifdef|endif|undef|er
ror|line|else|elif|if)";
+my $sharp_macros =
"(include|warning|assert|define|ifndef|pragma|ident|ifdef|endif|undef|er
ror|line|else|elif|if)";
# end of generated part.
# This part is generated automatically by reserved.pl from 'c_res.in'.
-$'c_reserved_words =
"(__attribute__|__extension__|__restrict__|__volatile__|__attribute|__vo
latile|__restrict|_Imaginary|__signed__|__inline__|__const__|restrict|co
ntinue|register|__signed|unsigned|_Complex|volatile|__inline|default|__c
onst|__asm__|typedef|extern|inline|signed|sizeof|static|struct|switch|re
turn|double|__asm|const|_Bool|break|float|union|short|while|char|goto|lo
ng|auto|else|enum|void|case|__P|for|int|asm|do|if)";
+my $c_reserved_words =
"(__attribute__|__extension__|__restrict__|__volatile__|__attribute|__vo
latile|__restrict|_Imaginary|__signed__|__inline__|__const__|restrict|co
ntinue|register|__signed|unsigned|_Complex|volatile|__inline|default|__c
onst|__asm__|typedef|extern|inline|signed|sizeof|static|struct|switch|re
turn|double|__asm|const|_Bool|break|float|union|short|while|char|goto|lo
ng|auto|else|enum|void|case|__P|for|int|asm|do|if)";
# end of generated part.
# This part is generated automatically by reserved.pl from
'cpp_res.in'.
-$'cpp_reserved_words =
"(reinterpret_cast|__attribute__|__extension__|__volatile__|dynamic_cast
|__attribute|static_cast|__volatile|__inline__|const_cast|__signed__|__c
onst__|protected|namespace|__signed|operator|volatile|explicit|__inline|
continue|register|template|typename|unsigned|mutable|__asm__|__const|typ
edef|private|default|virtual|wchar_t|public|return|sizeof|static|extern|
struct|switch|signed|inline|export|typeid|delete|friend|double|false|flo
at|throw|__asm|short|const|union|break|using|catch|class|while|auto|void
|long|else|enum|this|goto|true|case|char|bool|__P|int|for|new|try|asm|if
|do)";
+my $cpp_reserved_words =
"(reinterpret_cast|__attribute__|__extension__|__volatile__|dynamic_cast
|__attribute|static_cast|__volatile|__inline__|const_cast|__signed__|__c
onst__|protected|namespace|__signed|operator|volatile|explicit|__inline|
continue|register|template|typename|unsigned|mutable|__asm__|__const|typ
edef|private|default|virtual|wchar_t|public|return|sizeof|static|extern|
struct|switch|signed|inline|export|typeid|delete|friend|double|false|flo
at|throw|__asm|short|const|union|break|using|catch|class|while|auto|void
|long|else|enum|this|goto|true|case|char|bool|__P|int|for|new|try|asm|if
|do)";
# end of generated part.
# This part is generated automatically by reserved.pl from
'java_res.in'.
-$'java_reserved_words =
"(synchronized|instanceof|implements|transient|interface|protected|volat
ile|strictfp|abstract|continue|boolean|extends|finally|package|default|p
rivate|static|native|double|switch|throws|import|public|return|widefp|br
eak|catch|float|final|false|short|super|union|class|const|while|throw|th
is|char|else|goto|long|true|void|null|byte|case|try|new|int|for|do|if)";
+my $java_reserved_words =
"(synchronized|instanceof|implements|transient|interface|protected|volat
ile|strictfp|abstract|continue|boolean|extends|finally|package|default|p
rivate|static|native|double|switch|throws|import|public|return|widefp|br
eak|catch|float|final|false|short|super|union|class|const|while|throw|th
is|char|else|goto|long|true|void|null|byte|case|try|new|int|for|do|if)";
# end of generated part.
# This part is generated automatically by reserved.pl from
'php_res.in'.
-$'php_reserved_words =
"(Require_once|REQUIRE_ONCE|__FUNCTION__|require_once|include_once|Old_F
unction|OLD_FUNCTION|Old_function|Include_once|Include_Once|old_function
|INCLUDE_ONCE|Require_Once|EndForeach|enddeclare|ENDDECLARE|EndDeclare|E
nddeclare|endforeach|ENDFOREACH|Endforeach|SetCookie|Setcookie|__CLASS__
|SETCOOKIE|CFunction|Cfunction|CFUNCTION|endswitch|ENDSWITCH|Endswitch|E
ndSwitch|cfunction|setcookie|Is_Array|continue|Is_array|IS_ARRAY|is_arra
y|__FILE__|endwhile|ENDWHILE|Endwhile|EndWhile|__LINE__|Function|FUNCTIO
N|function|CONTINUE|Continue|DECLARE|Declare|default|DEFAULT|Default|fai
lure|FAILURE|Failure|foreach|FOREACH|Foreach|ForEach|include|INCLUDE|Inc
lude|require|REQUIRE|Require|success|SUCCESS|Success|declare|Elseif|Else
If|Return|RETURN|global|GLOBAL|Global|header|HEADER|Header|return|Printf
|PRINTF|printf|endfor|ENDFOR|Endfor|Is_Set|EndFor|Is_set|IS_SET|define|D
EFINE|Define|is_set|Switch|SWITCH|switch|Static|STATIC|static|elseif|ELS
EIF|FALSE|False|EMPTY|array|ARRAY|Array|empty|while|WHILE|break|BREAK|Br
eak|While|unset|UNSET|class|CLASS|Class|const|CONST|Const|Unset|false|En
dIf|Endif|endif|ENDIF|Empty|print|PRINT|Print|ECHO|echo|Each|EACH|Else|E
LSE|case|CASE|Case|Exit|EVAL|Eval|EXIT|exit|List|LIST|list|else|Echo|eac
h|true|TRUE|True|eval|and|AND|And|VAR|Var|xor|XOR|For|Xor|new|NEW|for|Ne
w|FOR|Die|DIE|die|var|as|AS|As|do|if|Do|or|OR|Or|DO|If|IF)";
+my $php_reserved_words =
"(Require_once|REQUIRE_ONCE|__FUNCTION__|require_once|include_once|Old_F
unction|OLD_FUNCTION|Old_function|Include_once|Include_Once|old_function
|INCLUDE_ONCE|Require_Once|EndForeach|enddeclare|ENDDECLARE|EndDeclare|E
nddeclare|endforeach|ENDFOREACH|Endforeach|SetCookie|Setcookie|__CLASS__
|SETCOOKIE|CFunction|Cfunction|CFUNCTION|endswitch|ENDSWITCH|Endswitch|E
ndSwitch|cfunction|setcookie|Is_Array|continue|Is_array|IS_ARRAY|is_arra
y|__FILE__|endwhile|ENDWHILE|Endwhile|EndWhile|__LINE__|Function|FUNCTIO
N|function|CONTINUE|Continue|DECLARE|Declare|default|DEFAULT|Default|fai
lure|FAILURE|Failure|foreach|FOREACH|Foreach|ForEach|include|INCLUDE|Inc
lude|require|REQUIRE|Require|success|SUCCESS|Success|declare|Elseif|Else
If|Return|RETURN|global|GLOBAL|Global|header|HEADER|Header|return|Printf
|PRINTF|printf|endfor|ENDFOR|Endfor|Is_Set|EndFor|Is_set|IS_SET|define|D
EFINE|Define|is_set|Switch|SWITCH|switch|Static|STATIC|static|elseif|ELS
EIF|FALSE|False|EMPTY|array|ARRAY|Array|empty|while|WHILE|break|BREAK|Br
eak|While|unset|UNSET|class|CLASS|Class|const|CONST|Const|Unset|false|En
dIf|Endif|endif|ENDIF|Empty|print|PRINT|Print|ECHO|echo|Each|EACH|Else|E
LSE|case|CASE|Case|Exit|EVAL|Eval|EXIT|exit|List|LIST|list|else|Echo|eac
h|true|TRUE|True|eval|and|AND|And|VAR|Var|xor|XOR|For|Xor|new|NEW|for|Ne
w|FOR|Die|DIE|die|var|as|AS|As|do|if|Do|or|OR|Or|DO|If|IF)";
# end of generated part.
diff -ru global-4.6.1/gctags/reserved.pl
global-4.6.1-new/gctags/reserved.pl
--- global-4.6.1/gctags/reserved.pl 2003-10-03 03:15:29.000000000
-0700
+++ global-4.6.1-new/gctags/reserved.pl 2004-01-22 12:28:36.000000000
-0800
@@ -128,9 +128,9 @@
print "# This part is generated automatically by $com from
'$keyword_file'.\n";
if ($prefix eq 'sharp') {
- print "\$'sharp_macros = \"(";
+ print "my \$sharp_macros = \"(";
} else {
- print "\$'${prefix}_reserved_words = \"(";
+ print "my \$${prefix}_reserved_words = \"(";
}
print join('|', @array);
print ")\";\n";
diff -ru global-4.6.1/htags/const.pl global-4.6.1-new/htags/const.pl
--- global-4.6.1/htags/const.pl 2003-10-03 03:15:31.000000000 -0700
+++ global-4.6.1-new/htags/const.pl 2004-01-22 12:24:49.000000000
-0800
@@ -1,7 +1,8 @@
# This part is generated automatically by convert.pl from
htags/manual.in.
-$program = 'htags';
-$usage_const = "Usage: htags
[-a][-c][-D][-f][-F][-g][-n][-o][-s][-v][-w][-d dbpath][-m name][-S
cgidir][-t title][htmldir]";
-$help_const = "$usage_const\
+use strict;
+my $program = 'htags';
+my $usage_const = "Usage: htags
[-a][-c][-D][-f][-F][-g][-n][-o][-s][-v][-w][-d dbpath][-m name][-S
cgidir][-t title][htmldir]";
+my $help_const = "$usage_const\
Options:\
-a, --alphabet\
Make an alphabetical function index, suitable for a large
project.\
diff -ru global-4.6.1/htags/htags.in global-4.6.1-new/htags/htags.in
--- global-4.6.1/htags/htags.in 2003-10-03 03:15:29.000000000 -0700
+++ global-4.6.1-new/htags/htags.in 2004-01-22 15:00:07.328125000
-0800
@@ -18,10 +18,10 @@
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
USA.
#
-$'w32 = ($^O =~ /^(ms)?(dos|win(32|nt))/i) ? 1 : 0;
-$www = "http://www.gnu.org/software/global/";;
-$file_count = 0;
-$caution_message = <<'END_OF_CAUTION';
+my $w32 = ($^O =~ /^(ms)?(dos|win(32|nt))/i) ? 1 : 0;
+my $www = "http://www.gnu.org/software/global/";;
+my $file_count = 0;
+my $caution_message = <<'END_OF_CAUTION';
<CENTER>
<BLOCKQUOTE>
<FONT SIZE=+2 COLOR=red>CAUTION</FONT><BR>
@@ -38,90 +38,90 @@
# SELF CHECK
#-----------------------------------------------------------------------
--
if (!defined($program) || !defined($usage_const) ||
!defined($help_const) ||
- !defined($'c_reserved_words) ||
- !defined($'cpp_reserved_words) ||
- !defined($'java_reserved_words)||
- !defined($'php_reserved_words) ||
- !defined($'sharp_macros))
+ !defined($c_reserved_words) ||
+ !defined($cpp_reserved_words) ||
+ !defined($java_reserved_words)||
+ !defined($php_reserved_words) ||
+ !defined($sharp_macros))
{
die("htags: Required variables not found. It seems that htags
wasn't built correctly.\n");
}
#-----------------------------------------------------------------------
--
# COMMAND EXISTENCE CHECK
#-----------------------------------------------------------------------
--
-foreach $c ('sort', 'gtags', 'global') {
- if (!&'usable($c)) {
- &'error("'$c' command is required but not found.");
+for my $c ('sort', 'gtags', 'global') {
+ if (!usable($c)) {
+ error("'$c' command is required but not found.");
}
}
#
# find filter
#
-$'gtags = &'usable("gtags");
-$'findcom = "$'gtags --find";
+my $gtags = usable("gtags");
+my $findcom = "$gtags --find";
#-----------------------------------------------------------------------
--
# CONFIGURATION
#-----------------------------------------------------------------------
--
-$version = `global --version`;
-chop($version);
+my $version = `global --version`;
+chomp($version);
# null device
-$'null_device = $'w32 ? 'NUL' : '/dev/null';
+my $null_device = $w32 ? 'NUL' : '/dev/null';
# temporary directory
-$'tmp = '/tmp';
+my $tmp = '/tmp';
if (defined($ENV{'TMPDIR'}) && -d $ENV{'TMPDIR'}) {
$tmp = $ENV{'TMPDIR'};
}
if (! -d $tmp || ! -w $tmp) {
- &'error("temporary directory '$tmp' not exist or not
writable.");
+ error("temporary directory '$tmp' not exist or not writable.");
}
-$'ncol = 4; # columns of line number
-$'tabs = 8; # tab skip
+my $ncol = 4; # columns of line number
+my $tabs = 8; # tab skip
#
# File index
#
-$'full_path = 0; # file index format
-$'icon_list = ''; # use icon for file
index
-$'no_order_list = 0; # doesn't use order list
-$'icon_suffix = ''; # icon suffix (jpg, png
etc)
-$'icon_spec = 'BORDER=0 ALIGN=top'; # parameter in IMG tag
-
-$'prolog_script = ''; # include script at
first
-$'epilog_script = ''; # include script at last
-$'show_position = 0; # show current position
-$'table_list = 0; # tag list using table
tag
-$'colorize_warned_line = 0; # colorize warned line
-$'script_alias = '/cgi-bin'; # script alias of WWW
server
-$'gzipped_suffix = 'ghtml'; # suffix of gzipped html
file
-$'normal_suffix = 'html'; # suffix of normal html
file
-$'action = 'cgi-bin/global.cgi'; # default action
-$'id = ''; # id (default non)
-$'cgi = 1; # 1: make cgi-bin/
-$'definition_header='no'; # {no|after|before}
-$'other_files = 0; # 1: list other files
-$'map_file = 1; # generate
HTML/MAP
-$'use_cache_file = 1; # make temporary db
+my $full_path = 0; # file index
format
+my $icon_list = ''; # use icon for
file index
+my $no_order_list = 0; # doesn't use order list
+my $icon_suffix = ''; # icon suffix (jpg, png
etc)
+my $icon_spec = 'BORDER=0 ALIGN=top'; # parameter in IMG tag
+
+my $prolog_script = ''; #
include script at first
+my $epilog_script = ''; #
include script at last
+my $show_position = 0; # show current
position
+my $table_list = 0; # tag
list using table tag
+my $colorize_warned_line = 0; # colorize warned line
+my $script_alias = '/cgi-bin'; # script alias of WWW
server
+my $gzipped_suffix = 'ghtml'; # suffix of gzipped html
file
+my $normal_suffix = 'html'; # suffix of
normal html file
+my $action = 'cgi-bin/global.cgi'; # default action
+my $id = ''; # id (default
non)
+my $cgi = 1; # 1: make
cgi-bin/
+my $definition_header='no'; # {no|after|before}
+my $other_files = 0; # 1: list other files
+my $map_file = 1; # generate
HTML/MAP
+my $use_cache_file = 1; # make temporary
db
#
# tag
#
-$'body_begin = '<BODY>';
-$'body_end = '</BODY>';
-$'table_begin = '<TABLE>';
-$'table_end = '</TABLE>';
-$'title_begin = '<H1><FONT COLOR=#cc0000>';
-$'title_end = '</FONT></H1>';
-$'comment_begin = '<I><FONT COLOR=green>'; # /* ... */
-$'comment_end = '</FONT></I>';
-$'sharp_begin = '<FONT COLOR=darkred>'; # #define, #include or
so on
-$'sharp_end = '</FONT>';
-$'brace_begin = '<FONT COLOR=blue>'; # { ... }
-$'brace_end = '</FONT>';
-$'reserved_begin = '<B>'; # if, while, for or so
on
-$'reserved_end = '</B>';
-$'position_begin = '<FONT COLOR=gray>';
-$'position_end = '</FONT>';
-$'warned_line_begin = '<SPAN STYLE="background-color:yellow">';
-$'warned_line_end = '</SPAN>';
-$'hr = '<HR>';
+my $body_begin = '<BODY>';
+my $body_end = '</BODY>';
+my $table_begin = '<TABLE>';
+my $table_end = '</TABLE>';
+my $title_begin = '<H1><FONT COLOR=#cc0000>';
+my $title_end = '</FONT></H1>';
+my $comment_begin = '<I><FONT COLOR=green>'; # /* ... */
+my $comment_end = '</FONT></I>';
+my $sharp_begin = '<FONT COLOR=darkred>'; # #define, #include or
so on
+my $sharp_end = '</FONT>';
+my $brace_begin = '<FONT COLOR=blue>'; # { ... }
+my $brace_end = '</FONT>';
+my $reserved_begin = '<B>'; # if, while, for or so
on
+my $reserved_end = '</B>';
+my $position_begin = '<FONT COLOR=gray>';
+my $position_end = '</FONT>';
+my $warned_line_begin = '<SPAN STYLE="background-color:yellow">';
+my $warned_line_end = '</SPAN>';
+my $hr = '<HR>';
{
#
# Setup the GTAGSCONF environment variable according to
@@ -130,24 +130,24 @@
# --gtagsconf=<config file> or <config value itself>
# --gtagslabel=<label>.
#
- local(@a, $confpath, $label);
- for ($i = 0; $i < @ARGV; $i++) {
+ my (@a, $confpath, $label);
+ for (my $i = 0; $i < @ARGV; $i++) {
if ($ARGV[$i] =~ /^--gtagsconf/) {
if ($ARGV[$i] =~ /^--gtagsconf=(.*)$/) {
$confpath = $1;
} elsif ($ARGV[$i] =~ /^--gtagsconf$/) {
if (++$i >= @ARGV) {
- &'error("--gtagsconf needs an
argument.");
+ error("--gtagsconf needs an
argument.");
}
$confpath = $ARGV[$i];
}
- $ENV{'GTAGSCONF'} = (-f $confpath) ?
&realpath($confpath) : $confpath;
+ $ENV{'GTAGSCONF'} = (-f $confpath) ?
realpath($confpath) : $confpath;
} elsif ($ARGV[$i] =~ /^--gtagslabel/) {
if ($ARGV[$i] =~ /^--gtagslabel=(.*)$/) {
$label = $1;
} elsif ($ARGV[$i] =~ /^--gtagslabel$/) {
if (++$i >= @ARGV) {
- &'error("--gtagslabel needs an
argument.");
+ error("--gtagslabel needs an
argument.");
}
$label = $ARGV[$i];
}
@@ -161,157 +161,164 @@
#
# load configuration variables.
#
-if ($var1 = &'getconf('ncol')) {
+my ($var1, $ncol);
+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;
+ $ncol = $var1;
}
}
-if ($var1 = &'getconf('tabs')) {
+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;
+ $tabs = $var1;
}
}
-if ($var1 = &'getconf('gzipped_suffix')) {
- $'gzipped_suffix = $var1;
+if ($var1 = getconf('gzipped_suffix')) {
+ $gzipped_suffix = $var1;
}
-if ($var1 = &'getconf('normal_suffix')) {
- $'normal_suffix = $var1;
+if ($var1 = getconf('normal_suffix')) {
+ $normal_suffix = $var1;
}
-if ($var1 = &'getconf('definition_header')) {
- $'definition_header = $var1;
+if ($var1 = getconf('definition_header')) {
+ $definition_header = $var1;
}
-if ($var1 = &'getconf('other_files')) {
- $'other_files = $var1;
+if ($var1 = getconf('other_files')) {
+ $other_files = $var1;
}
-if ($var1 = &'getconf('enable_grep')) {
- $'enable_grep = $var1;
+my $enable_grep;
+if ($var1 = getconf('enable_grep')) {
+ $enable_grep = $var1;
}
-if ($var1 = &'getconf('enable_idutils')) {
- $'enable_idutils = $var1;
+my $enable_idutils;
+if ($var1 = getconf('enable_idutils')) {
+ $enable_idutils = $var1;
}
-if ($var1 = &'getconf('full_path')) {
- $'full_path = $var1;
+if ($var1 = getconf('full_path')) {
+ $full_path = $var1;
}
-if ($var1 = &'getconf('table_list')) {
- $'table_list = $var1;
+if ($var1 = getconf('table_list')) {
+ $table_list = $var1;
}
-if ($var1 = &'getconf('icon_list')) {
- $'icon_list = $var1;
+if ($var1 = getconf('icon_list')) {
+ $icon_list = $var1;
}
-if ($var1 = &'getconf('icon_spec')) {
- $'icon_spec = $var1;
+if ($var1 = getconf('icon_spec')) {
+ $icon_spec = $var1;
}
-if ($var1 = &'getconf('icon_suffix')) {
- $'icon_suffix = $var1;
+if ($var1 = getconf('icon_suffix')) {
+ $icon_suffix = $var1;
}
-if ($var1 = &'getconf('no_order_list')) {
- $'no_order_list = $var1;
+if ($var1 = getconf('no_order_list')) {
+ $no_order_list = $var1;
}
-if ($var1 = &'getconf('prolog_script')) {
- $'prolog_script = $var1;
+if ($var1 = getconf('prolog_script')) {
+ $prolog_script = $var1;
}
-if ($var1 = &'getconf('epilog_script')) {
- $'epilog_script = $var1;
+if ($var1 = getconf('epilog_script')) {
+ $epilog_script = $var1;
}
-if (&'getconf('no_map_file')) {
- $'map_file = 0;
+if (getconf('no_map_file')) {
+ $map_file = 0;
}
#
# If enough momory exist and perl is configured so that vfork might be
used,
# set this variable.
# Note that vfork is no longer used in perl-5.8.
#
-if (&'getconf('no_cache_file')) { # undocumented
- $'use_cache_file = 0;
+if (getconf('no_cache_file')) { # undocumented
+ $use_cache_file = 0;
}
-if ($var1 = &'getconf('show_position')) {
- $'show_position = $var1;
+if ($var1 = getconf('show_position')) {
+ $show_position = $var1;
}
-if ($var1 = &'getconf('colorize_warned_line')) {
- $'colorize_warned_line = $var1;
+if ($var1 = getconf('colorize_warned_line')) {
+ $colorize_warned_line = $var1;
}
-if ($var1 = &'getconf('script_alias')) {
- $'script_alias = $var1;
- $'script_alias =~ s!/$!!;
+if ($var1 = getconf('script_alias')) {
+ $script_alias = $var1;
+ $script_alias =~ s!/$!!;
}
-if (&'getconf('symbol')) {
- $'symbol = 1;
+my $symbol = 0;
+if (getconf('symbol')) {
+ $symbol = 1;
}
-if (&'getconf('symbols')) { # for backward compatibility
- $'symbol = 1;
+if (getconf('symbols')) { # for backward compatibility
+ $symbol = 1;
}
-if (&'getconf('dynamic')) {
- $'dynamic = 1;
+my $dynamic = 0;
+if (getconf('dynamic')) {
+ $dynamic = 1;
}
-if (($var1 = &'getconf('body_begin')) && ($var2 =
&'getconf('body_end'))) {
- $'body_begin = $var1;
- $'body_end = $var2;
+my $var2;
+if (($var1 = getconf('body_begin')) && ($var2 = getconf('body_end'))) {
+ $body_begin = $var1;
+ $body_end = $var2;
}
-if (($var1 = &'getconf('table_begin')) && ($var2 =
&'getconf('table_end'))) {
- $'table_begin = $var1;
- $'table_end = $var2;
+if (($var1 = getconf('table_begin')) && ($var2 = getconf('table_end')))
{
+ $table_begin = $var1;
+ $table_end = $var2;
}
-if (($var1 = &'getconf('title_begin')) && ($var2 =
&'getconf('title_end'))) {
- $'title_begin = $var1;
- $'title_end = $var2;
+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('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('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('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;
+if (($var1 = getconf('reserved_begin')) && ($var2 =
getconf('reserved_end'))) {
+ $reserved_begin = $var1;
+ $reserved_end = $var2;
}
-if (($var1 = &'getconf('position_begin')) && ($var2 =
&'getconf('position_end'))) {
- $'position_begin = $var1;
- $'position_end = $var2;
+if (($var1 = getconf('position_begin')) && ($var2 =
getconf('position_end'))) {
+ $position_begin = $var1;
+ $position_end = $var2;
}
-if (($var1 = &'getconf('warned_line_begin')) && ($var2 =
&'getconf('warned_line_end'))) {
- $'warned_line_begin = $var1;
- $'warned_line_end = $var2;
+if (($var1 = getconf('warned_line_begin')) && ($var2 =
getconf('warned_line_end'))) {
+ $warned_line_begin = $var1;
+ $warned_line_end = $var2;
}
-if (($var1 = &'getconf('hr'))) {
- $'hr = $var1;
+if (($var1 = getconf('hr'))) {
+ $hr = $var1;
}
# insert htags_options into the head of ARGSV array.
-if (($var1 = &'getconf('htags_options'))) {
- $'htags_options = $var1;
+my $htags_options;
+if (($var1 = getconf('htags_options'))) {
+ $htags_options = $var1;
}
# HTML tag
-$'html_begin = '<HTML>';
-$'html_end = '</HTML>';
-$'meta_robots = "<META NAME='ROBOTS' CONTENT='NOINDEX,NOFOLLOW'>";
-$'meta_generator = "<META NAME='GENERATOR' CONTENT='GLOBAL-$version'>";
+my $html_begin = '<HTML>';
+my $html_end = '</HTML>';
+my $meta_robots = "<META NAME='ROBOTS' CONTENT='NOINDEX,NOFOLLOW'>";
+my $meta_generator = "<META NAME='GENERATOR'
CONTENT='GLOBAL-$version'>";
# Titles
-$'title_define_index = 'DEFINITIONS';
-$'title_file_index = 'FILES';
-$'title_included_from = 'INCLUDED FROM';
+my $title_define_index = 'DEFINITIONS';
+my $title_file_index = 'FILES';
+my $title_included_from = 'INCLUDED FROM';
# Anchor image
address@hidden = ('<', '>', '^', 'v', 'top', 'bottom', 'index',
'help');
address@hidden = ('left', 'right', 'first', 'last', 'top', 'bottom',
'index', 'help');
address@hidden = ('previous', 'next', 'first', 'last', 'top',
'bottom', 'index', 'help');
-foreach $a (@anchor_icons) {
- $a .= '.' . $'icon_suffix;
-}
-$back_icon = 'back' . '.' . $'icon_suffix;
-$dir_icon = 'dir' . '.' . $'icon_suffix;
-$c_icon = 'c' . '.' . $'icon_suffix;
-$file_icon = 'text' . '.' . $'icon_suffix;
address@hidden = ('Previous definition.',
+my @anchor_label = ('<', '>', '^', 'v', 'top', 'bottom', 'index',
'help');
+my @anchor_icons = ('left', 'right', 'first', 'last', 'top', 'bottom',
'index', 'help');
+my @anchor_comment = ('previous', 'next', 'first', 'last', 'top',
'bottom', 'index', 'help');
+for my $a (@anchor_icons) {
+ $a .= '.' . $icon_suffix;
+}
+my $back_icon = 'back' . '.' . $icon_suffix;
+my $dir_icon = 'dir' . '.' . $icon_suffix;
+my $c_icon = 'c' . '.' . $icon_suffix;
+my $file_icon = 'text' . '.' . $icon_suffix;
+my @anchor_msg = ('Previous definition.',
'Next definition.',
'First definition in this file.',
'Last definition in this file.',
@@ -329,8 +336,8 @@
# lno == -1: entry count
#
sub show {
- local($type, $lno, $opt) = @_;
- local($msg) = '';
+ my ($type, $lno, $opt) = @_;
+ my $msg = '';
if ($lno > 0) {
if ($type eq 'I') {
@@ -366,179 +373,49 @@
# DIRECTORIES
#-----------------------------------------------------------------------
--
# unit for a path
-$'SRCS = 'S'; # source file directory.
-$'DEFS = 'D'; # object definition
directory.
-$'REFS = 'R'; # object reference
directory.
-$'INCS = 'I'; # include file
directory.
-$'INCREFS = 'J'; # include file reference
directory.
-$'SYMS = 'Y'; # symbols directory.
+my $SRCS = 'S'; # source file directory.
+my $DEFS = 'D'; # object definition
directory.
+my $REFS = 'R'; # object reference
directory.
+my $INCS = 'I'; # include file
directory.
+my $INCREFS = 'J'; # include file reference
directory.
+my $SYMS = 'Y'; # symbols directory.
+my %GPATH;
+my $nextkey = 0;
+
sub get_dirlist {
- local(@dir) = (files, defines, $'SRCS, $'INCS, $'INCREFS);
- if (!$'dynamic) {
- push(@dir, $'DEFS, $'REFS);
- push(@dir, $'SYMS) if ($'symbol);
+ my @dir = ('files', 'defines', $SRCS, $INCS, $INCREFS);
+ if (!$dynamic) {
+ push(@dir, $DEFS, $REFS);
+ push(@dir, $SYMS) if ($symbol);
}
@dir;
}
sub get_taglist {
- local(@tags) = ('GTAGS', 'GRTAGS');
- push(@tags, 'GSYMS') if ($'symbol);
+ my @tags = ('GTAGS', 'GRTAGS');
+ push(@tags, 'GSYMS') if ($symbol);
@tags;
}
sub get_dirhash {
- local(%dir) = ('GTAGS', $'DEFS, 'GRTAGS', $'REFS, 'GSYMS',
$'SYMS);
+ my %dir = ('GTAGS', $DEFS, 'GRTAGS', $REFS, 'GSYMS', $SYMS);
%dir;
}
sub get_option {
- local($db) = @_;
- local(%option) = ('GTAGS', '', 'GRTAGS', 'r', 'GSYMS', 's');
+ my $db = shift;
+ my %option = ('GTAGS', '', 'GRTAGS', 'r', 'GSYMS', 's');
$option{$db};
}
#-----------------------------------------------------------------------
--
-# UTILITIES
-#----------------------------------------------------------------------
---
-#
-# get current working directory.
-#
-sub getcwd {
- local($dir) = `$'gtags --pwd`;
- if ($'w32) { $dir =~ s!\\!/!g; }
- chop($dir);
- $dir;
-}
-#
-# get real absolute path name.
-#
-sub realpath {
- local($path) = @_;
- local($cwd) = &getcwd; # for recovery
- local($real); # real directory
-
- if (! -d $path && ! -f $path) {
- &'error("'$path' not found.");
- }
- local($dir,$file) = ($path =~ m#^(.*/)?(.*)#);
- if ($dir) {
- chdir($dir) || &'error("directory '$dir' not found.");
- }
- $real = &getcwd;
- $path = $real . '/' . $file;
- $path =~ s!//!/!;
- chdir($cwd) || &'error("cannot recover current directory
'$cwd'.");
- $path;
-}
-#
-# get date string.
-#
-sub date {
- local($date) = `$'gtags --date`;
- chop($date);
- $date;
-}
-#
-# print message and exit with error status.
-#
-sub error {
- &clean();
- printf STDERR "$program: $_[0]\n";
- exit 1;
-}
-#
-# set things right before exiting.
-#
-sub clean {
- &cache'close();
-}
-#
-# locate executable command and return it's absolute path name.
-#
-sub usable {
- local($command) = @_;
- local($pathsep) = ($'w32) ? ';' : ':';
- foreach (split(/$pathsep/, $ENV{'PATH'})) {
- if ($'w32) {
- return "$_\\$command.com" if (-f
"$_\\$command.com");
- return "$_\\$command.exe" if (-f
"$_\\$command.exe");
- } else {
- return "$_/$command" if (-x "$_/$command");
- }
- }
- return '';
-}
-#
-# duplicate file. if possible, link it without making a copy.
-#
-sub duplicatefile {
- local($file, $from, $to) = @_;
- if ($'w32) {
- &'copy("$from/$file", "$to/$file")
- } else {
- link("$from/$file", "$to/$file")
- || &'copy("$from/$file", "$to/$file")
- }
-}
-#
-# copy file.
-#
-sub copy {
- local($from, $to) = @_;
- local($command) = ($'w32) ? 'copy' : 'cp';
- $command .= " $from $to";
- $command =~ s!/!\\!g if ($'w32);
- system($command);
- if ($? != 0) {
- &'error("cannot execute '$command'.");
- }
- return 1;
-}
-#
-# get value of configuration variable.
-#
-sub getconf {
- local($name) = @_;
- local($val);
- chop($val = `$'gtags --config $name`);
- if ($? != 0) {
- &'error("cannot get config value.");
- }
- $val;
-}
-#
-# convert source file path name into url.
-#
-sub path2url {
- local($path) = @_;
- $path = './' . $path if ($path !~ /^\./);
- if (!defined($'GPATH{$path})) {
- $'GPATH{$path} = ++$nextkey;
- }
- $'GPATH{$path} . '.' . $'HTML;
-}
-#
-# return header.
-#
-sub set_header {
- local($title) = @_;
- local($head) = '';
- $head .= "<HEAD>\n";
- $head .= "<TITLE>$title</TITLE>\n";
- $head .= "$'meta_robots\n$'meta_generator\n";
- $head .= $'style_sheet if ($'style_sheet);
- $head .= "</HEAD>\n";
- $head;
-}
-#----------------------------------------------------------------------
---
# LIST PROCEDURE
#-----------------------------------------------------------------------
--
sub list_begin {
- $'table_list ? "$'table_begin\n<TR><TH NOWRAP
ALIGN=left>tag</TH><TH NOWRAP ALIGN=right>line</TH><TH NOWRAP
ALIGN=center>file</TH><TH NOWRAP ALIGN=left>source code</TH></TR>\n" :
"<PRE>\n";
+ $table_list ? "$table_begin\n<TR><TH NOWRAP
ALIGN=left>tag</TH><TH NOWRAP ALIGN=right>line</TH><TH NOWRAP
ALIGN=center>file</TH><TH NOWRAP ALIGN=left>source code</TH></TR>\n" :
"<PRE>\n";
}
sub list_body {
- local($srcdir, $s) = @_; # $s must be choped.
- local($name, $lno, $filename, $line) = ($s =~
/^(\S+)\s+(\d+)\s+\.\/(\S+) (.*)$/);
- local($html) = &'path2url($filename);
+ my ($srcdir, $s) = @_; # $s must be choped.
+ my ($name, $lno, $filename, $line) = ($s =~
/^(\S+)\s+(\d+)\s+\.\/(\S+) (.*)$/);
+ my $html = path2url($filename);
- if ($'table_list) {
+ if ($table_list) {
$line =~ s/&/&/g;
$line =~ s/</</g;
$line =~ s/>/>/g;
@@ -556,31 +433,31 @@
$s . "\n";
}
sub list_end {
- local($s) = $'table_list ? $'table_end : "</PRE>";
+ my $s = $table_list ? $table_end : "</PRE>";
$s . "\n";
}
#-----------------------------------------------------------------------
--
# PROCESS START
#-----------------------------------------------------------------------
--
# include prolog_script if needed.
-require($'prolog_script) if ($'prolog_script && -f $'prolog_script);
+require($prolog_script) if ($prolog_script && -f $prolog_script);
#
# save config values and option values.
#
-$save_config = `$'gtags --config`;
-chop($save_config);
+my $save_config = `$gtags --config`;
+chomp($save_config);
$save_config =~ s/'/'"'"'/g; # keep single quote
-$save_argv = '';
+my $save_argv = '';
foreach (@ARGV) {
$save_argv .= ' ' if ($save_argv);
$save_argv .= (/[ \t]/) ? "'$_'" : $_; # quote arg include
blank.
}
-if ($'htags_options) {
+if ($htags_options) {
#
- # insert $'htags_options at the head of ARGV.
+ # insert $htags_options at the head of ARGV.
#
- local($a) = $'htags_options;
- local(@a, $skip);
+ my $a = $htags_options;
+ my (@a, $skip);
while ($a) {
$a =~ s/^[ \t]+//;
if ($a =~ s/^'([^']*)'// || $a =~ s/^"([^"]*)"// || $a
=~ s/^([^ \t]+)//) {
@@ -592,44 +469,49 @@
#
# options check.
#
-$'aflag = $'cflag = $'Dflag = $'fflag = $'Fflag = $'gflag = $'nflag =
$'sflag = $'Sflag = $'vflag = $'wflag = '';
-$show_version = 0;
-$show_help = 0;
-$include_caution = '';
-$action_value = '';
-$id_value = '';
-$cgidir = '';
-$main_func = 'main';
-$style_sheet = '';
-$cvsweb_url = '';
-$cvsweb_cvsroot = '';
-$statistics = 0;
+my ($aflag, $cflag, $Dflag, $fflag, $Fflag, $gflag,
+ $nflag, $oflag, $sflag, $Sflag, $vflag, $wflag);
+$aflag = $cflag = $Dflag = $fflag = $Fflag = $gflag = $nflag = $sflag =
$Sflag = $vflag = $wflag = '';
+my $show_version = 0;
+my $show_help = 0;
+my $include_caution = '';
+my $action_value = '';
+my $id_value = '';
+my $cgidir = '';
+my $main_func = 'main';
+my $style_sheet = '';
+my $cvsweb_url = '';
+my $cvsweb_cvsroot = '';
+my $statistics = 0;
+my $title = '';
+my $dbpath = '';
+
while ($ARGV[0] =~ /^-/) {
- $opt = shift;
+ my $opt = shift;
if ($opt =~ /^--action=(.*)$/) {
$action_value = $1;
} elsif ($opt =~ /^--id=(.*)$/) {
$id_value = $1;
} elsif ($opt =~ /^--nocgi$/) {
- $'cgi = 0;
+ $cgi = 0;
} elsif ($opt =~ /^--version$/) {
$show_version = 1;
} elsif ($opt =~ /^--help$/) {
$show_help = 1;
} elsif ($opt =~ /^--alphabet$/) {
- $'aflag = 'a';
+ $aflag = 'a';
} elsif ($opt =~ /^--compact$/) {
- $'cflag = 'c';
+ $cflag = 'c';
} elsif ($opt =~ /^--dynamic$/) {
- $'dynamic = 1;
+ $dynamic = 1;
} elsif ($opt =~ /^--each-line-tag$/) {
; # for backward compatibility.
} elsif ($opt =~ /^--form$/) {
- $'fflag = 'f';
+ $fflag = 'f';
} elsif ($opt =~ /^--frame$/) {
- $'Fflag = 'F';
+ $Fflag = 'F';
} elsif ($opt =~ /^--gtags$/) {
- $'gflag = 'g';
+ $gflag = 'g';
} elsif ($opt =~ /^--gtagsconf=(.*)$/) {
; # --gtagsconf is estimated only once.
} elsif ($opt =~ /^--gtagsconf$/) {
@@ -639,53 +521,53 @@
} elsif ($opt =~ /^--gtagslabel$/) {
shift; # --gtagslabel is estimated only once.
} elsif ($opt =~ /^--no-map-file$/) {
- $'map_file = 0;
+ $map_file = 0;
} elsif ($opt =~ /^--line-number$/) {
- $'nflag = 'n';
+ $nflag = 'n';
} elsif ($opt =~ /^--other$/) {
- $'oflag = 'o';
+ $oflag = 'o';
} elsif ($opt =~ /^--style-sheet=(.*)$/) {
- $'style_sheet = $1;
+ $style_sheet = $1;
} elsif ($opt =~ /^--style-sheet$/) {
- $'style_sheet = shift;
+ $style_sheet = shift;
} elsif ($opt =~ /^--symbol$/) {
- $'symbol = 1;
+ $symbol = 1;
} elsif ($opt =~ /^--symbols$/) { # for backward
compatibility
- $'symbol = 1;
+ $symbol = 1;
} elsif ($opt =~ /^--verbose$/) {
- $'vflag = 'v';
+ $vflag = 'v';
} elsif ($opt =~ /^--warning$/) {
- $'wflag = 'w';
+ $wflag = 'w';
} elsif ($opt =~ /^--caution$/) {
- $'include_caution = $'caution_message;
+ $include_caution = $caution_message;
} elsif ($opt =~ /^--title=(.*)$/) {
- $'title = $1;
+ $title = $1;
} elsif ($opt =~ /^--title$/) {
- $'title = shift;
+ $title = shift;
} elsif ($opt =~ /^--dbpath$/) {
$opt = shift;
last if ($opt eq '');
$dbpath = $opt;
} elsif ($opt =~ /^--main-func=(.*)$/) {
- $'main_func = $1;
+ $main_func = $1;
} elsif ($opt =~ /^--main-func$/) {
- $'main_func = shift;
+ $main_func = shift;
} elsif ($opt =~ /^--secure-cgi=(.*)$/) {
- $'Sflag = 'S';
- $'cgidir = $1;
+ $Sflag = 'S';
+ $cgidir = $1;
} elsif ($opt =~ /^--secure-cgi$/) {
- $'Sflag = 'S';
- $'cgidir = shift;
+ $Sflag = 'S';
+ $cgidir = shift;
} elsif ($opt =~ /^--statistics$/) {
- $'statistics = 1;
+ $statistics = 1;
} elsif ($opt =~ /^--cvsweb=(.*)$/) {
- $'cvsweb_url = $1;
+ $cvsweb_url = $1;
} elsif ($opt =~ /^--cvsweb$/) {
- $'cvsweb_url = shift;
+ $cvsweb_url = shift;
} elsif ($opt =~ /^--cvsweb-cvsroot=(.*)$/) {
- $'cvsweb_cvsroot = $1;
+ $cvsweb_cvsroot = $1;
} elsif ($opt =~ /^--cvsweb-cvsroot$/) {
- $'cvsweb_cvsroot = shift;
+ $cvsweb_cvsroot = shift;
} elsif ($opt =~ /^--/) {
print STDERR "$program: unrecognized option `$opt'\n";
print STDERR $usage_const, "\n";
@@ -696,17 +578,17 @@
print STDERR $usage_const, "\n";
exit 1;
} else {
- if ($opt =~ /a/) { $'aflag = 'a'; }
- if ($opt =~ /c/) { $'cflag = 'c'; }
- if ($opt =~ /D/) { $'Dflag = 'd'; }
- if ($opt =~ /f/) { $'fflag = 'f'; }
- if ($opt =~ /F/) { $'Fflag = 'F'; }
- if ($opt =~ /g/) { $'gflag = 'g'; }
- if ($opt =~ /n/) { $'nflag = 'n'; }
- if ($opt =~ /o/) { $'oflag = 'o'; }
- if ($opt =~ /s/) { $'sflag = 's'; }
- if ($opt =~ /v/) { $'vflag = 'v'; }
- if ($opt =~ /w/) { $'wflag = 'w'; }
+ if ($opt =~ /a/) { $aflag = 'a'; }
+ if ($opt =~ /c/) { $cflag = 'c'; }
+ if ($opt =~ /D/) { $Dflag = 'd'; }
+ if ($opt =~ /f/) { $fflag = 'f'; }
+ if ($opt =~ /F/) { $Fflag = 'F'; }
+ if ($opt =~ /g/) { $gflag = 'g'; }
+ if ($opt =~ /n/) { $nflag = 'n'; }
+ if ($opt =~ /o/) { $oflag = 'o'; }
+ if ($opt =~ /s/) { $sflag = 's'; }
+ if ($opt =~ /v/) { $vflag = 'v'; }
+ if ($opt =~ /w/) { $wflag = 'w'; }
if ($opt =~ /t/) {
$opt = shift;
last if ($opt eq '');
@@ -718,15 +600,16 @@
} elsif ($opt =~ /m/) {
$opt = shift;
last if ($opt eq '');
- $'main_func = $opt;
+ $main_func = $opt;
} elsif ($opt =~ /S/) {
- $'Sflag = 'S';
- $'cgidir = shift;
+ $Sflag = 'S';
+ $cgidir = shift;
}
}
}
+my $HTML = ($cflag) ? $gzipped_suffix : $normal_suffix;
if ($show_version) {
- local($command) = 'global --version';
+ my $command = 'global --version';
$command .= ' --verbose' if ($vflag);
$command .= ' htags';
system($command);
@@ -736,40 +619,40 @@
print STDOUT $help_const;
exit 0;
}
-if ($'gflag) {
- local($command) = $'gtags;
- $command .= " -v" if ($'vflag);
- $command .= " -w" if ($'wflag);
- $command .= " -I" if ($'enable_idutils);
+if ($gflag) {
+ my $command = $gtags;
+ $command .= " -v" if ($vflag);
+ $command .= " -w" if ($wflag);
+ $command .= " -I" if ($enable_idutils);
$command .= " $dbpath" if ($dbpath);
system($command);
- if ($?) { &'error("cannot execute gtags(1) command."); }
+ if ($?) { error("cannot execute gtags(1) command."); }
}
-if ($'cflag && !&'usable('gzip')) {
+if ($cflag && !usable('gzip')) {
print STDERR "Warning: 'gzip' command not found. -c option
ignored.\n";
- $'cflag = '';
+ $cflag = '';
}
-if ($'Dflag) {
- $'dynamic = 1;
+if ($Dflag) {
+ $dynamic = 1;
}
-if ($'oflag) {
- $'other_files = 1;
+if ($oflag) {
+ $other_files = 1;
}
-if ($'sflag) {
- $'symbol = 1;
+if ($sflag) {
+ $symbol = 1;
}
if (!$title) {
- @cwd = split('/', &'getcwd);
+ my @cwd = split('/', getcwd());
$title = $cwd[$#cwd];
}
-if ($'Dflag && $'Sflag) {
- &'error("Current implementation doesn't allow both -D(--dynamic)
and the -S(--secure-cgi).");
+if ($Dflag && $Sflag) {
+ error("Current implementation doesn't allow both -D(--dynamic)
and the -S(--secure-cgi).");
}
#
# load style sheet.
#
if ($style_sheet) {
- local($style_path) = $style_sheet;
+ my $style_path = $style_sheet;
$style_sheet = '';
if (open(SHEET, $style_path)) {
while (<SHEET>) {
@@ -783,31 +666,31 @@
#
# decide directory in which we make hypertext.
#
-$dist = &'getcwd() . '/HTML';
+my $dist = getcwd() . '/HTML';
if ($ARGV[0]) {
- $cwd = &'getcwd();
+ my $cwd = getcwd();
unless (-w $ARGV[0]) {
- &'error("'$ARGV[0]' is not writable directory.");
+ 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.");
-}
-if ($'Sflag) {
- $'action = "$'script_alias/global.cgi";
- $'id = $dist;
+ chdir($ARGV[0]) || error("directory '$ARGV[0]' not found.");
+ $dist = getcwd() . '/HTML';
+ chdir($cwd) || error("cannot return to original directory.");
+}
+if ($Sflag) {
+ $action = "$script_alias/global.cgi";
+ $id = $dist;
}
# --action, --id overwrite Sflag's value.
if ($action_value) {
- $'action = $action_value;
+ $action = $action_value;
}
if ($id_value) {
- $'id = $id_value;
+ $id = $id_value;
}
# If $dbpath is not specified then listen to global(1).
if (!$dbpath) {
- local($cwd) = &'getcwd();
- local($root) = `global -pqr`;
+ my $cwd = getcwd();
+ my $root = `global -pqr`;
chop($root);
if ($cwd eq $root) {
$dbpath = `global -pq`;
@@ -817,30 +700,164 @@
}
}
unless (-r "$dbpath/GTAGS" && -r "$dbpath/GRTAGS") {
- &'error("GTAGS and/or GRTAGS not found. Htags needs both of
them.");
+ error("GTAGS and/or GRTAGS not found. Htags needs both of
them.");
}
-if ($'symbol && ! -r "$dbpath/GSYMS") {
- &'error("-s(--symbol) option needs GSYMS tag file.");
+if ($symbol && ! -r "$dbpath/GSYMS") {
+ error("-s(--symbol) option needs GSYMS tag file.");
}
-$dbpath = &'realpath($dbpath);
+$dbpath = realpath($dbpath);
#
# for global(1)
#
-$ENV{'GTAGSROOT'} = &'getcwd();
+$ENV{'GTAGSROOT'} = getcwd();
$ENV{'GTAGSDBPATH'} = $dbpath;
delete $ENV{'GTAGSLIBPATH'};
#
# check directories
#
-if ($'fflag || $'cflag || $'dynamic) {
- if ($'cgidir && ! -d $'cgidir) {
- &'error("'$'cgidir' not found.");
+if ($fflag || $cflag || $dynamic) {
+ if ($cgidir && ! -d $cgidir) {
+ error("'$cgidir' not found.");
}
- if (!$'Sflag) {
- $'cgidir = "$dist/cgi-bin";
+ if (!$Sflag) {
+ $cgidir = "$dist/cgi-bin";
}
} else {
- $'Sflag = $'cgidir = '';
+ $Sflag = $cgidir = '';
+}
+#----------------------------------------------------------------------
---
+# UTILITIES
+#----------------------------------------------------------------------
---
+#
+# get current working directory.
+#
+sub getcwd {
+ my $dir = `$gtags --pwd`;
+ if ($w32) { $dir =~ s!\\!/!g; }
+ chomp($dir);
+ $dir;
+}
+#
+# get real absolute path name.
+#
+sub realpath {
+ my $path = shift;
+ my $cwd = getcwd(); # for recovery
+ my $real; # real directory
+
+ if (! -d $path && ! -f $path) {
+ error("'$path' not found.");
+ }
+ my ($dir, $file) = ($path =~ m#^(.*/)?(.*)#);
+ if ($dir) {
+ chdir($dir) || error("directory '$dir' not found.");
+ }
+ $real = &getcwd;
+ $path = $real . '/' . $file;
+ $path =~ s!//!/!;
+ chdir($cwd) || error("cannot recover current directory
'$cwd'.");
+ $path;
+}
+#
+# get date string.
+#
+sub date {
+ my $date = `$gtags --date`;
+ chomp($date);
+ $date;
+}
+#
+# print message and exit with error status.
+#
+sub error {
+ clean();
+ printf STDERR "$program: $_[0]\n";
+ exit 1;
+}
+#
+# set things right before exiting.
+#
+sub clean {
+ cache::close();
+}
+#
+# locate executable command and return it's absolute path name.
+#
+sub usable {
+ my $command = shift;
+ my $pathsep = ($w32) ? ';' : ':';
+ foreach (split(/$pathsep/, $ENV{'PATH'})) {
+ if ($w32) {
+ return "$_\\$command.com" if (-f
"$_\\$command.com");
+ return "$_\\$command.exe" if (-f
"$_\\$command.exe");
+ } else {
+ return "$_/$command" if (-x "$_/$command");
+ }
+ }
+ return '';
+}
+#
+# duplicate file. if possible, link it without making a copy.
+#
+sub duplicatefile {
+ my ($file, $from, $to) = @_;
+ if ($w32) {
+ copy("$from/$file", "$to/$file")
+ } else {
+ link("$from/$file", "$to/$file")
+ || copy("$from/$file", "$to/$file")
+ }
+}
+#
+# copy file.
+#
+sub copy {
+ my ($from, $to) = @_;
+ my $command = ($w32) ? 'copy' : 'cp';
+ $command .= " $from $to";
+ $command =~ s!/!\\!g if ($w32);
+ system($command);
+ if ($? != 0) {
+ error("cannot execute '$command'.");
+ }
+ return 1;
+}
+#
+# get value of configuration variable.
+#
+sub getconf
+{
+ my $name = shift;
+ my $val;
+ chomp($val = `$gtags --config $name`);
+ if ($? != 0) {
+ error("cannot get config value.");
+ }
+ $val;
+}
+#
+# convert source file path name into url.
+#
+sub path2url {
+ my $path = shift;
+ $path = './' . $path if ($path !~ /^\./);
+ if (!defined($GPATH{$path})) {
+ $GPATH{$path} = ++$nextkey;
+ }
+ $GPATH{$path} . '.' . $HTML;
+}
+#
+# return header.
+#
+sub set_header {
+ my $title = shift;
+ my $head = '';
+ $head .= "<HEAD>\n";
+ $head .= "<TITLE>$title</TITLE>\n";
+ $head .= "$meta_robots\n$meta_generator\n";
+ $head .= $style_sheet if ($style_sheet);
+ $head .= "</HEAD>\n";
+ $head;
}
#-----------------------------------------------------------------------
--
# MAKE FILES
@@ -863,183 +880,193 @@
# HTML/I/ ... include file index (9)
# HTML/rebuild.sh ... rebuild script (10)
#-----------------------------------------------------------------------
--
-$'HTML = ($'cflag) ? $'gzipped_suffix : $'normal_suffix;
-print STDERR "[", &'date, "] ", "Htags started\n" if ($'vflag);
-$start_all_time = time();
+print STDERR "[", date, "] ", "Htags started\n" if ($vflag);
+my $start_all_time = time();
#
# (#) check if GTAGS, GRTAGS is the latest.
#
-if (!$'w32) {
- $mtime_argc = 9;
- print STDERR "[", &'date, "] ", "(#) checking tag files ...\n"
if ($'vflag);
- $gtags_mtime = (stat("$dbpath/GTAGS"))[$mtime_argc];
- open(FIND, "$'findcom |") || &'error("cannot fork.");
+if (!$w32) {
+ my $mtime_argc = 9;
+ print STDERR "[", date, "] ", "(#) checking tag files ...\n" if
($vflag);
+ my $gtags_mtime = (stat("$dbpath/GTAGS"))[$mtime_argc];
+ open(FIND, "$findcom |") || error("cannot fork.");
while (<FIND>) {
chop;
if ($gtags_mtime < (stat($_))[$mtime_argc]) {
- &'error("GTAGS is not the latest one. Please
execute gtags(1) again.");
+ error("GTAGS is not the latest one. Please
execute gtags(1) again.");
}
}
close(FIND);
- if ($?) { &'error("cannot traverse directory."); }
+ if ($?) { error("cannot traverse directory."); }
}
#
# (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 (&'get_dirlist()) {
- mkdir("$dist/$d", 0775) || &'error("cannot make HTML directory")
if (! -d "$dist/$d");
+print STDERR "[", date, "] ", "(0) making directories ...\n" if
($vflag);
+mkdir($dist, 0777) || error("cannot make directory '$dist'.") if (! -d
$dist);
+foreach my $d (get_dirlist()) {
+ mkdir("$dist/$d", 0775) || error("cannot make HTML directory")
if (! -d "$dist/$d");
}
-if ($'cgi && ($'fflag || $'cflag || $'dynamic)) {
- mkdir("$dist/cgi-bin", 0775) || &'error("cannot make cgi-bin
directory") if (! -d "$dist/cgi-bin");
+if ($cgi && ($fflag || $cflag || $dynamic)) {
+ mkdir("$dist/cgi-bin", 0775) || error("cannot make cgi-bin
directory") if (! -d "$dist/cgi-bin");
}
#
# (1) make CGI program
#
-if ($'cgi && ($'fflag || $'dynamic)) {
- if ($'cgidir) {
- print STDERR "[", &'date, "] ", "(1) making CGI program
...\n" if ($'vflag);
- &makeprogram("$cgidir/global.cgi");
- chmod(0755, "$cgidir/global.cgi") || &'error("cannot
chmod CGI program.");
+if ($cgi && ($fflag || $dynamic)) {
+ if ($cgidir) {
+ print STDERR "[", date, "] ", "(1) making CGI program
...\n" if ($vflag);
+ makeprogram("$cgidir/global.cgi");
+ chmod(0755, "$cgidir/global.cgi") || error("cannot chmod
CGI program.");
}
# Always make bless.sh.
# Don't grant execute permission to bless script.
- &makebless("$dist/bless.sh");
- chmod(0640, "$dist/bless.sh") || &'error("cannot chmod bless
script.");
+ makebless("$dist/bless.sh");
+ chmod(0640, "$dist/bless.sh") || error("cannot chmod bless
script.");
- foreach $f ('GTAGS', 'GRTAGS', 'GSYMS', 'GPATH') {
+ foreach my $f ('GTAGS', 'GRTAGS', 'GSYMS', 'GPATH') {
if (-f "$dbpath/$f") {
unlink("$dist/cgi-bin/$f");
- &duplicatefile($f, $dbpath, "$dist/cgi-bin");
+ duplicatefile($f, $dbpath, "$dist/cgi-bin");
}
}
} else {
- print STDERR "[", &'date, "] ", "(1) making CGI program
...(skipped)\n" if ($'vflag);
+ print STDERR "[", date, "] ", "(1) making CGI program
...(skipped)\n" if ($vflag);
}
-if ($'cgi && $'cflag) {
- &makehtaccess("$dist/.htaccess");
- chmod(0644, "$dist/.htaccess") || &'error("cannot chmod
.htaccess skeleton.");
- if ($'cgidir) {
- &makeghtml("$cgidir/ghtml.cgi") || &'error("cannot make
unzip script.");
- chmod(0755, "$cgidir/ghtml.cgi") || &'error("cannot
chmod unzip script.");
+if ($cgi && $cflag) {
+ makehtaccess("$dist/.htaccess");
+ chmod(0644, "$dist/.htaccess") || error("cannot chmod .htaccess
skeleton.");
+ if ($cgidir) {
+ makeghtml("$cgidir/ghtml.cgi") || error("cannot make
unzip script.");
+ chmod(0755, "$cgidir/ghtml.cgi") || error("cannot chmod
unzip script.");
}
}
#
# (2) make help file
#
-print STDERR "[", &'date, "] ", "(2) making help.html ...\n" if
($'vflag);
-&makehelp("$dist/help.$'normal_suffix");
+print STDERR "[", date, "] ", "(2) making help.html ...\n" if ($vflag);
+makehelp("$dist/help.$normal_suffix");
#
# (#) load GPATH
#
-local($command) = "$'gtags --scandb=\"$dbpath/GPATH\" \"./\"";
-open(GPATH, "$command |") || &'error("cannot fork.");
-$nextkey = 0;
+my $command = "$gtags --scandb=\"$dbpath/GPATH\" \"./\"";
+open(GPATH, "$command |") || error("cannot fork.");
while (<GPATH>) {
chop;
- local($path, $no) = split;
- $'GPATH{$path} = $no;
+ my ($path, $no) = split;
+ $GPATH{$path} = $no;
if ($no > $nextkey) {
$nextkey = $no;
}
}
close(GPATH);
-if ($?) {&'error("'$command' failed."); }
+if ($?) {error("'$command' failed."); }
#
# (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}
+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();
-$start_time = time();
-$func_total = &makedupindex($dist);
-$end_time = time();
-print STDERR "Total $func_total functions.\n" if ($'vflag);
-$T_makedupindex = $end_time - $start_time;
+
+cache::open();
+
+my $start_time = time();
+my $func_total = makedupindex($dist);
+my $end_time = time();
+print STDERR "Total $func_total functions.\n" if ($vflag);
+my $T_makedupindex = $end_time - $start_time;
+
+cache::clearup();
+cache::open();
+
#
# (4) search index. (search.html)
#
-if ($'Fflag && $'fflag) {
- print STDERR "[", &'date, "] ", "(4) making search index ...\n"
if ($'vflag);
- &makesearchindex("$dist/search.$'normal_suffix");
+if ($Fflag && $fflag) {
+ print STDERR "[", date, "] ", "(4) making search index ...\n" if
($vflag);
+ makesearchindex("$dist/search.$normal_suffix");
}
#
# (5) make function index (defines.html and defines/*)
# PRODUCE @defines
#
-print STDERR "[", &'date, "] ", "(5) making function index ...\n" if
($'vflag);
-sub suddenly { &'clean(); exit 1}
+print STDERR "[", date, "] ", "(5) making function index ...\n" if
($vflag);
+sub suddenly { clean(); exit 1}
$start_time = time();
-$func_total = &makedefineindex($dist, "$dist/defines.$'normal_suffix",
$func_total);
+my @defines;
+$func_total = makedefineindex($dist, "$dist/defines.$normal_suffix",
$func_total);
$end_time = time();
-print STDERR "Total $func_total functions.\n" if ($'vflag);
-$T_makedefineindex = $end_time - $start_time;
+print STDERR "Total $func_total functions.\n" if ($vflag);
+my $T_makedefineindex = $end_time - $start_time;
+
+cache::clearup();
+cache::open();
+
#
# (6) make file index (files.html and files/*)
# PRODUCE @files %includes
#
-print STDERR "[", &'date, "] ", "(6) making file index ...\n" if
($'vflag);
+print STDERR "[", date, "] ", "(6) making file index ...\n" if
($vflag);
$start_time = time();
-$file_total = &makefileindex($dist, "$dist/files.$'normal_suffix",
"$dist/$INCS");
+my (@files, %includes, %included_from);
+my $file_total = makefileindex($dist, "$dist/files.$normal_suffix",
"$dist/$INCS");
$end_time = time();
-print STDERR "Total $file_total files.\n" if ($'vflag);
-$T_makefileindex = $end_time - $start_time;
+print STDERR "Total $file_total files.\n" if ($vflag);
+my $T_makefileindex = $end_time - $start_time;
$file_count += $file_total;
#
# [#] make a common part for mains.html and index.html
# USING @defines @files
#
-print STDERR "[", &'date, "] ", "(#) making a common part ...\n" if
($'vflag);
-$index = &makecommonpart($title);
+print STDERR "[", date, "] ", "(#) making a common part ...\n" if
($vflag);
+my $index = makecommonpart($title);
#
# (7)make index file (index.html)
#
-print STDERR "[", &'date, "] ", "(7) making index file ...\n" if
($'vflag);
-&makeindex("$dist/index.$'normal_suffix", $title, $index);
+print STDERR "[", date, "] ", "(7) making index file ...\n" if
($vflag);
+makeindex("$dist/index.$normal_suffix", $title, $index);
#
# (8) make main index (mains.html)
#
-print STDERR "[", &'date, "] ", "(8) making main index ...\n" if
($'vflag);
-&makemainindex("$dist/mains.$'normal_suffix", $index);
+print STDERR "[", date, "] ", "(8) making main index ...\n" if
($vflag);
+makemainindex("$dist/mains.$normal_suffix", $index);
#
# (9) make HTML files ($SRCS/*)
# USING TAG CACHE, %includes and anchor database.
#
-print STDERR "[", &'date, "] ", "(9) making hypertext from source code
...\n" if ($'vflag);
+print STDERR "[", date, "] ", "(9) making hypertext from source code
...\n" if ($vflag);
$start_time = time();
-&makehtml($dist, $file_total);
+makehtml($dist, $file_total);
$end_time = time();
-$T_makehtml = $end_time - $start_time;
+my $T_makehtml = $end_time - $start_time;
#
# (10) rebuild script. (rebuild.sh)
#
# Don't grant execute permission to rebuild script.
-&makerebuild("$dist/rebuild.sh");
-chmod(0640, "$dist/rebuild.sh") || &'error("cannot chmod rebuild
script.");
+makerebuild("$dist/rebuild.sh");
+chmod(0640, "$dist/rebuild.sh") || error("cannot chmod rebuild
script.");
-&'clean();
+clean();
-$end_all_time = time();
-print STDERR "[", &'date, "] ", "Done.\n" if ($'vflag);
-$T_all = $end_all_time - $start_all_time;
-if ($'vflag && $'cgi && ($'cflag || $'fflag)) {
+my $end_all_time = time();
+print STDERR "[", date, "] ", "Done.\n" if ($vflag);
+my $T_all = $end_all_time - $start_all_time;
+if ($vflag && $cgi && ($cflag || $fflag)) {
print STDERR "\n";
print STDERR "[Information]\n";
print STDERR "\n";
- if ($'cflag) {
- print STDERR " Your system may need to be setup to
decompress *.$'gzipped_suffix files.\n";
+ if ($cflag) {
+ print STDERR " Your system may need to be setup to
decompress *.$gzipped_suffix files.\n";
print STDERR " This can be done by having your browser
compiled with the relevant\n";
print STDERR " options, or by configuring your http
server to treat these as\n";
print STDERR " gzipped files. (Please see
'HTML/.htaccess')\n";
print STDERR "\n";
}
- if ($'fflag || $'dynamic) {
- local($path) = ($'action =~ /^\//) ?
"DOCUMENT_ROOT$'action" : "HTML/$'action";
+ if ($fflag || $dynamic) {
+ my $path = ($action =~ /^\//) ? "DOCUMENT_ROOT$action" :
"HTML/$action";
print STDERR " You need to setup http server so that
$path\n";
print STDERR " is executed as a CGI script.
(DOCUMENT_ROOT means WWW server's data root.)\n";
print STDERR "\n";
@@ -1048,15 +1075,15 @@
print STDERR "\n";
}
# This is not supported.
-if ($'icon_list && -f $'icon_list) {
- system("tar xzf $'icon_list -C $dist");
+if ($icon_list && -f $icon_list) {
+ system("tar xzf $icon_list -C $dist");
}
# include epilog_script if needed.
-require($'epilog_script) if ($'epilog_script && -f $'epilog_script);
+require($epilog_script) if ($epilog_script && -f $epilog_script);
#
# Print statistics information.
#
-if ($'statistics) {
+if ($statistics) {
printf STDERR "- Elapsed time of making duplicate entries
............ %10d seconds.\n", $T_makedupindex;
printf STDERR "- Elapsed time of making function index
............... %10d seconds.\n", $T_makedefineindex;
printf STDERR "- Elapsed time of making file index
................... %10d seconds.\n", $T_makefileindex;
@@ -1071,12 +1098,12 @@
# makeprogram: make CGI program
#
sub makeprogram {
- local($file) = @_;
- local($globalpath) = &'usable('global');
- local($gtagspath) = &'usable('gtags');
+ my $file = shift;
+ my $globalpath = usable('global');
+ my $gtagspath = usable('gtags');
- open(PROGRAM, ">$file") || &'error("cannot make CGI program.");
- local($script) = <<'END_OF_SCRIPT';
+ open(PROGRAM, ">$file") || error("cannot make CGI program.");
+ my $script = <<'END_OF_SCRIPT';
#! @PERL@
#------------------------------------------------------------------
# SORRY TO HAVE SURPRISED YOU!
@@ -1084,10 +1111,11 @@
# 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.
#------------------------------------------------------------------
+use strict;
print "Content-type: text/html\n\n";
print "@address@hidden";
print "@address@hidden";
-$htmlbase = $ENV{'HTTP_REFERER'};
+my $htmlbase = $ENV{'HTTP_REFERER'};
if (!$htmlbase) {
print "<H1><FONT COLOR=#cc0000>Error</FONT></H1>\n";
print "<H3>Your browser doesn't send HTTP_REFERER.</H3>\n";
@@ -1106,9 +1134,10 @@
print "@address@hidden";
exit 0;
}
address@hidden = split (/&/, $ENV{'QUERY_STRING'});
-foreach $p (@pairs) {
- ($name, $value) = split(/=/, $p);
+my @pairs = split (/&/, $ENV{'QUERY_STRING'});
+my %form;
+foreach my $p (@pairs) {
+ my ($name, $value) = split(/=/, $p);
$value =~ tr/+/ /;
$value =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack("C", hex($1))/eg;
$form{$name} = $value;
@@ -1120,10 +1149,10 @@
print "@address@hidden";
exit 0;
}
-$pattern = $form{'pattern'};
-$from = $form{'from'};
-$flag = '';
-$words = 'definitions';
+my $pattern = $form{'pattern'};
+my $from = $form{'from'};
+my $flag = '';
+my $words = 'definitions';
if ($form{'type'} eq 'reference') {
$flag = 'r';
$words = 'references';
@@ -1140,11 +1169,11 @@
$flag = 'I';
$words = 'patterns';
}
-$iflag = '';
+my $iflag = '';
if ($form{'icase'}) {
$iflag = 'i';
}
-$oflag = '';
+my $oflag = '';
if ($form{'other'} && $flag eq 'g') {
$oflag = 'o';
}
@@ -1182,7 +1211,7 @@
chdir("../..");
}
}
-local(%ctab) = ('&', '&', '<', '<', '>', '>');
+my %ctab = ('&', '&', '<', '<', '>', '>');
if ($form{'type'} eq 'source') {
open(PIPE, "-|") || exec '@gtagspath@', '--secure', '--expand',
'address@hidden@', './'.$pattern;
if ($?) {
@@ -1218,8 +1247,8 @@
$pattern =~ s/([&<>])/$ctab{$1}/ge;
print "<H1><FONT COLOR=#cc0000>" . $pattern . "</FONT></H1>\n";
print "Following $words are matched to above address@hidden@\n";
-$cnt = 0;
-local($tag, $lno, $filename, $fileno);
+my $cnt = 0;
+my ($tag, $lno, $filename, $fileno);
print "<PRE>\n";
open(PIPEOUT, "| @gtagspath@ --convert");
if ($?) {
@@ -1256,34 +1285,34 @@
#------------------------------------------------------------------
END_OF_SCRIPT
- $quoted_body_begin = $'body_begin;
+ my $quoted_body_begin = $body_begin;
$quoted_body_begin =~ s/"/\\"/g;
- $quoted_body_end = $'body_end;
+ my $quoted_body_end = $body_end;
$quoted_body_end =~ s/"/\\"/g;
- $script =~ s/address@hidden@/$'html_begin/g;
- $script =~ s/address@hidden@/$'html_end/g;
+ $script =~ s/address@hidden@/$html_begin/g;
+ $script =~ s/address@hidden@/$html_end/g;
$script =~ s/address@hidden@/$quoted_body_begin/g;
$script =~ s/address@hidden@/$quoted_body_end/g;
- $script =~ s/address@hidden@/$'normal_suffix/g;
- $script =~ s/address@hidden@/$'SRCS/g;
- $script =~ s/address@hidden@/$'HTML/g;
- $script =~ s/address@hidden@/$'tabs/g;
- $script =~ s/address@hidden@/$'hr/g;
+ $script =~ s/address@hidden@/$normal_suffix/g;
+ $script =~ s/address@hidden@/$SRCS/g;
+ $script =~ s/address@hidden@/$HTML/g;
+ $script =~ s/address@hidden@/$tabs/g;
+ $script =~ s/address@hidden@/$hr/g;
$script =~ s/address@hidden@/$globalpath/g;
$script =~ s/address@hidden@/$gtagspath/g;
print PROGRAM $script;
- close(PROGRAM) || &'error("cannot make CGI program.");
- $'file_count++;
+ close(PROGRAM) || error("cannot make CGI program.");
+ $file_count++;
}
#
# makebless: make bless script
#
sub makebless {
- local($file) = @_;
- local($action) = "$'script_alias/global.cgi";
+ my $file = shift;
+ my $action = "$script_alias/global.cgi";
- open(SCRIPT, ">$file") || &'error("cannot make bless script.");
- local($script) = <<'END_OF_SCRIPT';
+ open(SCRIPT, ">$file") || error("cannot make bless script.");
+ my $script = <<'END_OF_SCRIPT';
#!/bin/sh
#
# Bless.sh: rewrite id's value of html for centralised cgi script.
@@ -1314,22 +1343,22 @@
done
rm -f cgi-bin/global.cgi
END_OF_SCRIPT
- $script =~ s/address@hidden@/$'null_device/g;
+ $script =~ s/address@hidden@/$null_device/g;
$script =~ s/address@hidden@/$action/g;
print SCRIPT $script;
- close(SCRIPT) || &'error("cannot make bless script.");
+ close(SCRIPT) || error("cannot make bless script.");
}
#
# makeghtml: make unzip script
#
sub makeghtml {
- local($file) = @_;
- open(PROGRAM, ">$file") || &'error("cannot make unzip script.");
- local($script) = <<END_OF_SCRIPT;
+ my $file = shift;
+ open(PROGRAM, ">$file") || error("cannot make unzip script.");
+ my $script = <<END_OF_SCRIPT;
#!/bin/sh
echo "content-type: text/html"
echo
-gzip -S $'HTML -d -c "\$PATH_TRANSLATED"
+gzip -S $HTML -d -c "\$PATH_TRANSLATED"
END_OF_SCRIPT
print PROGRAM $script;
@@ -1339,9 +1368,9 @@
# makehtaccess: make .htaccess skeleton file.
#
sub makehtaccess {
- local($file) = @_;
- open(SKELETON, ">$file") || &'error("cannot make .htaccess
skeleton file.");
- $skeleton = <<END_OF_SCRIPT;
+ my $file = shift;
+ open(SKELETON, ">$file") || error("cannot make .htaccess
skeleton file.");
+ my $skeleton = <<END_OF_SCRIPT;
#
# Skelton file for .htaccess -- This file was generated by htags(1).
#
@@ -1353,19 +1382,19 @@
#
# Please rewrite '/cgi-bin/ghtml.cgi' to the true value in your web
site.
#
-AddHandler htags-gzipped-html $'gzipped_suffix
+AddHandler htags-gzipped-html $gzipped_suffix
Action htags-gzipped-html /cgi-bin/ghtml.cgi
END_OF_SCRIPT
print SKELETON $skeleton;
- close(SKELETON) || &'error("cannot make .htaccess skeleton.");
+ close(SKELETON) || error("cannot make .htaccess skeleton.");
}
#
# makerebuild: make rebuild script
#
sub makerebuild {
- local($file) = @_;
- local($cwd) = getcwd;
- open(FILE, ">$file") || &'error("cannot make rebuild script.");
+ my $file = shift;
+ my $cwd = getcwd();
+ open(FILE, ">$file") || error("cannot make rebuild script.");
print FILE "#!/bin/sh\n";
print FILE "#\n";
print FILE "# rebuild.sh: rebuild hypertext with the previous
context.\n";
@@ -1380,21 +1409,21 @@
# makehelp: make help file
#
sub makehelp {
- local($file) = @_;
- local(@label) = ($'icon_list) ? @'anchor_comment :
@'anchor_label;
- local(@icons) = @'anchor_icons;
- local(@msg) = @'anchor_msg;
-
- open(HELP, ">$file") || &'error("cannot make help file.");
- print HELP $'html_begin, "\n";
- print HELP &'set_header('HELP');
- print HELP $'body_begin, "\n";
+ my $file = shift;
+ my @label = ($icon_list) ? @anchor_comment : @anchor_label;
+ my @icons = @anchor_icons;
+ my @msg = @anchor_msg;
+
+ open(HELP, ">$file") || error("cannot make help file.");
+ print HELP $html_begin, "\n";
+ print HELP set_header('HELP');
+ print HELP $body_begin, "\n";
print HELP "<H2>Usage of Links</H2>\n";
print HELP "<PRE>/* ";
- foreach $n (0 .. $#label) {
- if ($'icon_list) {
- print HELP "<IMG SRC=icons/$icons[$n]
ALT=\[$label[$n]\] $'icon_spec>";
+ foreach my $n (0 .. $#label) {
+ if ($icon_list) {
+ print HELP "<IMG SRC=icons/$icons[$n]
ALT=\[$label[$n]\] $icon_spec>";
if ($n < $#label) {
print HELP " ";
}
@@ -1402,29 +1431,29 @@
print HELP "\[$label[$n]\]";
}
}
- if ($'show_position) {
+ if ($show_position) {
print HELP "[+line file]";
}
print HELP " */</PRE>\n";
print HELP "<DL>\n";
- foreach $n (0 .. $#label) {
+ foreach my $n (0 .. $#label) {
print HELP "<DT>";
- if ($'icon_list) {
- print HELP "<IMG SRC=icons/$icons[$n]
ALT=\[$label[$n]\] $'icon_spec>";
+ if ($icon_list) {
+ print HELP "<IMG SRC=icons/$icons[$n]
ALT=\[$label[$n]\] $icon_spec>";
} else {
print HELP "[$label[$n]]";
}
print HELP "<DD>$msg[$n]\n";
}
- if ($'show_position) {
+ if ($show_position) {
print HELP "<DT>[+line file]";
print HELP "<DD>Current position (line number and file
name).\n";
}
print HELP "</DL>\n";
- print HELP $'body_end, "\n";
- print HELP $'html_end, "\n";
+ print HELP $body_end, "\n";
+ print HELP $html_end, "\n";
close(HELP);
- $'file_count++;
+ $file_count++;
}
#
# makedupindex: make duplicate entries index (D/*, R/* and Y/*)
@@ -1433,63 +1462,63 @@
# r) $count
#
sub makedupindex {
- local($dist) = @_;
- local($definition_count) = 0;
- local($srcdir) = "../$'SRCS";
- local(%kind) = ('GTAGS', 'definition', 'GRTAGS', 'reference',
'GSYMS', 'symbol');
- local(%dir) = &'get_dirhash();
- local($flag) = ($'cflag) ? 'C' : 'N';
+ my $dist = shift;
+ my $definition_count = 0;
+ my $srcdir = "../$SRCS";
+ my %kind = ('GTAGS', 'definition', 'GRTAGS', 'reference',
'GSYMS', 'symbol');
+ my %dir = get_dirhash();
+ my $flag = ($cflag) ? 'C' : 'N';
#
# Gtags with --write option create file and put data for each
# duplicate entries index.
#
- if (!$'dynamic) {
- open(FILE, "| $'gtags --write") || &'error("cannot
fork.");
+ if (!$dynamic) {
+ open(FILE, "| $gtags --write") || error("cannot fork.");
}
- foreach $db (&'get_taglist()) {
- local($kind) = $kind{$db};
- local($option) = &'get_option($db);
- local($prev) = '';
- local($first_line);
- local($writing) = 0;
- local($count) = 0;
- local($entry_count) = 0;
- local($command);
+ foreach my $db (get_taglist()) {
+ my $kind = $kind{$db};
+ my $option = get_option($db);
+ my $prev = '';
+ my $first_line;
+ my $writing = 0;
+ my $count = 0;
+ my $entry_count = 0;
+ my $command;
#
# It is not necessary to sort here. In addition, the
line
# image of the source code is also unnecessary with the
# --dynamic option,
#
- $option .= $'dynamic ? 'nn' : 'n';
+ $option .= $dynamic ? 'nn' : 'n';
- $command = "global -x$option \".*\" | $'gtags --sort";
- open(LIST, "$command |") || &'error("cannot fork.");
+ $command = "global -x$option \".*\" | $gtags --sort";
+ open(LIST, "$command |") || error("cannot fork.");
while (<LIST>) {
chop;
- local($tag) = split;
+ my ($tag) = split;
if ($prev ne $tag) {
$count++;
- print STDERR " [$count] adding $kind
$tag\n" if ($'vflag);
+ print STDERR " [$count] adding $kind
$tag\n" if ($vflag);
if ($writing) {
- if (!$'dynamic) {
- print FILE &'list_end;
- print FILE $'body_end,
"\n";
- print FILE $'html_end,
"\n";
- $'file_count++;
+ if (!$dynamic) {
+ print FILE list_end;
+ print FILE $body_end,
"\n";
+ print FILE $html_end,
"\n";
+ $file_count++;
}
$writing = 0;
#
# cache record: " <file id>
<entry number>"
#
- local($prev_count) = $count - 1;
- &cache'put($db, $prev, "
$prev_count $entry_count");
+ my $prev_count = $count - 1;
+ cache::put($db, $prev, "
$prev_count $entry_count");
}
# single entry
if ($first_line) {
- local($nouse, $lno, $filename) =
split(/[ \t]+/, $first_line);
- &cache'put($db, $prev, "$lno
$filename");
+ my ($nouse, $lno, $filename) =
split(/[ \t]+/, $first_line);
+ cache::put($db, $prev, "$lno
$filename");
}
$first_line = $_;
$prev = $tag;
@@ -1502,46 +1531,46 @@
# N<file> create normal
file.
# C<file> create gzipped
file.
#
- if (!$'dynamic) {
- local($dir) = $dir{$db};
- print FILE
"$flag$dist/$dir/$count.$'HTML\n";
- print FILE $'html_begin,
"\n";
- print FILE
&'set_header($tag);
- print FILE $'body_begin,
"\n";
- print FILE &'list_begin;
- print FILE
&'list_body($srcdir, $first_line);
+ if (!$dynamic) {
+ my $dir = $dir{$db};
+ print FILE
"$flag$dist/$dir/$count.$HTML\n";
+ print FILE $html_begin,
"\n";
+ print FILE
set_header($tag);
+ print FILE $body_begin,
"\n";
+ print FILE list_begin;
+ print FILE
list_body($srcdir, $first_line);
}
$writing = 1;
$entry_count++;
$first_line = '';
}
- if (!$'dynamic) {
- print FILE &'list_body($srcdir,
$_);
+ if (!$dynamic) {
+ print FILE list_body($srcdir,
$_);
}
$entry_count++;
}
}
$definition_count = $count if ($db eq 'GTAGS');
close(LIST);
- if ($?) { &'error("'$command' failed."); }
+ if ($?) { error("'$command' failed."); }
if ($writing) {
- if (!$'dynamic) {
- print FILE &'list_end;
- print FILE $'body_end, "\n";
- print FILE $'html_end, "\n";
- $'file_count++;
+ if (!$dynamic) {
+ print FILE list_end;
+ print FILE $body_end, "\n";
+ print FILE $html_end, "\n";
+ $file_count++;
}
#
# cache record: " <file id> <entry number>"
#
- &cache'put($db, $prev, " $count $entry_count");
+ cache::put($db, $prev, " $count $entry_count");
}
if ($first_line) {
- local($nouse, $lno, $filename) = split(/[ \t]+/,
$first_line);
- &cache'put($db, $prev, "$lno $filename");
+ my ($nouse, $lno, $filename) = split(/[ \t]+/,
$first_line);
+ cache::put($db, $prev, "$lno $filename");
}
}
- if (!$'dynamic) {
+ if (!$dynamic) {
close(FILE);
}
$definition_count;
@@ -1556,64 +1585,64 @@
# go) @defines
#
sub makedefineindex {
- local($dist, $file, $total) = @_;
- local($count) = 0;
- local($alpha_count) = 0;
- local($indexlink) = ($'Fflag) ? "../defines.$'normal_suffix" :
"../mains.$'normal_suffix";
- local($index_string) = 'Index Page';
- local($target) = ($'Fflag) ? 'mains' : '_top';
-
- if ($'map_file) {
- open(MAP, ">$'dist/MAP") || &'error("cannot open.");
- }
- open(DEFINES, ">$file") || &'error("cannot make function index
'$file'.");
- print DEFINES $'html_begin, "\n";
- print DEFINES &'set_header($'title_define_index);
- print DEFINES $'body_begin, "\n";
- if ($'Fflag) {
- print DEFINES "<A
HREF=defines.$'normal_suffix><H2>$'title_define_index</H2></A>\n";
+ my ($dist, $file, $total) = @_;
+ my $count = 0;
+ my $alpha_count = 0;
+ my $indexlink = $Fflag ? "../defines.$normal_suffix" :
"../mains.$normal_suffix";
+ my $index_string = 'Index Page';
+ my $target = $Fflag ? 'mains' : '_top';
+
+ if ($map_file) {
+ open(MAP, ">$dist/MAP") || error("cannot open.");
+ }
+ open(DEFINES, ">$file") || error("cannot make function index
'$file'.");
+ print DEFINES $html_begin, "\n";
+ print DEFINES set_header($title_define_index);
+ print DEFINES $body_begin, "\n";
+ if ($Fflag) {
+ print DEFINES "<A
HREF=defines.$normal_suffix><H2>$title_define_index</H2></A>\n";
} else {
- print DEFINES "<H2>$'title_define_index</H2>\n";
+ print DEFINES "<H2>$title_define_index</H2>\n";
}
- if (!$'aflag && !$'Fflag) {
- $indexlink = "mains.$'normal_suffix";
+ if (!$aflag && !$Fflag) {
+ $indexlink = "mains.$normal_suffix";
print DEFINES "<A HREF=$indexlink
TITLE='$index_string'>" .
- ($'icon_list ? "<IMG SRC=icons/$'back_icon
ALT='[..]' $'icon_spec>" : "[..]") .
+ ($icon_list ? "<IMG SRC=icons/$back_icon
ALT='[..]' $icon_spec>" : "[..]") .
"</A>\n";
}
- if (!$'no_order_list) {
- print DEFINES "<OL>\n" if (!$'aflag);
+ if (!$no_order_list) {
+ print DEFINES "<OL>\n" if (!$aflag);
}
- local($old) = select(DEFINES);
- local($command) = "global -c";
- open(TAGS, "$command |") || &'error("cannot fork.");
- local($alpha, $alpha_f);
- @defines = (); # [A][B][C]...
+ my $old = select(DEFINES);
+ my $command = "global -c";
+ open(TAGS, "$command |") || error("cannot fork.");
+ my ($alpha, $alpha_f);
+ my @defines = (); # [A][B][C]...
while (<TAGS>) {
$count++;
chop;
- local($tag) = $_;
- print STDERR " [$count/$total] adding $tag\n" if
($'vflag);
- if ($'aflag && ($alpha eq '' || $tag !~ /^$alpha/)) {
+ my $tag = $_;
+ print STDERR " [$count/$total] adding $tag\n" if
($vflag);
+ if ($aflag && ($alpha eq '' || $tag !~ /^$alpha/)) {
if ($alpha) {
- local($msg) = $alpha_count == 1 ?
'definition is containded.' : 'definitions are containded.';
- push(@defines, "<A
HREF=defines/$alpha_f.$'HTML TITLE='$alpha_count $msg'>[$alpha]</A>\n");
+ my $msg = $alpha_count == 1 ?
'definition is containded.' : 'definitions are containded.';
+ push(@defines, "<A
HREF=defines/$alpha_f.$HTML TITLE='$alpha_count $msg'>[$alpha]</A>\n");
$alpha_count = 0;
- if (!$'no_order_list) {
+ if (!$no_order_list) {
print ALPHA "</OL>\n";
} else {
print ALPHA "<BR>\n";
}
print ALPHA "<A HREF=$indexlink
TITLE='$index_string'>";
- print ALPHA $'icon_list ? "<IMG
SRC=../icons/$'back_icon ALT='[..]' $'icon_spec>" : "[..]";
+ print ALPHA $icon_list ? "<IMG
SRC=../icons/$back_icon ALT='[..]' $icon_spec>" : "[..]";
print ALPHA "</A>\n";
- print ALPHA $'body_end, "\n";
- print ALPHA $'html_end, "\n";
+ print ALPHA $body_end, "\n";
+ print ALPHA $html_end, "\n";
close(ALPHA);
- $'file_count++;
+ $file_count++;
}
# for multi-byte code
- local($c0, $c1);
+ my ($c0, $c1);
$c0 = substr($tag, 0, 1);
if (ord($c0) > 127) {
$c1 = substr($tag, 1, 1);
@@ -1627,19 +1656,19 @@
$alpha_f = "l$c0";
}
}
- if ($'cflag) {
- open(ALPHA, "| gzip -c
>$dist/defines/$alpha_f.$'HTML") || &'error("cannot make alphabetical
function index.");
+ if ($cflag) {
+ open(ALPHA, "| gzip -c
>$dist/defines/$alpha_f.$HTML") || error("cannot make alphabetical
function index.");
} else {
- open(ALPHA,
">$dist/defines/$alpha_f.$'HTML") || &'error("cannot make alphabetical
function index.");
+ open(ALPHA,
">$dist/defines/$alpha_f.$HTML") || error("cannot make alphabetical
function index.");
}
- print ALPHA $'html_begin, "\n";
- print ALPHA &'set_header("[$alpha]");
- print ALPHA $'body_begin, "\n";
+ print ALPHA $html_begin, "\n";
+ print ALPHA set_header("[$alpha]");
+ print ALPHA $body_begin, "\n";
print ALPHA "<H2>[$alpha]</H2>\n";
print ALPHA "<A HREF=$indexlink
TITLE='$index_string'>";
- print ALPHA $'icon_list ? "<IMG
SRC=../icons/$'back_icon ALT='[..]' $'icon_spec>" : "[..]";
+ print ALPHA $icon_list ? "<IMG
SRC=../icons/$back_icon ALT='[..]' $icon_spec>" : "[..]";
print ALPHA "</A>\n";
- if (!$'no_order_list) {
+ if (!$no_order_list) {
print ALPHA "<OL>\n";
} else {
print ALPHA "<BR><BR>\n";
@@ -1650,80 +1679,80 @@
#
# generating url for function definition.
#
- local($line) = &cache'get('GTAGS', $tag);
- local($url);
- local($guide);
+ my $line = cache::get('GTAGS', $tag);
+ my $url;
+ my $guide;
if ($line =~ /^ (\d+) (\d+)/) {
- $url = "$'DEFS/$1.$'HTML";
- if ($'dynamic) {
- local($cgi) = $'action;
- if ($'action !~ /^\// && $'aflag) {
- $cgi = "../" . $'action;
+ $url = "$DEFS/$1.$HTML";
+ if ($dynamic) {
+ my $cgi = $action;
+ if ($action !~ /^\// && $aflag) {
+ $cgi = "../" . $action;
}
$url =
"${cgi}?pattern=$tag&type=definitions";
} else {
- $url = "$'DEFS/$1.$'HTML";
- if ($'aflag) {
+ $url = "$DEFS/$1.$HTML";
+ if ($aflag) {
$url = "../" . $url;
}
}
$guide = "Multiple defined in $2 places.";
} else {
- local($lno, $path) = split(/[ \t]+/, $line);
- local($filename) = &'path2url($path);
+ my ($lno, $path) = split(/[ \t]+/, $line);
+ my $filename = path2url($path);
$path =~ s!^\./!!;
- $url = "$'SRCS/$filename#$lno";
- if ($'aflag) {
+ $url = "$SRCS/$filename#$lno";
+ if ($aflag) {
$url = "../" . $url;
}
$guide = "Defined at $lno in $path.";
}
- if (!$'no_order_list) {
+ if (!$no_order_list) {
print "<LI>";
}
print "<A HREF=$url TARGET=$target";
print " TITLE='$guide'" if ($guide);
print ">$tag</A>\n";
- if ($'no_order_list) {
+ if ($no_order_list) {
print "<BR>";
}
- if ($'map_file) {
+ if ($map_file) {
print MAP "$tag\t$url\n";
}
}
close(TAGS);
- if ($?) { &'error("'$command' failed."); }
+ if ($?) { error("'$command' failed."); }
select($old);
- if ($'aflag) {
- push(@defines, "<A HREF=defines/$alpha_f.$'HTML
TITLE='$alpha_count definitions are containded.'>[$alpha]</A>\n");
- if (!$'no_order_list) {
+ if ($aflag) {
+ push(@defines, "<A HREF=defines/$alpha_f.$HTML
TITLE='$alpha_count definitions are containded.'>[$alpha]</A>\n");
+ if (!$no_order_list) {
print ALPHA "</OL>\n";
} else {
print ALPHA "<BR>\n";
}
print ALPHA "<A HREF=$indexlink TITLE='$index_string'>";
- print ALPHA $'icon_list ? "<IMG SRC=../icons/$'back_icon
ALT='[..]' $'icon_spec>" : "[..]";
+ print ALPHA $icon_list ? "<IMG SRC=../icons/$back_icon
ALT='[..]' $icon_spec>" : "[..]";
print ALPHA "</A>\n";
- print ALPHA $'body_end, "\n";
- print ALPHA $'html_end, "\n";
+ print ALPHA $body_end, "\n";
+ print ALPHA $html_end, "\n";
close(ALPHA);
- $'file_count++;
+ $file_count++;
print DEFINES @defines;
}
- if (!$'no_order_list) {
- print DEFINES "</OL>\n" if (!$'aflag);
+ if (!$no_order_list) {
+ print DEFINES "</OL>\n" if (!$aflag);
}
- if (!$'aflag && !$'Fflag) {
+ if (!$aflag && !$Fflag) {
print DEFINES "<A HREF=$indexlink
TITLE='$index_string'>" .
- ($'icon_list ? "<IMG SRC=icons/$'back_icon
ALT='[..]' $'icon_spec>" : "[..]") .
+ ($icon_list ? "<IMG SRC=icons/$back_icon
ALT='[..]' $icon_spec>" : "[..]") .
"</A>\n";
}
- print DEFINES $'body_end, "\n";
- print DEFINES $'html_end, "\n";
+ print DEFINES $body_end, "\n";
+ print DEFINES $html_end, "\n";
close(DEFINES);
- $'file_count++;
- if ($'map_file) {
+ $file_count++;
+ if ($map_file) {
close(MAP);
}
$count;
@@ -1738,38 +1767,38 @@
# go) %includes
#
sub makefileindex {
- local($dist, $file, $incdir) = @_;
- local($count) = 0;
- local($indexlink) = ($'Fflag) ? "../files.$'normal_suffix" :
"../mains.$'normal_suffix";
- local($target) = ($'Fflag) ? 'mains' : '_top';
- local(@dirstack, @fdstack);
- local($findcom) = ($'other_files) ? "$'findcom --other | sort -t
/ +1" : $'findcom;
- local($parent_string) = 'Parent Directory';
-
- open(FIND, "$findcom |") || &'error("cannot fork.");
- open(FILES, ">$file") || &'error("cannot make file '$file'.");
- print FILES $'html_begin, "\n";
- print FILES &'set_header($'title_file_index);
- print FILES $'body_begin, "\n";
- print FILES "<A
HREF=files.$'normal_suffix><H2>$'title_file_index</H2></A>\n";
- if (!$'no_order_list) {
+ my ($dist, $file, $incdir) = @_;
+ my $count = 0;
+ my $indexlink = ($Fflag) ? "../files.$normal_suffix" :
"../mains.$normal_suffix";
+ my $target = ($Fflag) ? 'mains' : '_top';
+ my (@dirstack, @fdstack, %fdmap); # %fdmap key = path, value =
filehandle
+ my $findcom = ($other_files) ? "$findcom --other | sort -t / +1"
: $findcom;
+ my $parent_string = 'Parent Directory';
+
+ open(FIND, "$findcom |") || error("cannot fork.");
+ open(FILES, ">$file") || error("cannot make file '$file'.");
+ print FILES $html_begin, "\n";
+ print FILES set_header($title_file_index);
+ print FILES $body_begin, "\n";
+ print FILES "<A
HREF=files.$normal_suffix><H2>$title_file_index</H2></A>\n";
+ if (!$no_order_list) {
print FILES "<OL>\n";
}
- local($org) = select(FILES);
- local(@push, @pop, $file);
+ my $org = select(FILES);
+ my (@push, @pop, $file);
while (<FIND>) {
- local($notsource) = 0;
+ my $notsource = 0;
chop;
if (/^ /) {
- next if (!$'other_files);
+ next if (!$other_files);
s/^ //;
next if (-B $_);
$notsource = 1;
}
$count++;
s!^\./!!;
- print STDERR " [$count] adding $_\n" if ($'vflag);
+ print STDERR " [$count] adding $_\n" if ($vflag);
@push = split('/');
$file = pop(@push);
@pop = @dirstack;
@@ -1780,36 +1809,40 @@
if (@push || @pop) {
while (@pop) {
pop(@dirstack);
- local($parent) = (@dirstack) ?
&'path2url(join('/', @dirstack)) : $indexlink;
- print $'no_order_list ? "<BR>\n" :
"</OL>\n";
+ my $parent = (@dirstack) ?
path2url(join('/', @dirstack)) : $indexlink;
+ print $no_order_list ? "<BR>\n" :
"</OL>\n";
print "<A HREF=$parent
TITLE='$parent_string'>" .
- ($'icon_list ? "<IMG
SRC=../icons/$'back_icon ALT='[..]' $'icon_spec>" : "[..]") .
+ ($icon_list ? "<IMG
SRC=../icons/$back_icon ALT='[..]' $icon_spec>" : "[..]") .
"</A>\n";
- print $'body_end, "\n";
- print $'html_end, "\n";
- $path = pop(@fdstack);
- close($path);
- $'file_count++;
- select($fdstack[$#fdstack]) if
(@fdstack);
+ print $body_end, "\n";
+ print $html_end, "\n";
+ my $path = pop(@fdstack);
+ my $fd = $fdmap{$path};
+ close($fd);
+ delete $fdmap{$path};
+ $file_count++;
+ if (@fdstack) {
+ select(
$fdmap{$fdstack[$#fdstack]} );
+ }
pop(@pop);
}
while (@push) {
- local($parent) = (@dirstack) ?
&'path2url(join('/', @dirstack)) : $indexlink;
+ my $parent = (@dirstack) ?
path2url(join('/', @dirstack)) : $indexlink;
push(@dirstack, shift @push);
- $path = join('/', @dirstack);
- $cur = "$dist/files/" .
&'path2url($path);
- local($last) = $path;
- if (!$'full_path) {
+ my $path = join('/', @dirstack);
+ my $cur = "$dist/files/" .
path2url($path);
+ my $last = $path;
+ if (!$full_path) {
$last =~ s!.*/!!;
}
- local($li) = '';
- if (!$'no_order_list) {
+ my $li = '';
+ if (!$no_order_list) {
$li .="<LI>";
}
- $li .= "<A HREF=" . (@dirstack == 1 ?
'files/' : '') . &path2url($path) . " TITLE='$path/'>" .
- ($'icon_list ? "<IMG SRC=" .
(@dirstack == 1 ? '' : '../') . "icons/$'dir_icon ALT=[$path/] HSPACE=3
$'icon_spec>" : '') .
+ $li .= "<A HREF=" . (@dirstack == 1 ?
'files/' : '') . path2url($path) . " TITLE='$path/'>" .
+ ($icon_list ? "<IMG SRC=" .
(@dirstack == 1 ? '' : '../') . "icons/$dir_icon ALT=[$path/] HSPACE=3
$icon_spec>" : '') .
"$last/</A>\n";
- if ($'no_order_list) {
+ if ($no_order_list) {
$li .="<BR>";
}
if (@dirstack == 1) {
@@ -1817,22 +1850,24 @@
} else {
print $li;
}
- if ($'cflag) {
- open($cur, "| gzip -c
>\"$cur\"") || &'error("cannot make directory index.");
+ my $curfd;
+ if ($cflag) {
+ open($curfd, "| gzip -c
>\"$cur\"") || error("cannot make directory index.");
} else {
- open($cur, ">$cur") ||
&'error("cannot make directory index.");
+ open($curfd, ">$cur") ||
error("cannot make directory index.");
}
- select($cur);
+ select($curfd);
push(@fdstack, $cur);
- print $'html_begin, "\n";
- print &'set_header("$path/");
- print $'body_begin, "\n";
+ $fdmap{$cur} = $curfd;
+ print $html_begin, "\n";
+ print set_header("$path/");
+ print $body_begin, "\n";
print "<H2>";
print "<A HREF=$indexlink>root</A>/";
- local(@p);
- foreach $n (0 .. $#dirstack) {
+ my @p;
+ foreach my $n (0 .. $#dirstack) {
push(@p, $dirstack[$n]);
- local($url) =
&'path2url(join('/', @p));
+ my $url = path2url(join('/',
@p));
print "<A HREF=$url>" if ($n <
$#dirstack);
print "$dirstack[$n]";
print "</A>" if ($n <
$#dirstack);
@@ -1840,9 +1875,9 @@
}
print "</H2>\n";
print "<A HREF=$parent
TITLE='$parent_string'>" .
- ($'icon_list ? "<IMG
SRC=../icons/$'back_icon ALT='[..]' $'icon_spec>" : "[..]") .
+ ($icon_list ? "<IMG
SRC=../icons/$back_icon ALT='[..]' $icon_spec>" : "[..]") .
"</A>\n";
- if (!$'no_order_list) {
+ if (!$no_order_list) {
print "<OL>\n";
} else {
print "<BR><BR>\n";
@@ -1868,26 +1903,26 @@
$includes{$file} =
"$includes{$file}\n$_";
}
}
- local($url);
- if ($notsource && $'dynamic) {
- local($cgi) = ($'action =~ /^\// || @dirstack ==
0) ? $'action : "../$'action";
+ my $url;
+ if ($notsource && $dynamic) {
+ my $cgi = ($action =~ /^\// || @dirstack == 0) ?
$action : "../$action";
$url = "${cgi}?pattern=$_&type=source";
} else {
- $url = (@dirstack == 0 ? '' : '../') . "$'SRCS/"
. &'path2url($_);
+ $url = (@dirstack == 0 ? '' : '../') . "$SRCS/"
. path2url($_);
}
- local($last) = $_;
- if (!$'full_path) {
+ my $last = $_;
+ if (!$full_path) {
$last =~ s!.*/!!;
}
- local($icon) = ($last =~ /\.[chy]$/) ? $'c_icon :
$'file_icon;
- local($li) = '';
- if (!$'no_order_list) {
+ my $icon = ($last =~ /\.[chy]$/) ? $c_icon : $file_icon;
+ my $li = '';
+ if (!$no_order_list) {
$li .= "<LI>\n";
}
$li .= "<A HREF=$url TARGET=$target TITLE='$_'>" .
- ($'icon_list ? "<IMG SRC=" . (@dirstack == 0 ?
'' : '../') . "icons/$icon ALT=[$_] HSPACE=3 $'icon_spec>" : '') .
+ ($icon_list ? "<IMG SRC=" . (@dirstack == 0 ? ''
: '../') . "icons/$icon ALT=[$_] HSPACE=3 $icon_spec>" : '') .
"$last</A>\n";
- if ($'no_order_list) {
+ if ($no_order_list) {
$li .= "<BR>\n";
}
if (@dirstack == 0) {
@@ -1897,27 +1932,31 @@
}
}
close(FIND);
- if ($?) { &'error("cannot traverse directory.($findcom)"); }
+ if ($?) { error("cannot traverse directory.($findcom)"); }
while (@dirstack) {
pop(@dirstack);
- local($parent) = (@dirstack) ? &'path2url(join('/',
@dirstack)) : $indexlink;
- print $'no_order_list ? "<BR>\n": "</OL>\n";
+ my $parent = (@dirstack) ? path2url(join('/',
@dirstack)) : $indexlink;
+ print $no_order_list ? "<BR>\n": "</OL>\n";
print "<A HREF=$parent TITLE='$parent_string'>" .
- ($'icon_list ? "<IMG SRC=../icons/$'back_icon
ALT='[..]' $'icon_spec>" : "[..]") .
+ ($icon_list ? "<IMG SRC=../icons/$back_icon
ALT='[..]' $icon_spec>" : "[..]") .
"</A>\n";
- print $'body_end, "\n";
- print $'html_end, "\n";
- $path = pop(@fdstack);
- close($path);
- $'file_count++;
- select($fdstack[$#fdstack]) if (@fdstack);
+ print $body_end, "\n";
+ print $html_end, "\n";
+ my $path = pop(@fdstack);
+ my $fd = $fdmap{$path};
+ close($fd);
+ delete $fdmap{$path};
+ $file_count++;
+ if (@fdstack) {
+ select( $fdmap{$fdstack[$#fdstack]} );
+ }
}
print FILES @files;
- print FILES $'no_order_list ? "<BR>\n" : "</OL>\n";
- print FILES $'body_end, "\n";
- print FILES $'html_end, "\n";
+ print FILES $no_order_list ? "<BR>\n" : "</OL>\n";
+ print FILES $body_end, "\n";
+ print FILES $html_end, "\n";
close(FILES);
- $'file_count++;
+ $file_count++;
#
# Pick up include pattern.
@@ -1925,12 +1964,12 @@
# C: #include "xxx.h"
# PHP: include("xxx.inc.php");
#
- local($command) = "global -gnx \"^[ \\t]*(#[
\\t]*include|include[ \\t]*\\()\"";
- open(PIPE, "$command |") || &'error("cannot fork.");
+ my $command = "global -gnx \"^[ \\t]*(#[ \\t]*include|include[
\\t]*\\()\"";
+ open(PIPE, "$command |") || error("cannot fork.");
while (<PIPE>) {
chop;
- local($nouse, $lno, $filename, $image) = split(/\s+/,
$_, 4);
- local($last, $sep);
+ my ($nouse, $lno, $filename, $image) = split(/\s+/, $_,
4);
+ my ($last, $sep);
if ($filename =~ /\.php$/) {
($last, $sep) = ($image =~
m![/"']([^/"']+)(["'])\)!);
} else {
@@ -1949,58 +1988,58 @@
close(PIPE);
select($org);
- foreach $last (keys %includes) {
+ foreach my $last (keys %includes) {
if (!defined $included_from{$last}) {
delete $includes{$last};
next;
}
- local($no, @incs) = split(/\n/, $includes{$last});
+ my ($no, @incs) = split(/\n/, $includes{$last});
if (@incs > 1) {
- local($path) = "$incdir/$no.$'HTML";
- if ($'cflag) {
- open(INCLUDE, "| gzip -c >$path") ||
&'error("cannot open file '$path'.");
+ my $path = "$incdir/$no.$HTML";
+ if ($cflag) {
+ open(INCLUDE, "| gzip -c >$path") ||
error("cannot open file '$path'.");
} else {
- open(INCLUDE, ">$path") ||
&'error("cannot open file '$path'.");
+ open(INCLUDE, ">$path") || error("cannot
open file '$path'.");
}
- print INCLUDE $'html_begin, "\n";
- print INCLUDE &'set_header($last);
- print INCLUDE $'body_begin, "\n";
+ print INCLUDE $html_begin, "\n";
+ print INCLUDE set_header($last);
+ print INCLUDE $body_begin, "\n";
print INCLUDE "<PRE>\n";
- foreach $filename (@incs) {
- $path = &'path2url($filename);
- print INCLUDE "<A HREF=../$'SRCS/$path
TARGET=$target>$filename</A>\n";
+ foreach my $filename (@incs) {
+ $path = path2url($filename);
+ print INCLUDE "<A HREF=../$SRCS/$path
TARGET=$target>$filename</A>\n";
}
print INCLUDE "</PRE>\n";
- print INCLUDE $'body_end, "\n";
- print INCLUDE $'html_end, "\n";
+ print INCLUDE $body_end, "\n";
+ print INCLUDE $html_end, "\n";
close(INCLUDE);
- $'file_count++;
+ $file_count++;
# '' means that information already written to
file.
$includes{$last} = $no;
}
- local(@refs) = split(/\n/, $included_from{$last});
+ my @refs = split(/\n/, $included_from{$last});
if (@refs == 1) {
- local($nouse, $lno, $filename) = split(/\s+/,
$refs[0]);
+ my ($nouse, $lno, $filename) = split(/\s+/,
$refs[0]);
$included_from{$last} = "$lno $filename";
} else {
- local($path) = "$dist/$'INCREFS/$no.$'HTML";
- if ($'cflag) {
- open(INCLUDE, "| gzip -c >$path") ||
&'error("cannot open file '$path'.");
+ my $path = "$dist/$INCREFS/$no.$HTML";
+ if ($cflag) {
+ open(INCLUDE, "| gzip -c >$path") ||
error("cannot open file '$path'.");
} else {
- open(INCLUDE, ">$path") ||
&'error("cannot open file '$path'.");
+ open(INCLUDE, ">$path") || error("cannot
open file '$path'.");
}
- print INCLUDE $'html_begin, "\n";
- print INCLUDE &'set_header($last);
- print INCLUDE $'body_begin, "\n";
- print INCLUDE &'list_begin();
- foreach $line (@refs) {
- print INCLUDE &'list_body("../$'SRCS",
$line);
- }
- print INCLUDE &'list_end;
- print INCLUDE $'body_end, "\n";
- print INCLUDE $'html_end, "\n";
+ print INCLUDE $html_begin, "\n";
+ print INCLUDE set_header($last);
+ print INCLUDE $body_begin, "\n";
+ print INCLUDE list_begin();
+ foreach my $line (@refs) {
+ print INCLUDE list_body("../$SRCS",
$line);
+ }
+ print INCLUDE list_end;
+ print INCLUDE $body_end, "\n";
+ print INCLUDE $html_end, "\n";
close(INCLUDE);
- $'file_count++;
+ $file_count++;
$included_from{$last} = " $no " . @refs;
}
}
@@ -2015,11 +2054,11 @@
# r) html
#
sub makesearchpart {
- local($action, $id, $target) = @_;
- local($index) = '';
+ my ($action, $id, $target) = @_;
+ my $index = '';
- if ($'Fflag) {
- $index .= "<A
HREF=search.$'normal_suffix><H2>SEARCH</H2></A>\n";
+ if ($Fflag) {
+ $index .= "<A
HREF=search.$normal_suffix><H2>SEARCH</H2></A>\n";
} else {
$index .= "<H2>SEARCH</H2>\n";
}
@@ -2043,17 +2082,17 @@
}
$index .= "\n<INPUT TYPE=radio NAME=type VALUE=path TITLE='Look
for path name which matches to the specified pattern.'>";
$index .= ($target) ? "Path" : "Path name";
- if ($'enable_grep) {
+ if ($enable_grep) {
$index .= "\n<INPUT TYPE=radio NAME=type VALUE=grep
TITLE='Retrieve lines which matches to the specified pattern.'>";
$index .= ($target) ? "Grep" : "Grep pattern";
}
- if ($'enable_idutils && -f "$dbpath/ID") {
+ if ($enable_idutils && -f "$dbpath/ID") {
$index .= "\n<INPUT TYPE=radio NAME=type VALUE=idutils
TITLE='Retrieve lines which matches to the specified pattern using
idutils(1).'>";
$index .= ($target) ? "Id" : "Id pattern";
}
$index .= "<BR>\n<INPUT TYPE=checkbox NAME=icase VALUE=1
TITLE='Ignore case distinctions in the pattern.'>";
$index .= ($target) ? "Icase" : "Ignore case";
- if ($'enable_grep && $'other_files) {
+ if ($enable_grep && $other_files) {
$index .= "\n<INPUT TYPE=checkbox NAME=other VALUE=1
TITLE='Files other than the source code are also retrieved.'>";
$index .= ($target) ? "Other" : "Other files";
}
@@ -2067,66 +2106,66 @@
# gi) @defines
#
sub makecommonpart {
- local($title) = @_;
- local($index) = '';
+ my $title = shift;;
+ my $index = '';
- if ($'include_header) {
- $index .= $'include_header;
- $index .= "\n$'hr\n";
- }
- $index .= "$'title_begin$'title$'title_end\n";
+ # if ($include_header) {
+ # $index .= $include_header;
+ # $index .= "\n$hr\n";
+ # }
+ $index .= "$title_begin$title$title_end\n";
$index .= "<P ALIGN=right>\n";
- $index .= "Last updated " . &'date . "<BR>\n";
- $index .= "This hypertext was generated by <A HREF=$'www
TARGET=_top TITLE='Go to the GLOBAL project
page.'>GLOBAL-$'version</A>.<BR>\n";
+ $index .= "Last updated " . date . "<BR>\n";
+ $index .= "This hypertext was generated by <A HREF=$www
TARGET=_top TITLE='Go to the GLOBAL project
page.'>GLOBAL-$version</A>.<BR>\n";
$index .= "</P>\n";
- $index .= "$'hr\n";
- if ($'include_caution) {
- $'include_caution =~ s/address@hidden@/$'file_count/;
- $'include_caution =~ s/address@hidden@/$'www/;
- $index .= $'include_caution;
- $index .= "\n$'hr\n";
- }
- if ($'fflag) {
- $index .= &makesearchpart($'action, $'id);
- $index .= "$'hr\n";
+ $index .= "$hr\n";
+ if ($include_caution) {
+ $include_caution =~ s/address@hidden@/$file_count/;
+ $include_caution =~ s/address@hidden@/$www/;
+ $index .= $include_caution;
+ $index .= "\n$hr\n";
+ }
+ if ($fflag) {
+ $index .= makesearchpart($action, $id);
+ $index .= "$hr\n";
}
$index .= "<H2>MAINS</H2>\n";
- local($command) = "global -nx $'main_func | sort +0 -1 +2 -3 +1n
-2";
- open(PIPE, "$command |") || &'error("cannot fork.");
- $index .= &'list_begin();
+ my $command = "global -nx $main_func | sort +0 -1 +2 -3 +1n -2";
+ open(PIPE, "$command |") || error("cannot fork.");
+ $index .= list_begin();
while (<PIPE>) {
chop;
- $index .= &'list_body($'SRCS, $_);
+ $index .= list_body($SRCS, $_);
}
- $index .= &'list_end();
+ $index .= list_end();
close(PIPE);
- if ($?) { &'error("'$command' failed."); }
- $index .= "$'hr\n";
- if ($'aflag && !$'Fflag) {
- $index .= "<H2>$'title_define_index</H2>\n";
- foreach $f (@defines) {
+ if ($?) { error("'$command' failed."); }
+ $index .= "$hr\n";
+ if ($aflag && !$Fflag) {
+ $index .= "<H2>$title_define_index</H2>\n";
+ foreach my $f (@defines) {
$index .= $f;
}
} else {
- $index .= "<H2><A
HREF=defines.$'normal_suffix>$'title_define_index</A></H2>\n";
+ $index .= "<H2><A
HREF=defines.$normal_suffix>$title_define_index</A></H2>\n";
}
- $index .= "$'hr\n";
- if ($'Fflag) {
- $index .= "<H2><A
HREF=files.$'normal_suffix>$'title_file_index</A></H2>\n";
+ $index .= "$hr\n";
+ if ($Fflag) {
+ $index .= "<H2><A
HREF=files.$normal_suffix>$title_file_index</A></H2>\n";
} else {
- $index .= "<H2>$'title_file_index</H2>\n";
- if (!$'no_order_list) {
+ $index .= "<H2>$title_file_index</H2>\n";
+ if (!$no_order_list) {
$index .= "<OL>\n";
}
- foreach $f (@files) {
+ foreach my $f (@files) {
$index .= $f;
}
- if (!$'no_order_list) {
+ if (!$no_order_list) {
$index .= "</OL>\n";
} else {
$index .= "<BR>\n";
}
- $index .= "$'hr\n";
+ $index .= "$hr\n";
}
$index;
}
@@ -2138,45 +2177,45 @@
# i) $index common part
#
sub makeindex {
- local($file, $title, $index) = @_;
+ my ($file, $title, $index) = @_;
- if ($'Fflag) {
- open(FRAME, ">$file") || &'error("cannot open file
'$file'.");
- print FRAME $'html_begin, "\n";
+ if ($Fflag) {
+ open(FRAME, ">$file") || error("cannot open file
'$file'.");
+ print FRAME $html_begin, "\n";
print FRAME "<HEAD>\n<TITLE>$title</TITLE>\n";
- print FRAME "$'meta_robots\n$'meta_generator\n";
- print FRAME $'style_sheet if ($'style_sheet);
+ print FRAME "$meta_robots\n$meta_generator\n";
+ print FRAME $style_sheet if ($style_sheet);
print FRAME "</HEAD>\n";
print FRAME "<FRAMESET COLS='200,*'>\n";
- if ($'fflag) {
+ if ($fflag) {
print FRAME "<FRAMESET ROWS='33%,33%,*'>\n";
- print FRAME "<FRAME NAME=search
SRC=search.$'normal_suffix>\n";
+ print FRAME "<FRAME NAME=search
SRC=search.$normal_suffix>\n";
} else {
print FRAME "<FRAMESET ROWS='50%,*'>\n";
}
- print FRAME "<FRAME NAME=defines
SRC=defines.$'normal_suffix>\n";
- print FRAME "<FRAME NAME=files
SRC=files.$'normal_suffix>\n";
+ print FRAME "<FRAME NAME=defines
SRC=defines.$normal_suffix>\n";
+ print FRAME "<FRAME NAME=files
SRC=files.$normal_suffix>\n";
print FRAME "</FRAMESET>\n";
- print FRAME "<FRAME NAME=mains
SRC=mains.$'normal_suffix>\n";
+ print FRAME "<FRAME NAME=mains
SRC=mains.$normal_suffix>\n";
print FRAME "<NOFRAMES>\n";
- print FRAME $'body_begin, "\n";
+ print FRAME $body_begin, "\n";
print FRAME $index;
- print FRAME $'body_end, "\n";
+ print FRAME $body_end, "\n";
print FRAME "</NOFRAMES>\n";
print FRAME "</FRAMESET>\n";
- print FRAME $'html_end, "\n";
+ print FRAME $html_end, "\n";
close(FRAME);
- $'file_count++;
+ $file_count++;
} else {
- open(FILE, ">$file") || &'error("cannot open file
'$file'.");
- print FILE $'html_begin, "\n";
- print FILE &'set_header($title);
- print FILE $'body_begin, "\n";
+ open(FILE, ">$file") || error("cannot open file
'$file'.");
+ print FILE $html_begin, "\n";
+ print FILE set_header($title);
+ print FILE $body_begin, "\n";
print FILE $index;
- print FILE $'body_end, "\n";
- print FILE $'html_end, "\n";
+ print FILE $body_end, "\n";
+ print FILE $html_end, "\n";
close(FILE);
- $'file_count++;
+ $file_count++;
}
}
#
@@ -2186,17 +2225,17 @@
# i) $index common part
#
sub makemainindex {
- local($file, $index) = @_;
+ my ($file, $index) = @_;
- open(INDEX, ">$file") || &'error("cannot create file '$file'.");
- print INDEX $'html_begin, "\n";
- print INDEX &'set_header($title);
- print INDEX $'body_begin, "\n";
+ open(INDEX, ">$file") || error("cannot create file '$file'.");
+ print INDEX $html_begin, "\n";
+ print INDEX set_header($title);
+ print INDEX $body_begin, "\n";
print INDEX $index;
- print INDEX $'body_end, "\n";
- print INDEX $'html_end, "\n";
+ print INDEX $body_end, "\n";
+ print INDEX $html_end, "\n";
close(INDEX);
- $'file_count++;
+ $file_count++;
}
#
# makesearchindex: make search html
@@ -2204,55 +2243,62 @@
# i) $file file name
#
sub makesearchindex {
- local($file) = @_;
+ my $file = shift;
- open(SEARCH, ">$file") || &'error("cannot create file
'$file'.");
- print SEARCH $'html_begin, "\n";
- print SEARCH &'set_header('SEARCH');
- print SEARCH $'body_begin, "\n";
- print SEARCH &makesearchpart($'action, $'id, 'mains');
- print SEARCH $'body_end, "\n";
- print SEARCH $'html_end, "\n";
+ open(SEARCH, ">$file") || error("cannot create file '$file'.");
+ print SEARCH $html_begin, "\n";
+ print SEARCH set_header('SEARCH');
+ print SEARCH $body_begin, "\n";
+ print SEARCH makesearchpart($action, $id, 'mains');
+ print SEARCH $body_end, "\n";
+ print SEARCH $html_end, "\n";
close(SEARCH);
- $'file_count++;
+ $file_count++;
}
#
# makehtml: make html files
#
# i) total number of files.
#
-sub makehtml {
- local($dist, $total) = @_;
- local($count) = 0;
- local($findcom) = ($'other_files && !$'dynamic) ? "$'findcom
--other | sort -t / +1" : $'findcom;
+sub makehtml
+{
+ my ($dist, $total) = @_;
+ my $count = 0;
+ my $findcom = ($other_files && !$dynamic) ? "$findcom --other |
sort -t / +1" : $findcom;
- open(FIND, "$findcom |") || &'error("cannot fork.");
+ open(FIND, "$findcom |") || error("cannot fork.");
while (<FIND>) {
- local($notsource) = 0;
+ my $notsource = 0;
chop;
if (/^ /) {
- next if (!$'other_files);
+ next if (!$other_files);
s/^ //;
if (-B $_) {
- print STDERR "Warning: '$_' is binary
file. (skipped)\n" if ($'wflag);
+ print STDERR "Warning: '$_' is binary
file. (skipped)\n" if ($wflag);
next;
}
$notsource = 1;
}
$count++;
- local($path) = $_;
+ my $path = $_;
$path =~ s/^\.\///;
- print STDERR " [$count/$total] converting $path\n" if
($'vflag);
- $path = &'path2url($path);
- &convert'src2html($_, "$dist/$'SRCS/$path", $notsource);
+ print STDERR " [$count/$total] converting $path\n" if
($vflag);
+ $path = path2url($path);
+ convert::src2html($_, "$dist/$SRCS/$path", $notsource);
}
close(FIND);
- if ($?) { &'error("cannot traverse directory.($findcom)"); }
+ if ($?) { error("cannot traverse directory.($findcom)"); }
}
#=======================================================================
==
# CONVERT PACKAGE
#=======================================================================
==
package convert;
+
+# package globals
+my $INCOMMENT;
+my $quote;
+my ($isjava, $iscpp, $isphp);
+
#
# src2html: convert source code into HTML
#
@@ -2262,57 +2308,67 @@
# gi) %includes
# pairs of include file and the path
#
-sub src2html {
- local($file, $hfile, $notsource) = @_;
- local($ncol) = $'ncol;
- local($tabs) = $'tabs;
- local(%ctab) = ('&', '&', '<', '<', '>', '>');
- local($isjava) = ($file =~ /\.java$/) ? 1 : 0;
- local($iscpp) = ($file =~ /\.(h|c\+\+|cc|cpp|cxx|hxx|hpp|C|H)$/)
? 1 : 0;
- local($isphp) = ($file =~ /\.(php|php3|phtml)$/) ? 1 : 0;
- local($indexlink) = ($'Fflag) ? "../files.$'normal_suffix" :
"../mains.$'normal_suffix";
- local($command);
+sub src2html
+{
+ cache::clearup(); # closes DBM files and undef's hashes - save
memory
+ cache::open(); # re-open DBM, re-define hashes
+ my ($file, $hfile, $notsource) = @_;
+ my $ncol = $ncol;
+ my $tabs = $tabs;
+ my %ctab = ('&', '&', '<', '<', '>', '>');
+ $isjava = ($file =~ /\.java$/) ? 1 : 0;
+ $iscpp = ($file =~ /\.(h|c\+\+|cc|cpp|cxx|hxx|hpp|C|H)$/) ? 1 :
0;
+ $isphp = ($file =~ /\.(php|php3|phtml)$/) ? 1 : 0;
+ my $indexlink = ($Fflag) ? "../files.$normal_suffix" :
"../mains.$normal_suffix";
+ my ($command, $guide);
- if ($'cflag) {
+ if ($cflag) {
$command = "gzip -c >";
- $command .= ($'w32) ? "\"$hfile\"" : "'$hfile'";
- open(HTML, "| $command") || &'error("cannot create file
'$hfile'.");
+ $command .= ($w32) ? "\"$hfile\"" : "'$hfile'";
+ open(HTML, "| $command") || error("cannot create file
'$hfile'.");
} else {
- open(HTML, ">$hfile") || &'error("cannot create file
'$hfile'.");
+ open(HTML, ">$hfile") || error("cannot create file
'$hfile'.");
}
- local($old) = select(HTML);
+
+ my $old = select(HTML); # make the HTML filehandle the current
one and save off the old one.
+
#
# load tags belonging to this file.
#
- &anchor'load($file, $notsource);
- $command = "$'gtags --expand -$tabs ";
- $command .= ($'w32) ? "\"$file\"" : "'$file'";
- open(SRC, "$command |") || &'error("cannot fork.");
+ anchor::load($file, $notsource);
+ $command = "$gtags --expand -$tabs ";
+ $command .= ($w32) ? "\"$file\"" : "'$file'";
+ open(SRC, "$command |") || error("cannot fork.");
+
+ # this file's quoted strings and comments
+ my @quoted_strings;
+ my @comments;
+
$file =~ s/^\.\///;
- print $'html_begin, "\n";
- print &'set_header($file);
- print $'body_begin, "\n";
+ print $html_begin, "\n";
+ print main::set_header($file);
+ print $body_begin, "\n";
#
# print the header
#
print "<A NAME=TOP><H2>";
- print &fill_anchor($indexlink, $file);
- if ($'cvsweb_url) {
- print " <A HREF=$'cvsweb_url$file";
- print "?cvsroot=$'cvsweb_cvsroot" if ($'cvsweb_cvsroot);
+ print fill_anchor($indexlink, $file);
+ if ($cvsweb_url) {
+ print " <A HREF=$cvsweb_url$file";
+ print "?cvsroot=$cvsweb_cvsroot" if ($cvsweb_cvsroot);
print "><FONT SIZE=-1>[CVS]</FONT></A>\n";
}
print "</H2>\n";
- print "$'comment_begin/* ";
- print &link_format(&anchor'getlinks(0));
- if ($'show_position) {
- print $'position_begin;
+ print "$comment_begin/* ";
+ print link_format(anchor::getlinks(0));
+ if ($show_position) {
+ print $position_begin;
print "[+1 $file]";
- print $'position_end;
+ print $position_end;
}
- print " */$'comment_end";
- print "\n$'hr\n";
+ print " */$comment_end";
+ print "\n$hr\n";
#
# It is not source file.
@@ -2333,41 +2389,41 @@
#
# INCLUDED FROM index.
#
- local($basename) = ($file =~ /([^\/]+)$/);
- local($incref) = $'included_from{$basename};
+ my $basename = ($file =~ /([^\/]+)$/);
+ my $incref = $included_from{$basename};
if (defined $incref) {
- local($url, $title);
+ my ($url, $title);
if ($incref =~ /^ (\d+) (\d+)/) {
- $url = "../$'INCREFS/$1.$'HTML";
- $title = &'show('I', -1, $2);
+ $url = "../$INCREFS/$1.$HTML";
+ $title = main::show('I', -1, $2);
} else {
- local($lno, $filename) = split(/\s+/,
$incref);
- $url = &'path2url($filename) . "#$lno";
+ my ($lno, $filename) = split(/\s+/,
$incref);
+ $url = main::path2url($filename) .
"#$lno";
$filename =~ s!\./!!;
- $title = &'show('I', $lno, $filename);
+ $title = main::show('I', $lno,
$filename);
}
- print "<H2><A HREF=$url
TITLE='$title'>$'title_included_from</A></H2>\n";
- print "$'hr\n";
+ print "<H2><A HREF=$url
TITLE='$title'>$title_included_from</A></H2>\n";
+ print "$hr\n";
}
#
# DEFINITIONS index.
#
- local($define_index) = '';
- local($lno, $tag, $type);
- for (($lno, $tag, $type) = &anchor'first(); $lno; ($lno,
$tag, $type) = &anchor'next()) {
+ my $define_index = '';
+ my ($lno, $tag, $type);
+ for (($lno, $tag, $type) = anchor::first(); $lno; ($lno,
$tag, $type) = anchor::next()) {
if ($type eq 'D') {
$define_index .= "<LI><A HREF=#$lno";
- $define_index .= " TITLE=\"" .
&'show('R',$lno,'') . "\"";
+ $define_index .= " TITLE=\"" .
main::show('R',$lno,'') . "\"";
$define_index .= ">$tag</A>\n";
}
}
if ($define_index) {
- print "<H2>$'title_define_index</H2>\n";
+ print "<H2>$title_define_index</H2>\n";
print "This source file includes following
definitions.\n";
print "<OL>\n";
print $define_index;
print "</OL>\n";
- print "$'hr\n";
+ print "$hr\n";
}
#
# print source code
@@ -2375,25 +2431,25 @@
print "<PRE>\n";
$INCOMMENT = 0; # initial status is out
of comment
$quote = '';
- local($LNO, $TAG, $TYPE) = &anchor'first();
+ my ($LNO, $TAG, $TYPE) = anchor::first();
while (<SRC>) {
- local($converted);
+ my $converted;
s/\r$//;
# make link for include file
if (!$INCOMMENT && !$quote && /^[ \t]*(#[
\t]*include|include[ \t]*\()/) {
- local($last, $sep);
+ my ($last, $sep);
if ($isphp) {
($last, $sep) = ($_ =~
m![/"']([^/"']+)(["'])[ \t]*\)!);
} else {
($last, $sep) = ($_ =~
m![</"]([^</"]+)([">])!);
}
- if (defined $'includes{$last}) {
- local($link);
- local($no, @incs) = split(/\n/,
$'includes{$last});
+ if (defined $includes{$last}) {
+ my $link;
+ my ($no, @incs) = split(/\n/,
$includes{$last});
if (@incs == 1) {
- $link =
&'path2url($incs[0]);
+ $link =
main::path2url($incs[0]);
} else {
- $link =
"../$'INCS/$no.$'HTML";
+ $link =
"../$INCS/$no.$HTML";
}
# quote path name.
$last =~
s/([\[\]\.\*\+])/\\\1/g;
@@ -2409,30 +2465,31 @@
}
# translate '<', '>' and '&' into entity name
if (!$converted) { s/([&<>])/$ctab{$1}/ge; }
- &protect_line(); # protect quoted char,
strings and comments
+ protect_line(\$_, address@hidden, address@hidden);
# protect quoted char, strings and comments
# painting source code
s/({|})/\016$1\017/g;
- local($sharp) = s/^([ \t\004]*#[
\t\004]*($'sharp_macros))// ? $1 : '';
+ my $sharp = s/^([ \t\004]*#[
\t\004]*($sharp_macros))// ? $1 : '';
if ($sharp !~ '#[ \t\004]*include') {
if ($isjava) {
-
s/\b($'java_reserved_words)\b/\022$1\023/go;
+
s/\b($java_reserved_words)\b/\022$1\023/go;
} elsif ($iscpp) {
-
s/\b($'cpp_reserved_words)\b/\022$1\023/go;
+
s/\b($cpp_reserved_words)\b/\022$1\023/go;
} elsif ($isphp) {
-
s/\b($'php_reserved_words)\b/\022$1\023/go;
- } else {
-
s/\b($'c_reserved_words)\b/\022$1\023/go;
+
s/\b($php_reserved_words)\b/\022$1\023/go;
+ } elsif (0) {
+
s/\b($c_reserved_words)\b/\022$1\023/go;
}
}
s/^/\020$sharp\021/ if ($sharp); #
recover macro
- local($define_line) = 0;
- local(@links) = ();
- local($count) = 0;
- local($warned) = 0;
+ my $define_line = 0;
+ my @links = ();
+ my $count = 0;
+ my $warned = 0;
print "<A NAME=$.>";
- for (; int($LNO) == $.; ($LNO, $TAG, $TYPE) =
&anchor'next()) {
+ for (; int($LNO) == $.; ($LNO, $TAG, $TYPE) =
anchor::next()) {
$define_line = $LNO if ($TYPE eq 'D');
+ my $db;
if ($TYPE eq 'R') {
$db = 'GTAGS';
} elsif ($TYPE eq 'Y') {
@@ -2440,14 +2497,14 @@
} else { # 'D', 'M' or 'T'
$db = 'GRTAGS';
}
- local($line) = &cache'get($db, $TAG);
+ my $line = cache::get($db, $TAG);
if (defined($line)) {
- local($href);
+ my $href;
if ($line =~ /^ (\d+) (\d+)/) {
- local($url);
- if ($'dynamic) {
- local($cgi) =
($'action =~ /^\//) ? $'action : "../$'action";
- local($type);
+ my $url;
+ if ($dynamic) {
+ my $cgi =
($action =~ /^\//) ? $action : "../$action";
+ my $type;
if ($db eq
'GTAGS') {
$type =
'definitions';
} elsif ($db eq
'GRTAGS') {
@@ -2457,25 +2514,25 @@
}
$url =
"${cgi}?pattern=$TAG&type=$type";
} else {
- local($dir);
+ my $dir;
if ($TYPE eq
'R') {
- $dir =
$'DEFS;
+ $dir =
$DEFS;
} elsif ($TYPE
eq 'Y') {
- $dir =
$'SYMS;
+ $dir =
$SYMS;
} else {
# 'D', 'M' or 'T'
- $dir =
$'REFS;
+ $dir =
$REFS;
}
- $url =
"../$dir/$1.$'HTML";
+ $url =
"../$dir/$1.$HTML";
}
$href = "<A HREF=$url";
- $href .= " TITLE=\"" .
&'show($TYPE,-1,$2) . "\"";
+ $href .= " TITLE=\"" .
main::show($TYPE,-1,$2) . "\"";
$href .= ">$TAG</A>";
} else {
- local($lno, $filename) =
split(/[ \t]+/, $line);
- local($url) =
&'path2url($filename);
+ my ($lno, $filename) =
split(/[ \t]+/, $line);
+ my $url =
main::path2url($filename);
$filename =~ s!\./!!;
- $href = "<A
HREF=../$'SRCS/$url#$lno";
- $href .= " TITLE=\"" .
&'show($TYPE,$lno,$filename) . "\"";
+ $href = "<A
HREF=../$SRCS/$url#$lno";
+ $href .= " TITLE=\"" .
main::show($TYPE,$lno,$filename) . "\"";
$href .= ">$TAG</A>";
}
# set tag marks and save
hyperlink into @links
@@ -2484,7 +2541,7 @@
$count++;
push(@links,
$href);
} else {
- if ($'wflag) {
+ if ($wflag) {
print
STDERR "Warning: $file $LNO $TAG($TYPE) tag must exist.\n";
$warned
= 1;
}
@@ -2495,97 +2552,98 @@
$count++;
push(@links,
$href);
} else {
- if ($'wflag) {
+ if ($wflag) {
print
STDERR "Warning: $file $LNO $TAG($TYPE) tag must exist.\n";
$warned
= 1;
}
}
}
} else {
- if (($TYPE eq 'R' || $TYPE eq
'Y') && $'wflag) {
+ if (($TYPE eq 'R' || $TYPE eq
'Y') && $wflag) {
print STDERR "Warning:
$file $LNO $TAG($TYPE) found but not defined.\n";
$warned = 1;
}
}
}
# implant links
- local($s);
+ my $s;
for ($count = 0; @links; $count++) {
$s = shift @links;
unless (s/\005$count\005/$s/) {
- if ($'wflag) {
+ if ($wflag) {
print STDERR "Warning:
$file $LNO $TAG($TYPE) tag must exist.\n";
$warned = 1;
}
}
}
- s/\016/$'brace_begin/g;
- s/\017/$'brace_end/g;
- s/\020/$'sharp_begin/g;
- s/\021/$'sharp_end/g;
- s/\022/$'reserved_begin/g;
- s/\023/$'reserved_end/g;
- &unprotect_line();
- if ($warned && $'colorize_warned_line) {
- s/^/$'warned_line_begin/;
- s/$/$'warned_line_end/;
+ s/\016/$brace_begin/g;
+ s/\017/$brace_end/g;
+ s/\020/$sharp_begin/g;
+ s/\021/$sharp_end/g;
+ s/\022/$reserved_begin/g;
+ s/\023/$reserved_end/g;
+ unprotect_line(\$_, address@hidden,
address@hidden);
+ if ($warned && $colorize_warned_line) {
+ s/^/$warned_line_begin/;
+ s/$/$warned_line_end/;
}
# make guide
- if ($define_line && $'definition_header ne 'no')
{
+ if ($define_line && $definition_header ne 'no')
{
$guide = '';
- if ($'definition_header eq 'right') {
+ if ($definition_header eq 'right') {
$guide .= ' ' x 4;
- } elsif ($'nflag) {
+ } elsif ($nflag) {
$guide .= ' ' x ($ncol + 1);
}
- $guide .= "$'comment_begin/* ";
- $guide .=
&link_format(&anchor'getlinks($define_line));
- if ($'show_position) {
- $guide .= $'position_begin;
+ $guide .= "$comment_begin/* ";
+ $guide .=
link_format(anchor::getlinks($define_line));
+ if ($show_position) {
+ $guide .= $position_begin;
$guide .= "[+$define_line
$file]";
- $guide .= $'position_end;
+ $guide .= $position_end;
}
- $guide .= " */$'comment_end";
+ $guide .= " */$comment_end";
}
# print a line
- if ($define_line && $'definition_header eq
'before') {
+ if ($define_line && $definition_header eq
'before') {
print $guide;
print "\n";
}
- printf "%${ncol}d ", $. if ($'nflag);
+ printf "%${ncol}d ", $. if ($nflag);
chop;
print;
- if ($define_line && $'definition_header eq
'right') {
+ if ($define_line && $definition_header eq
'right') {
print $guide;
}
print "\n";
- if ($define_line && $'definition_header eq
'after') {
+ if ($define_line && $definition_header eq
'after') {
print $guide;
print "\n";
}
}
print "</PRE>\n";
}
- print "$'hr\n";
+ print "$hr\n";
print "<A NAME=BOTTOM>\n";
- print "$'comment_begin/* ";
- print &link_format(&anchor'getlinks(-1));
- if ($'show_position) {
- print $'position_begin;
+ print "$comment_begin/* ";
+ print link_format(anchor::getlinks(-1));
+ if ($show_position) {
+ print $position_begin;
print "[+$. $file]";
- print $'position_end;
+ print $position_end;
}
- print " */$'comment_end";
+ print " */$comment_end";
print "\n";
- print $'body_end, "\n";
- print $'html_end, "\n";
+ print $body_end, "\n";
+ print $html_end, "\n";
close(SRC);
- if ($?) { &'error("cannot open file '$file'."); }
+ if ($?) { error("cannot open file '$file'."); }
close(HTML);
select($old);
-}
+} # src2html()
+
#
# fill_anchor: fill anchor into file name
#
@@ -2593,27 +2651,29 @@
# i) $path path name
# r) hypertext file name string
#
-sub fill_anchor {
- local($root, $path) = @_;
- local(@file) = split(/\//, $path);
- local(@path, $url);
+sub fill_anchor
+{
+ my ($root, $path) = @_;
+ my @file = split(/\//, $path);
+ my (@path, $url);
$url = "<A HREF=$root>root</A>/";
while (@file) {
- local($unit) = shift(@file);
+ my $unit = shift(@file);
if (@file == 0) {
$url .= $unit;
last;
}
push(@path, $unit);
$url .= "<A HREF=../files/";
- $url .= &'path2url(join('/', @path));
+ $url .= main::path2url(join('/', @path));
$url .= ">";
$url .= $unit;
$url .= "</A>/";
}
$url;
}
+
#
# protect_line: protect quoted strings
#
@@ -2622,26 +2682,30 @@
# \003 quoted string
# \004 comment
#
-sub protect_line {
- @quoted_strings = ();
- @comments = ();
+sub protect_line
+{
+ my $rLine = shift; # reference to $_
+ my $ra_quoted_strings = shift; # reference to quoted strings
array
+ my $ra_comments = shift;
+ @$ra_quoted_strings = ();
+ @$ra_comments = ();
if ($INCOMMENT) {
# This regular expression was drived from
# perl FAQ 4.27 (ftp://ftp.cis.ufl.edu/pub/perl/faq/FAQ)
- if (s!^([^*]*\*+([^/*][^*]*\*+)*/)!\004!) {
- push(@comments, $1);
+ if ($$rLine =~ s!^([^*]*\*+([^/*][^*]*\*+)*/)!\004!) {
+ push @$ra_comments, $1;
$INCOMMENT = 0;
} else {
- s/^(.*)$/\004/;
- push(@comments, $1);
+ $$rLine =~ s/^(.*)$/\004/;
+ push @$ra_comments, $1;
}
} elsif ($quote) {
- if (s/^(([^$quote\\]|\\.)*$quote)/\003/) {
- push(@quoted_strings, $1);
+ if ($$rLine =~ s/^(([^$quote\\]|\\.)*$quote)/\003/) {
+ push @$ra_quoted_strings, $1;
$quote = '';
} else {
- s/^(.*)$/\003/;
- push(@quoted_strings, $1);
+ $$rLine =~ s/^(.*)$/\003/;
+ push @$ra_quoted_strings, $1;
}
}
#
@@ -2651,31 +2715,31 @@
# to extract them using perl. We should rewrite htags itself
# using other language like lex or yacc in the near future.
#
- while ($isphp ? /(#|\/\/|\/\*|'|")/ : /(\/\/|\/\*|'|")/) {
+ while ( $isphp ? ($$rLine =~ /(#|\/\/|\/\*|'|")/) : ($$rLine =~
/(\/\/|\/\*|'|")/) ) {
if ($isphp && $1 eq '#') {
- s/(#.*$)/\004/;
- push(@comments, $1);
+ $$rLine =~ s/(#.*$)/\004/;
+ push @$ra_comments, $1;
} elsif ($1 eq '//') {
- s/(\/\/.*$)/\004/;
- push(@comments, $1);
+ $$rLine =~ s/(\/\/.*$)/\004/;
+ push @$ra_comments, $1;
} elsif ($1 eq '/*') {
# This regular expression was drived from
# perl FAQ 4.27
(ftp://ftp.cis.ufl.edu/pub/perl/faq/FAQ)
- if (s!(/\*[^*]*\*+([^/*][^*]*\*+)*/)!\004!) {
- push(@comments, $1);
+ if ($$rLine =~
s!(/\*[^*]*\*+([^/*][^*]*\*+)*/)!\004!) {
+ push @$ra_comments, $1;
} else {
- s/(\/\*.*)$/\004/;
- push(@comments, $1);
+ $$rLine =~ s/(\/\*.*)$/\004/;
+ push @$ra_comments, $1;
$INCOMMENT = 1;
}
} else {
$quote = $1;
- if (s/($quote([^$quote\\]|\\.)*$quote)/\003/) {
- push(@quoted_strings, $1);
+ if ($$rLine =~
s/($quote([^$quote\\]|\\.)*$quote)/\003/) {
+ push @$ra_quoted_strings, $1;
$quote = '';
} else {
- s/($quote.*)$/\003/;
- push(@quoted_strings, $1);
+ $$rLine =~ s/($quote.*)$/\003/;
+ push @$ra_quoted_strings, $1;
#
# Accept the single quoted string which
# consists of two or more lines for PHP
@@ -2686,46 +2750,52 @@
}
}
}
+
#
# unprotect_line: recover quoted strings
#
# i) $_ source line
#
-sub unprotect_line {
- local($s);
-
- while (@comments) {
- $s = shift @comments;
+sub unprotect_line
+{
+ my $rLine = shift; # reference to $_
+ my $ra_quoted_strings = shift; # reference to quoted strings
array
+ my $ra_comments = shift;
+ my $s;
+ while (@$ra_comments) {
+ $s = shift @$ra_comments;
# nested tag can be occured but no problem.
- s/\004/$'comment_begin$s$'comment_end/;
+ $$rLine =~ s/\004/$comment_begin$s$comment_end/;
}
- while (@quoted_strings) {
- $s = shift @quoted_strings;
- s/\003/$s/;
+ while (@$ra_quoted_strings) {
+ $s = shift @$ra_quoted_strings;
+ $$rLine =~ s/\003/$s/;
}
}
+
#
# link_format: format hyperlinks.
#
# i) (previous, next, first, last, top, bottom)
#
-sub link_format {
- local(@tag) = @_;
- local(@label) = ($'icon_list) ? @'anchor_comment :
@'anchor_label;
- local(@icons) = @'anchor_icons;
- local($line);
+sub link_format
+{
+ my @tag = @_;
+ my @label = ($icon_list) ? @anchor_comment : @anchor_label;
+ my @icons = @anchor_icons;
+ my $line;
- for $n (0 .. $#label) {
+ for my $n (0 .. $#label) {
if ($n == 6) {
- $line .= "<A HREF=../mains.$'normal_suffix>";
+ $line .= "<A HREF=../mains.$normal_suffix>";
} elsif ($n == 7) {
- $line .= "<A HREF=../help.$'normal_suffix>";
+ $line .= "<A HREF=../help.$normal_suffix>";
} elsif ($tag[$n]) {
$line .= "<A HREF=#$tag[$n]>";
}
- if ($'icon_list) {
- $icon = ($tag[$n] || $n > 5) ? "$icons[$n]" :
"n_$icons[$n]";
- $line .= "<IMG SRC=../icons/$icon
ALT=\[$label[$n]\] $'icon_spec>";
+ if ($icon_list) {
+ my $icon = ($tag[$n] || $n > 5) ? "$icons[$n]" :
"n_$icons[$n]";
+ $line .= "<IMG SRC=../icons/$icon
ALT=\[$label[$n]\] $icon_spec>";
} else {
$line .= "\[$label[$n]\]";
}
@@ -2738,6 +2808,9 @@
# ANCHOR PACKAGE
#=======================================================================
==
package anchor;
+
+my (@ANCHORS, $FIRST, $LAST, $CURRENT, $CURRENTDEF);
+
#
# load: load anchors belonging to specified file.
#
@@ -2746,8 +2819,9 @@
# go) FIRST first definition
# go) LAST last definition
#
+
sub load {
- local($file, $notsource) = @_;
+ my ($file, $notsource) = @_;
@ANCHORS = ();
$FIRST = $LAST = 0;
@@ -2756,15 +2830,15 @@
return;
}
- local(@keys);
- foreach $db (&'get_taglist()) {
- local($option) = &'get_option($db);
- local($pipein) = "global -fn$option ";
- $pipein .= ($'w32) ? "\"$file\"" : "'$file'";
- open(PIPE, "$pipein |") || &'error("cannot fork.");
+ my @keys;
+ foreach my $db (main::get_taglist()) {
+ my $option = main::get_option($db);
+ my $pipein = "global -fn$option ";
+ $pipein .= ($w32) ? "\"$file\"" : "'$file'";
+ open(PIPE, "$pipein |") || error("cannot fork.");
while (<PIPE>) {
- local($tag, $lno, $filename, $image) =
split(/\s+/, $_, 4);
- local($type);
+ my ($tag, $lno, $filename, $image) =
split(/\s+/, $_, 4);
+ my $type;
if ($db eq 'GTAGS') {
if ($image =~ /^#[ \t]*(define|undef)/)
{
$type = 'M';
@@ -2779,23 +2853,22 @@
$type = 'Y';
}
push(@keys, int($lno));
- push(@ANCHORS, "$lno$type$tag");
+ push(@ANCHORS, [ $lno, $type, $tag ]);
}
close(PIPE);
- if ($?) { &'error("'$pipein' failed."); }
+ if ($?) { error("'$pipein' failed."); }
}
- sub compare { $keys[$a] <=> $keys[$b]; }
- @ANCHORS = @ANCHORS[sort compare 0 .. $#keys];
- local($c);
+ @ANCHORS = @ANCHORS[sort { $keys[$a] <=> $keys[$b] } 0 ..
$#keys];
+ my $c;
for ($c = 0; $c < @ANCHORS; $c++) {
- local($lno, $type, $tag) = split(/(\D)/, $ANCHORS[$c],
2);
+ my ($lno, $type, $tag) = @{ $ANCHORS[$c] };
if ($type eq 'D') {
$FIRST = $lno;
last;
}
}
for ($c = $#ANCHORS; $c >= 0; $c--) {
- local($lno, $type, $tag) = split(/(\D)/, $ANCHORS[$c],
2);
+ my ($lno, $type, $tag) = @{ $ANCHORS[$c] };
if ($type eq 'D') {
$LAST = $lno;
last;
@@ -2807,7 +2880,7 @@
#
sub first {
$CURRENT = 0;
- local($lno, $type, $tag) = split(/(\D)/, $ANCHORS[$CURRENT], 2);
+ my ($lno, $type, $tag) = @{ $ANCHORS[$CURRENT] };
$CURRENTDEF = $CURRENT if ($type eq 'D');
($lno, $tag, $type);
@@ -2819,7 +2892,7 @@
if (++$CURRENT > $#ANCHORS) {
return ('', '', '');
}
- local($lno, $type, $tag) = split(/(\D)/, $ANCHORS[$CURRENT], 2);
+ my ($lno, $type, $tag) = @{ $ANCHORS[$CURRENT] };
$CURRENTDEF = $CURRENT if ($type eq 'D');
($lno, $tag, $type);
@@ -2833,15 +2906,15 @@
# r) (previous, next, first, last, top, bottom)
#
sub getlinks {
- local($linenumber) = @_;
- local($prev, $next, $first, $last, $top, $bottom);
+ my $linenumber = shift;
+ my ($prev, $next, $first, $last, $top, $bottom);
$prev = $next = $first = $last = $top = $bottom = 0;
if ($linenumber >= 1) {
- local($c, $p, $n);
+ my ($c, $p, $n);
if ($CURRENTDEF == 0) {
for ($c = 0; $c <= $#ANCHORS; $c++) {
- local($lno, $type, $tag) = split(/(\D)/,
$ANCHORS[$c], 2);
+ my ($lno, $type, $tag) = @{ $ANCHORS[$c]
};
if ($lno == $linenumber && $type eq 'D')
{
last;
}
@@ -2849,7 +2922,7 @@
$CURRENTDEF = $c;
} else {
for ($c = $CURRENTDEF; $c >= 0; $c--) {
- local($lno, $type, $tag) = split(/(\D)/,
$ANCHORS[$c], 2);
+ my ($lno, $type, $tag) = @{ $ANCHORS[$c]
};
if ($lno == $linenumber && $type eq 'D')
{
last;
}
@@ -2857,14 +2930,14 @@
}
$p = $n = $c;
while (--$p >= 0) {
- local($lno, $type, $tag) = split(/(\D)/,
$ANCHORS[$p], 2);
+ my ($lno, $type, $tag) = @{ $ANCHORS[$p] };
if ($type eq 'D') {
$prev = $lno;
last;
}
}
while (++$n <= $#ANCHORS) {
- local($lno, $type, $tag) = split(/(\D)/,
$ANCHORS[$n], 2);
+ my ($lno, $type, $tag) = @{ $ANCHORS[$n] };
if ($type eq 'D') {
$next = $lno;
last;
@@ -2887,6 +2960,10 @@
# CACHE PACKAGE
#=======================================================================
==
package cache;
+
+my (%GTAGS, %GRTAGS, %GSYMS);
+my ($GTAGS, $GRTAGS, $GSYMS);
+
#
# open: open tag cache
#
@@ -2896,16 +2973,16 @@
# other: sized cache
#
sub open {
- unless ($'use_cache_file) {
+ unless ($use_cache_file) {
return;
}
- $GTAGS = "$'tmp/htagd$$";
- dbmopen(%GTAGS, $GTAGS, 0600) || &'error("cannot make cache file
'$GTAGS'.");
- $GRTAGS = "$'tmp/htagr$$";
- dbmopen(%GRTAGS, $GRTAGS, 0600) || &'error("cannot make cache
file '$GRTAGS'.");
- if ($'symbol) {
- $GSYMS = "$'tmp/htagy$$";
- dbmopen(%GSYMS, $GSYMS, 0600) || &'error("cannot make
cache file '$GSYMS'.");
+ $GTAGS = "$tmp/htagd$$";
+ dbmopen(%GTAGS, $GTAGS, 0600) || error("cannot make cache file
'$GTAGS'.");
+ $GRTAGS = "$tmp/htagr$$";
+ dbmopen(%GRTAGS, $GRTAGS, 0600) || error("cannot make cache file
'$GRTAGS'.");
+ if ($symbol) {
+ $GSYMS = "$tmp/htagy$$";
+ dbmopen(%GSYMS, $GSYMS, 0600) || error("cannot make
cache file '$GSYMS'.");
}
}
#
@@ -2916,7 +2993,7 @@
# i) $line tag line
#
sub put {
- local($db, $tag, $line) = @_;
+ my ($db, $tag, $line) = @_;
if ($db eq 'GTAGS') {
$GTAGS{$tag} = $line;
} elsif ($db eq 'GRTAGS') {
@@ -2933,7 +3010,7 @@
# r) tag line
#
sub get {
- local($db, $tag) = @_;
+ my ($db, $tag) = @_;
if ($db eq 'GTAGS') {
return $GTAGS{$tag};
} elsif ($db eq 'GRTAGS') {
@@ -2946,7 +3023,7 @@
# close: close cache
#
sub close {
- unless ($'use_cache_file) {
+ unless ($use_cache_file) {
return;
}
if ($GTAGS) {
@@ -2962,3 +3039,30 @@
unlink("$GSYMS", "$GSYMS.db", "$GSYMS.pag",
"$GSYMS.dir");
}
}
+
+#
+# clearup: close cache, but don't delete files
+# clear up memory!
+#
+sub clearup {
+ unless ($use_cache_file) {
+ return;
+ }
+ if ($GTAGS) {
+ dbmclose(%GTAGS);
+ }
+ if ($GRTAGS) {
+ dbmclose(%GRTAGS);
+ }
+ if ($GSYMS) {
+ dbmclose(%GSYMS);
+ }
+ %GTAGS = ();
+ %GRTAGS = ();
+ undef %GTAGS;
+ undef %GRTAGS;
+ if ($symbol) {
+ %GSYMS = ();
+ undef %GSYMS;
+ }
+}
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- PATCH htags improvements.,
Bakken, Luke <=