[Lxr-commits] CVS: lxr/lib/LXR Common.pm,1.48,1.49 Config.pm,1.31,1.32 Files.pm,1.7,1.8 Index.pm,1.1
Brought to you by:
ajlittoz
Menu
▾
▴
[Lxr-commits] CVS: lxr/lib/LXR Common.pm,1.48,1.49 Config.pm,1.31,1.32 Files.pm,1.7,1.8 Index.pm,1.10,1.11 Lang.pm,1.31,1.32 SimpleParse.pm,1.16,1.17 Tagger.pm,1.21,1.22
|
From: Dave B. <bro...@us...> - 2004-07-21 20:44:41
|
Update of /cvsroot/lxr/lxr/lib/LXR In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv25090/lib/LXR Modified Files: Common.pm Config.pm Files.pm Index.pm Lang.pm SimpleParse.pm Tagger.pm Log Message: perltidy with options: -ce -pt=2 -nolq -nsfs Index: Common.pm =================================================================== RCS file: /cvsroot/lxr/lxr/lib/LXR/Common.pm,v retrieving revision 1.48 retrieving revision 1.49 diff -u -d -r1.48 -r1.49 --- Common.pm 19 Jul 2004 19:50:20 -0000 1.48 +++ Common.pm 21 Jul 2004 20:44:30 -0000 1.49 @@ -40,7 +40,7 @@ &markupstring &httpinit &makeheader &makefooter &expandtemplate &httpclean); -%EXPORT_TAGS = ( 'html' => [@EXPORT_OK] ); +%EXPORT_TAGS = ('html' => [@EXPORT_OK]); require Local; require LXR::SimpleParse; @@ -54,23 +54,23 @@ $tmpcounter = 23; sub warning { - my $c = join( ", line ", (caller)[ 0, 2 ] ); - print( STDERR "[", scalar(localtime), "] warning: $c: $_[0]\n" ); + my $c = join(", line ", (caller)[ 0, 2 ]); + print(STDERR "[", scalar(localtime), "] warning: $c: $_[0]\n"); print("<h4 align=\"center\"><i>** Warning: $_[0]</i></h4>\n") if $wwwdebug; } sub fatal { - my $c = join( ", line ", (caller)[ 0, 2 ] ); - print( STDERR "[", scalar(localtime), "] fatal: $c: $_[0]\n" ); - print( STDERR '[@INC ', join( " ", @INC ), ' $0 ', $0, "\n" ); - print( STDERR '$config', join( " ", %$config ), "\n" ) if ref($config) eq "HASH"; + my $c = join(", line ", (caller)[ 0, 2 ]); + print(STDERR "[", scalar(localtime), "] fatal: $c: $_[0]\n"); + print(STDERR '[@INC ', join(" ", @INC), ' $0 ', $0, "\n"); + print(STDERR '$config', join(" ", %$config), "\n") if ref($config) eq "HASH"; print("<h4 align=\"center\"><i>** Fatal: $_[0]</i></h4>\n") if $wwwdebug; exit(1); } sub abortall { - my $c = join( ", line ", (caller)[ 0, 2 ] ); - print( STDERR "[", scalar(localtime), "] abortall: $c: $_[0]\n" ); + my $c = join(", line ", (caller)[ 0, 2 ]); + print(STDERR "[", scalar(localtime), "] abortall: $c: $_[0]\n"); print( "Content-Type: text/html; charset=iso-8859-1\n\n", "<html>\n<head>\n<title>Abort</title>\n</head>\n", @@ -101,62 +101,62 @@ } @args = (); - foreach ( $config->allvariables ) { + foreach ($config->allvariables) { $val = $args{$_} || $config->variable($_); - push( @args, "$_=$val" ) unless ( $val eq $config->vardefault($_) ); - delete( $args{$_} ); + push(@args, "$_=$val") unless ($val eq $config->vardefault($_)); + delete($args{$_}); } - foreach ( keys(%args) ) { - push( @args, "$_=$args{$_}" ); + foreach (keys(%args)) { + push(@args, "$_=$args{$_}"); } - return ( $#args < 0 ? '' : '?' . join( ';', @args ) ); + return ($#args < 0 ? '' : '?' . join(';', @args)); } sub fileref { - my ( $desc, $css, $path, $line, @args ) = @_; + my ($desc, $css, $path, $line, @args) = @_; # jwz: URL-quote any special characters. $path =~ s|([^-a-zA-Z0-9.\@/_\r\n])|sprintf("%%%02X", ord($1))|ge; - if ( $line > 0 && length($line) < 3 ) { - $line = ( '0' x ( 3 - length($line) ) ) . $line; + if ($line > 0 && length($line) < 3) { + $line = ('0' x (3 - length($line))) . $line; } return ("<a class='$css' href=\"$config->{virtroot}/source$path" . &urlargs(@args) - . ( $line > 0 ? "#$line" : "" ) - . "\"\>$desc</a>" ); + . ($line > 0 ? "#$line" : "") + . "\"\>$desc</a>"); } sub diffref { - my ( $desc, $css, $path, $darg ) = @_; + my ($desc, $css, $path, $darg) = @_; my $dval; - ( $darg, $dval ) = $darg =~ /(.*?)=(.*)/; + ($darg, $dval) = $darg =~ /(.*?)=(.*)/; return ("<a class='$css' href=\"$config->{virtroot}/diff$path" - . &urlargs( ( $darg ? "diffvar=$darg" : "" ), ( $dval ? "diffval=$dval" : "" ) ) - . "\"\>$desc</a>" ); + . &urlargs(($darg ? "diffvar=$darg" : ""), ($dval ? "diffval=$dval" : "")) + . "\"\>$desc</a>"); } sub idref { - my ( $desc, $css, $id, @args ) = @_; + my ($desc, $css, $id, @args) = @_; return ("<a class='$css' href=\"$config->{virtroot}/ident" - . &urlargs( ( $id ? "i=$id" : "" ), @args ) - . "\"\>$desc</a>" ); + . &urlargs(($id ? "i=$id" : ""), @args) + . "\"\>$desc</a>"); } sub incref { - my ( $name, $css, $file, @paths ) = @_; - my ( $dir, $path ); + my ($name, $css, $file, @paths) = @_; + my ($dir, $path); - push( @paths, $config->incprefix ); + push(@paths, $config->incprefix); foreach $dir (@paths) { $dir =~ s/\/+$//; - $path = $config->mappath( $dir . "/" . $file ); - return &fileref( $name, $css, $path ) if $files->isfile( $path, $release ); + $path = $config->mappath($dir . "/" . $file); + return &fileref($name, $css, $path) if $files->isfile($path, $release); } @@ -165,7 +165,7 @@ sub http_wash { my $t = shift; - if ( !defined($t) ) { + if (!defined($t)) { return (undef); } @@ -181,7 +181,7 @@ # dme: Smaller version of the markupfile function meant for marking up # the descriptions in source directory listings. sub markupstring { - my ( $string, $virtp ) = @_; + my ($string, $virtp) = @_; # Mark special characters so they don't get processed just yet. $string =~ s/([\&\<\>])/\0$1/g; @@ -212,7 +212,7 @@ # HTMLify file names, assuming file is in the current directory. $string =~ -s#\b(([\w\-_\/]+\.(c|h|cc|cp|hpp|cpp|java))|README)\b#<a href=\"$config->{virtroot}/source$virtp$1\">$1</a>#g; + s#\b(([\w\-_\/]+\.(c|h|cc|cp|hpp|cpp|java))|README)\b#<a href=\"$config->{virtroot}/source$virtp$1\">$1</a>#g; return ($string); } @@ -228,7 +228,7 @@ if ( $string =~ /....../ - && ( $string =~ /_/ || $string =~ /.[A-Z]/ ) + && ($string =~ /_/ || $string =~ /.[A-Z]/) # && defined($xref{$string}) FIXME ) @@ -260,55 +260,54 @@ #_PH_ supress block is here to avoid the <pre> tag output #while called from diff - my ( $fileh, $outfun ) = @_; + my ($fileh, $outfun) = @_; my ($dir) = $pathname =~ m|^(.*/)|; my $line = '001'; - my @ltag = &fileref( 1, "fline", $pathname, 1 ) =~ /^(<a)(.*\#)001(\">)1(<\/a>)$/; + my @ltag = &fileref(1, "fline", $pathname, 1) =~ /^(<a)(.*\#)001(\">)1(<\/a>)$/; $ltag[0] .= ' name='; $ltag[3] .= " "; - my @itag = &idref( 1, "fid", 1 ) =~ /^(.*=)1(\">)1(<\/a>)$/; - my $lang = new LXR::Lang( $pathname, $release, @itag ); + my @itag = &idref(1, "fid", 1) =~ /^(.*=)1(\">)1(<\/a>)$/; + my $lang = new LXR::Lang($pathname, $release, @itag); # A source code file if ($lang) { my $language = $lang->language; # To get back to the key to lookup the tabwidth. + &LXR::SimpleParse::init($fileh, $config->filetype->{$language}[3], $lang->parsespec); - &LXR::SimpleParse::init( $fileh, $config->filetype->{$language}[3], $lang->parsespec ); - - my ( $btype, $frag ) = &LXR::SimpleParse::nextfrag; + my ($btype, $frag) = &LXR::SimpleParse::nextfrag; #&$outfun("<pre class=\"file\">\n"); - &$outfun( join( $line++, @ltag ) ) if defined($frag); + &$outfun(join($line++, @ltag)) if defined($frag); - while ( defined($frag) ) { + while (defined($frag)) { &markspecials($frag); - if ( $btype eq 'comment' ) { + if ($btype eq 'comment') { # Comment # Convert mail adresses to mailto: &freetextmarkup($frag); - $lang->processcomment( \$frag ); - } elsif ( $btype eq 'string' ) { + $lang->processcomment(\$frag); + } elsif ($btype eq 'string') { # String $frag = "<span class='string'>$frag</span>"; - } elsif ( $btype eq 'include' ) { + } elsif ($btype eq 'include') { # Include directive - $lang->processinclude( \$frag, $dir ); + $lang->processinclude(\$frag, $dir); } else { # Code - $lang->processcode( \$frag ); + $lang->processcode(\$frag); } &htmlquote($frag); my $ofrag = $frag; - ( $btype, $frag ) = &LXR::SimpleParse::nextfrag; + ($btype, $frag) = &LXR::SimpleParse::nextfrag; $ofrag =~ s/\n$// unless defined($frag); $ofrag =~ s/\n/"\n".join($line++, @ltag)/ge; @@ -317,15 +316,15 @@ } #&$outfun("</pre>"); - } elsif ( $pathname =~ /$config->graphicfile/ ) { + } elsif ($pathname =~ /$config->graphicfile/) { &$outfun("<ul><table><tr><th valign=\"center\"><b>Image: </b></th>"); - &$outfun( "<img src=\"$config->{virtroot}/source" + &$outfun("<img src=\"$config->{virtroot}/source" . $pathname . &urlargs("raw=1") - . "\" border=\"0\" alt=\"$pathname\">\n" ); + . "\" border=\"0\" alt=\"$pathname\">\n"); &$outfun("</tr></td></table></ul>"); - } elsif ( $pathname =~ m|/CREDITS$| ) { - while ( defined( $_ = $fileh->getline ) ) { + } elsif ($pathname =~ m|/CREDITS$|) { + while (defined($_ = $fileh->getline)) { &LXR::SimpleParse::untabify($_); &markspecials($_); &htmlquote($_); @@ -334,16 +333,16 @@ s/^(W:\s+)(.*)/$1<a href=\"$2\">$2<\/a>/gm; # &$outfun("<a name=\"L$.\"><\/a>".$_); - &$outfun( join( $line++, @ltag ) . $_ ); + &$outfun(join($line++, @ltag) . $_); } } else { - return unless defined( $_ = $fileh->getline ); + return unless defined($_ = $fileh->getline); # If it's not a script or something with an Emacs spec header and # the first line is very long or containts control characters... if ( !/^\#!/ && !/-\*-.*-\*-/i - && ( length($_) > 132 || /[\000-\010\013\014\016-\037\200-]/ ) ) + && (length($_) > 132 || /[\000-\010\013\014\016-\037\200-]/)) { # We postulate that it's a binary file. @@ -353,7 +352,7 @@ my $uname = $pathname; $uname =~ s|([^-a-zA-Z0-9.\@/_\r\n])|sprintf("%%%02X", ord($1))|ge; - &$outfun( "<a href=\"$config->{virtroot}/source" . $uname . &urlargs("raw=1") . "\">" ); + &$outfun("<a href=\"$config->{virtroot}/source" . $uname . &urlargs("raw=1") . "\">"); &$outfun("$pathname</a></b>"); &$outfun("</ul>"); @@ -367,8 +366,8 @@ &htmlquote($_); # &$outfun("<a name=\"L$.\"><\/a>".$_); - &$outfun( join( $line++, @ltag ) . $_ ); - } while ( defined( $_ = $fileh->getline ) ); + &$outfun(join($line++, @ltag) . $_); + } while (defined($_ = $fileh->getline)); #&$outfun("</pre>"); } @@ -378,7 +377,7 @@ sub fixpaths { my $node = '/' . shift; - while ( $node =~ s|/[^/]+/\.\./|/|g ) { } + while ($node =~ s|/[^/]+/\.\./|/|g) { } $node =~ s|/\.\./|/|g; $node .= '/' if $files->isdir($node); @@ -400,8 +399,8 @@ # Todo: check lxr.conf. - my $time = $files->getfiletime( $pathname, $release ); - my $time2 = ( stat( $config->confpath ) )[9]; + my $time = $files->getfiletime($pathname, $release); + my $time2 = (stat($config->confpath))[9]; $time = $time2 if $time2 > $time; # Remove this to see if we get a speed increase by not stating all @@ -422,21 +421,21 @@ # $time = $time2 if $time2 > $time; # } - if ( $time > 0 ) { - my ( $sec, $min, $hour, $mday, $mon, $year, $wday ) = gmtime($time); - my @days = ( "Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun" ); + if ($time > 0) { + my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($time); + my @days = ("Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun"); my @months = - ( "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" ); + ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"); $year += 1900; $wday = $days[$wday]; $mon = $months[$mon]; # Last-Modified: Wed, 10 Dec 1997 00:55:32 GMT - printf( "Last-Modified: %s, %2d %s %d %02d:%02d:%02d GMT\n", - $wday, $mday, $mon, $year, $hour, $min, $sec ); + printf("Last-Modified: %s, %2d %s %d %02d:%02d:%02d GMT\n", + $wday, $mday, $mon, $year, $hour, $min, $sec); } - if ( $HTTP->{'param'}->{'raw'} ) { + if ($HTTP->{'param'}->{'raw'}) { #FIXME - need more types here my %type = ( @@ -444,8 +443,8 @@ 'html' => 'text/html' ); - if ( $pathname =~ /\.([^.]+)$/ && $type{$1} ) { - print( "Content-type: ", $type{$1}, "\n" ); + if ($pathname =~ /\.([^.]+)$/ && $type{$1}) { + print("Content-type: ", $type{$1}, "\n"); } else { print("Content-Type: text/plain\n"); } @@ -493,7 +492,7 @@ $SIG{__WARN__} = \&warning; $SIG{__DIE__} = \&fatal; - $HTTP->{'path_info'} = http_wash( $ENV{'PATH_INFO'} ); + $HTTP->{'path_info'} = http_wash($ENV{'PATH_INFO'}); $HTTP->{'this_url'} = 'http://' . $ENV{'SERVER_NAME'}; $HTTP->{'this_url'} .= ':' . $ENV{'SERVER_PORT'} @@ -509,19 +508,19 @@ $HTTP->{'param'}->{'i'} ||= $HTTP->{'param'}->{'identifier'}; $identifier = $HTTP->{'param'}->{'i'}; - $config = new LXR::Config( $HTTP->{'this_url'} ); + $config = new LXR::Config($HTTP->{'this_url'}); die "Can't find config for " . $HTTP->{'this_url'} if !defined($config); - $files = new LXR::Files( $config->sourceroot ); + $files = new LXR::Files($config->sourceroot); die "Can't create Files for " . $config->sourceroot if !defined($files); - $index = new LXR::Index( $config->dbname ); + $index = new LXR::Index($config->dbname); die "Can't create Index for " . $config->dbname if !defined($index); - foreach ( $config->allvariables ) { - $config->variable( $_, $HTTP->{'param'}->{$_} ) if $HTTP->{'param'}->{$_}; + foreach ($config->allvariables) { + $config->variable($_, $HTTP->{'param'}->{$_}) if $HTTP->{'param'}->{$_}; } $release = $config->variable('v'); - $pathname = fixpaths( $HTTP->{'path_info'} || $HTTP->{'param'}->{'file'} ); + $pathname = fixpaths($HTTP->{'path_info'} || $HTTP->{'param'}->{'file'}); printhttp; } @@ -533,10 +532,10 @@ } sub expandtemplate { - my ( $templ, %expfunc ) = @_; - my ( $expfun, $exppar ); + my ($templ, %expfunc) = @_; + my ($expfun, $exppar); - while ( $templ =~ s/(\{[^\{\}]*)\{([^\{\}]*)\}/$1\01$2\02/s ) { } + while ($templ =~ s/(\{[^\{\}]*)\{([^\{\}]*)\}/$1\01$2\02/s) { } $templ =~ s/(\$(\w+)(\{([^\}]*)\}|))/{ if (defined($expfun = $expfunc{$2})) { @@ -564,13 +563,13 @@ # templates than it used to be. State information is passed via # function arguments, as God intended. sub bannerexpand { - my ( $templ, $who ) = @_; + my ($templ, $who) = @_; - if ( $who eq 'source' || $who eq 'sourcedir' || $who eq 'diff' ) { + if ($who eq 'source' || $who eq 'sourcedir' || $who eq 'diff') { my $fpath = ''; - my $furl = fileref( $config->sourcerootname . '/', "banner", '/' ); + my $furl = fileref($config->sourcerootname . '/', "banner", '/'); - foreach ( $pathname =~ m|([^/]+/?)|g ) { + foreach ($pathname =~ m|([^/]+/?)|g) { $fpath .= $_; # jwz: put a space after each / in the banner so that it's @@ -579,7 +578,7 @@ # so we have to use a real space. It's somewhat ugly to # have these spaces be visible, but not as ugly as getting # a horizontal scrollbar... - $furl .= ' ' . fileref( $_, "banner", "/$fpath" ); + $furl .= ' ' . fileref($_, "banner", "/$fpath"); } $furl =~ s|/</a>|</a>/|gi; @@ -594,19 +593,19 @@ } sub titleexpand { - my ( $templ, $who ) = @_; + my ($templ, $who) = @_; - if ( $who eq 'source' || $who eq 'diff' || $who eq 'sourcedir' ) { + if ($who eq 'source' || $who eq 'diff' || $who eq 'sourcedir') { return $config->sourcerootname . $pathname; - } elsif ( $who eq 'ident' ) { + } elsif ($who eq 'ident') { my $i = $HTTP->{'param'}->{'i'}; - return $config->sourcerootname . ' identfier search' . ( $i ? ": $i" : '' ); - } elsif ( $who eq 'search' ) { + return $config->sourcerootname . ' identfier search' . ($i ? ": $i" : ''); + } elsif ($who eq 'search') { my $s = $HTTP->{'param'}->{'string'}; - return $config->sourcerootname . ' freetext search' . ( $s ? ": $s" : '' ); - } elsif ( $who eq 'find' ) { + return $config->sourcerootname . ' freetext search' . ($s ? ": $s" : ''); + } elsif ($who eq 'find') { my $s = $HTTP->{'param'}->{'string'}; - return $config->sourcerootname . ' file search' . ( $s ? ": $s" : '' ); + return $config->sourcerootname . ' file search' . ($s ? ": $s" : ''); } } @@ -618,7 +617,7 @@ } sub baseurl { - ( my $url = $config->baseurl ) =~ s|/*$|/|; + (my $url = $config->baseurl) =~ s|/*$|/|; return $url; } @@ -638,51 +637,51 @@ # by filling in all the relevant values in the nested "modelink" # template. sub modeexpand { - my ( $templ, $who ) = @_; + my ($templ, $who) = @_; my $modex = ''; my @mlist = (); my $mode; - if ( $who eq 'source' || $who eq 'sourcedir' ) { - push( @mlist, "<span class='modes-sel'>source navigation</span>" ); + if ($who eq 'source' || $who eq 'sourcedir') { + push(@mlist, "<span class='modes-sel'>source navigation</span>"); } else { - push( @mlist, fileref( "source navigation", "modes", $pathname ) ); + push(@mlist, fileref("source navigation", "modes", $pathname)); } - if ( $who eq 'diff' ) { - push( @mlist, "<span class='modes-sel'>diff markup</span>" ); - } elsif ( $who eq 'source' && $pathname !~ m|/$| ) { - push( @mlist, diffref( "diff markup", "modes", $pathname ) ); + if ($who eq 'diff') { + push(@mlist, "<span class='modes-sel'>diff markup</span>"); + } elsif ($who eq 'source' && $pathname !~ m|/$|) { + push(@mlist, diffref("diff markup", "modes", $pathname)); } - if ( $who eq 'ident' ) { - push( @mlist, "<span class='modes-sel'>identifier search</span>" ); + if ($who eq 'ident') { + push(@mlist, "<span class='modes-sel'>identifier search</span>"); } else { - push( @mlist, idref( "identifier search", "modes", "" ) ); + push(@mlist, idref("identifier search", "modes", "")); } - if ( $who eq 'search' ) { - push( @mlist, "<span class='modes-sel'>freetext search</span>" ); + if ($who eq 'search') { + push(@mlist, "<span class='modes-sel'>freetext search</span>"); } else { - push( @mlist, + push(@mlist, "<a class=\"modes\" " . "href=\"$config->{virtroot}/search" . urlargs - . "\">freetext search</a>" ); + . "\">freetext search</a>"); } - if ( $who eq 'find' ) { - push( @mlist, "<span class='modes-sel'>file search</span>" ); + if ($who eq 'find') { + push(@mlist, "<span class='modes-sel'>file search</span>"); } else { - push( @mlist, + push(@mlist, "<a class='modes' " . "href=\"$config->{virtroot}/find" . urlargs - . "\">file search</a>" ); + . "\">file search</a>"); } foreach $mode (@mlist) { - $modex .= expandtemplate( $templ, ( 'modelink' => sub { return $mode } ) ); + $modex .= expandtemplate($templ, ('modelink' => sub { return $mode })); } return ($modex); @@ -692,54 +691,54 @@ # "variables" template using varname and varlinks, the latter in turn # expands the nested "varlinks" template using varval. sub varlinks { - my ( $templ, $who, $var ) = @_; + my ($templ, $who, $var) = @_; my $vlex = ''; - my ( $val, $oldval ); + my ($val, $oldval); my $vallink; $oldval = $config->variable($var); - foreach $val ( $config->varrange($var) ) { - if ( $val eq $oldval ) { + foreach $val ($config->varrange($var)) { + if ($val eq $oldval) { $vallink = "<span class=\"var-sel\">$val</span>"; } else { - if ( $who eq 'source' || $who eq 'sourcedir' ) { - $vallink = &fileref( $val, "varlink", $config->mappath( $pathname, "$var=$val" ), - 0, "$var=$val" ); + if ($who eq 'source' || $who eq 'sourcedir') { + $vallink = &fileref($val, "varlink", $config->mappath($pathname, "$var=$val"), + 0, "$var=$val"); - } elsif ( $who eq 'diff' ) { - $vallink = &diffref( $val, "varlink", $pathname, "$var=$val" ); - } elsif ( $who eq 'ident' ) { - $vallink = &idref( $val, "varlink", $identifier, "$var=$val" ); - } elsif ( $who eq 'search' ) { + } elsif ($who eq 'diff') { + $vallink = &diffref($val, "varlink", $pathname, "$var=$val"); + } elsif ($who eq 'ident') { + $vallink = &idref($val, "varlink", $identifier, "$var=$val"); + } elsif ($who eq 'search') { $vallink = "<a class=\"varlink\" href=\"$config->{virtroot}/search" - . &urlargs( "$var=$val", "string=" . $HTTP->{'param'}->{'string'} ) + . &urlargs("$var=$val", "string=" . $HTTP->{'param'}->{'string'}) . "\">$val</a>"; - } elsif ( $who eq 'find' ) { + } elsif ($who eq 'find') { $vallink = "<a class=\"varlink\" href=\"$config->{virtroot}/find" - . &urlargs( "$var=$val", "string=" . $HTTP->{'param'}->{'string'} ) + . &urlargs("$var=$val", "string=" . $HTTP->{'param'}->{'string'}) . "\">$val</a>"; } } - $vlex .= expandtemplate( $templ, ( 'varvalue' => sub { return $vallink } ) ); + $vlex .= expandtemplate($templ, ('varvalue' => sub { return $vallink })); } return ($vlex); } sub varexpand { - my ( $templ, $who ) = @_; + my ($templ, $who) = @_; my $varex = ''; my $var; - foreach $var ( $config->allvariables ) { + foreach $var ($config->allvariables) { $varex .= expandtemplate( $templ, ( 'varname' => sub { $config->vardescription($var) }, - 'varlinks' => sub { varlinks( @_, $who, $var ) } + 'varlinks' => sub { varlinks(@_, $who, $var) } ) ); } @@ -748,10 +747,10 @@ sub devinfo { my ($templ) = @_; - my ( @mods, $mod, $path ); - my %mods = ( 'main' => $0, %INC ); + my (@mods, $mod, $path); + my %mods = ('main' => $0, %INC); - while ( ( $mod, $path ) = each %mods ) { + while (($mod, $path) = each %mods) { $mod =~ s/.pm$//; $mod =~ s|/|::|g; $path =~ s|/+|/|g; @@ -759,7 +758,7 @@ no strict 'refs'; next unless ${ $mod . '::CVSID' }; - push( @mods, [ ${ $mod . '::CVSID' }, $path, ( stat($path) )[9] ] ); + push(@mods, [ ${ $mod . '::CVSID' }, $path, (stat($path))[9] ]); } return join( @@ -770,7 +769,7 @@ ( 'moduleid' => sub { $$_[0] }, 'modpath' => sub { $$_[1] }, - 'modtime' => sub { scalar( localtime( $$_[2] ) ) } + 'modtime' => sub { scalar(localtime($$_[2])) } ) ); } @@ -783,16 +782,16 @@ sub atticlink { return " " if !$files->isa("LXR::Files::CVS"); return " " if $ENV{'SCRIPT_NAME'} !~ m|/source$|; - if ( $HTTP->{'param'}->{'showattic'} ) { + if ($HTTP->{'param'}->{'showattic'}) { return ("<a class='modes' href=\"$config->{virtroot}/source" . $HTTP->{'path_info'} . &urlargs("showattic=0") - . "\">Hide attic files</a>" ); + . "\">Hide attic files</a>"); } else { return ("<a class='modes' href=\"$config->{virtroot}/source" . $HTTP->{'path_info'} . &urlargs("showattic=1") - . "\">Show attic files</a>" ); + . "\">Show attic files</a>"); } } @@ -803,20 +802,20 @@ $tmplname = $who . "head"; - unless ( $who ne "sourcedir" || $config->sourcedirhead ) { + unless ($who ne "sourcedir" || $config->sourcedirhead) { $tmplname = "sourcehead"; } - unless ( $config->value($tmplname) ) { + unless ($config->value($tmplname)) { $tmplname = "htmlhead"; } - if ( $config->value($tmplname) ) { - if ( open( TEMPL, $config->value($tmplname) ) ) { + if ($config->value($tmplname)) { + if (open(TEMPL, $config->value($tmplname))) { local ($/) = undef; $template = <TEMPL>; close(TEMPL); } else { - warning( "Template " . $config->value($tmplname) . " does not exist." ); + warning("Template " . $config->value($tmplname) . " does not exist."); } } @@ -825,15 +824,15 @@ expandtemplate( $template, ( - 'title' => sub { titleexpand( @_, $who ) }, - 'banner' => sub { bannerexpand( @_, $who ) }, + 'title' => sub { titleexpand(@_, $who) }, + 'banner' => sub { bannerexpand(@_, $who) }, 'baseurl' => sub { baseurl(@_) }, 'stylesheet' => sub { stylesheet(@_) }, 'dotdoturl' => sub { dotdoturl(@_) }, 'thisurl' => sub { thisurl(@_) }, 'pathname' => sub { pathname(@_) }, - 'modes' => sub { modeexpand( @_, $who ) }, - 'variables' => sub { varexpand( @_, $who ) }, + 'modes' => sub { modeexpand(@_, $who) }, + 'variables' => sub { varexpand(@_, $who) }, 'devinfo' => sub { devinfo(@_) }, 'atticlink' => sub { atticlink(@_) }, ) @@ -848,20 +847,20 @@ $tmplname = $who . "tail"; - unless ( $who ne "sourcedir" || $config->sourcedirhead ) { + unless ($who ne "sourcedir" || $config->sourcedirhead) { $tmplname = "sourcetail"; } - unless ( $config->value($tmplname) ) { + unless ($config->value($tmplname)) { $tmplname = "htmltail"; } - if ( $config->value($tmplname) ) { - if ( open( TEMPL, $config->value($tmplname) ) ) { + if ($config->value($tmplname)) { + if (open(TEMPL, $config->value($tmplname))) { local ($/) = undef; $template = <TEMPL>; close(TEMPL); } else { - warning( "Template " . $config->value($tmplname) . " does not exist." ); + warning("Template " . $config->value($tmplname) . " does not exist."); } } @@ -869,10 +868,10 @@ expandtemplate( $template, ( - 'banner' => sub { bannerexpand( @_, $who ) }, + 'banner' => sub { bannerexpand(@_, $who) }, 'thisurl' => sub { thisurl(@_) }, - 'modes' => sub { modeexpand( @_, $who ) }, - 'variables' => sub { varexpand( @_, $who ) }, + 'modes' => sub { modeexpand(@_, $who) }, + 'variables' => sub { varexpand(@_, $who) }, 'devinfo' => sub { devinfo(@_) } ) ), Index: Config.pm =================================================================== RCS file: /cvsroot/lxr/lxr/lib/LXR/Config.pm,v retrieving revision 1.31 retrieving revision 1.32 diff -u -d -r1.31 -r1.32 --- Config.pm 19 Jul 2004 19:50:20 -0000 1.31 +++ Config.pm 21 Jul 2004 20:44:30 -0000 1.32 @@ -31,7 +31,7 @@ $confname = 'lxr.conf'; sub new { - my ( $class, @parms ) = @_; + my ($class, @parms) = @_; my $self = {}; bless($self); $self->_initialize(@parms); @@ -44,7 +44,7 @@ my $file = shift; my @data; - open( INPUT, $file ) || fatal("Config: cannot open $file\n"); + open(INPUT, $file) || fatal("Config: cannot open $file\n"); $file = <INPUT>; close(INPUT); @@ -54,8 +54,8 @@ } sub _initialize { - my ( $self, $url, $confpath ) = @_; - my ( $dir, $arg ); + my ($self, $url, $confpath) = @_; + my ($dir, $arg); unless ($url) { $url = 'http://' . $ENV{'SERVER_NAME'} . ':' . $ENV{'SERVER_PORT'}; @@ -66,11 +66,11 @@ $url .= '/' unless $url =~ m#/$#; # append / if necessary unless ($confpath) { - ($confpath) = ( $0 =~ /(.*?)[^\/]*$/ ); + ($confpath) = ($0 =~ /(.*?)[^\/]*$/); $confpath .= $confname; } - unless ( open( CONFIG, $confpath ) ) { + unless (open(CONFIG, $confpath)) { die("Couldn't open configuration file \"$confpath\"."); } @@ -80,17 +80,17 @@ my $config_contents = <CONFIG>; $config_contents =~ /(.*)/s; $config_contents = $1; #untaint it - my @config = eval( "\n#line 1 \"configuration file\"\n" . $config_contents ); + my @config = eval("\n#line 1 \"configuration file\"\n" . $config_contents); die($@) if $@; my $config; - if ( scalar(@config) > 0 ) { - %$self = ( %$self, %{ $config[0] } ); + if (scalar(@config) > 0) { + %$self = (%$self, %{ $config[0] }); } CANDIDATE: foreach $config (@config) { - if ( $config->{baseurl} ) { + if ($config->{baseurl}) { my @aliases; - if ( $config->{baseurl_aliases} ) { + if ($config->{baseurl_aliases}) { @aliases = @{ $config->{baseurl_aliases} }; } my $root = $config->{baseurl}; @@ -98,9 +98,9 @@ foreach my $rt (@aliases) { $rt .= '/' unless $rt =~ m#/$#; # append / if necessary my $r = quotemeta($rt); - if ( $url =~ /^$r/ ) { + if ($url =~ /^$r/) { $config->{baseurl} = $rt; - %$self = ( %$self, %$config ); + %$self = (%$self, %$config); last CANDIDATE; } } @@ -113,11 +113,11 @@ sub allvariables { my $self = shift; - return keys( %{ $self->{variables} || {} } ); + return keys(%{ $self->{variables} || {} }); } sub variable { - my ( $self, $var, $val ) = @_; + my ($self, $var, $val) = @_; $self->{variables}{$var}{value} = $val if defined($val); return $self->{variables}{$var}{value} @@ -125,14 +125,14 @@ } sub vardefault { - my ( $self, $var ) = @_; + my ($self, $var) = @_; return $self->{variables}{$var}{default} || $self->{variables}{$var}{range}[0]; } sub vardescription { - my ( $self, $var, $val ) = @_; + my ($self, $var, $val) = @_; $self->{variables}{$var}{name} = $val if defined($val); @@ -140,9 +140,9 @@ } sub varrange { - my ( $self, $var ) = @_; + my ($self, $var) = @_; - if ( ref( $self->{variables}{$var}{range} ) eq "CODE" ) { + if (ref($self->{variables}{$var}{range}) eq "CODE") { return &{ $self->{variables}{$var}{range} }; } @@ -150,21 +150,21 @@ } sub varexpand { - my ( $self, $exp ) = @_; + my ($self, $exp) = @_; $exp =~ s/\$\{?(\w+)\}?/$self->variable($1)/ge; return $exp; } sub value { - my ( $self, $var ) = @_; + my ($self, $var) = @_; - if ( exists( $self->{$var} ) ) { + if (exists($self->{$var})) { my $val = $self->{$var}; - if ( ref($val) eq 'ARRAY' ) { + if (ref($val) eq 'ARRAY') { return map { $self->varexpand($_) } @$val; - } elsif ( ref($val) eq 'CODE' ) { + } elsif (ref($val) eq 'CODE') { return $val; } else { return $self->varexpand($val); @@ -176,11 +176,11 @@ sub AUTOLOAD { my $self = shift; - ( my $var = $AUTOLOAD ) =~ s/.*:://; + (my $var = $AUTOLOAD) =~ s/.*:://; my @val = $self->value($var); - if ( ref( $val[0] ) eq 'CODE' ) { + if (ref($val[0]) eq 'CODE') { return $val[0]->(@_); } else { return wantarray ? @val : $val[0]; @@ -188,23 +188,23 @@ } sub mappath { - my ( $self, $path, @args ) = @_; + my ($self, $path, @args) = @_; my %oldvars; - my ( $m, $n ); + my ($m, $n); foreach $m (@args) { - if ( $m =~ /(.*?)=(.*)/ ) { + if ($m =~ /(.*?)=(.*)/) { $oldvars{$1} = $self->variable($1); - $self->variable( $1, $2 ); + $self->variable($1, $2); } } - while ( ( $m, $n ) = each %{ $self->{maps} || {} } ) { + while (($m, $n) = each %{ $self->{maps} || {} }) { $path =~ s/$m/$self->varexpand($n)/e; } - while ( ( $m, $n ) = each %oldvars ) { - $self->variable( $m, $n ); + while (($m, $n) = each %oldvars) { + $self->variable($m, $n); } return $path; Index: Files.pm =================================================================== RCS file: /cvsroot/lxr/lxr/lib/LXR/Files.pm,v retrieving revision 1.7 retrieving revision 1.8 diff -u -d -r1.7 -r1.8 --- Files.pm 19 Jul 2004 19:50:20 -0000 1.7 +++ Files.pm 21 Jul 2004 20:44:30 -0000 1.8 @@ -23,10 +23,10 @@ use strict; sub new { - my ( $self, $srcroot ) = @_; + my ($self, $srcroot) = @_; my $files; - if ( $srcroot =~ /^CVS:(.*)/i ) { + if ($srcroot =~ /^CVS:(.*)/i) { require LXR::Files::CVS; $srcroot = $1; $files = new LXR::Files::CVS($srcroot); Index: Index.pm =================================================================== RCS file: /cvsroot/lxr/lxr/lib/LXR/Index.pm,v retrieving revision 1.10 retrieving revision 1.11 diff -u -d -r1.10 -r1.11 --- Index.pm 19 Jul 2004 19:50:20 -0000 1.10 +++ Index.pm 21 Jul 2004 20:44:30 -0000 1.11 @@ -24,15 +24,15 @@ use strict; sub new { - my ( $self, $dbname, @args ) = @_; + my ($self, $dbname, @args) = @_; my $index; - if ( $dbname =~ /^DBI:/i ) { + if ($dbname =~ /^DBI:/i) { require LXR::Index::DBI; - $index = new LXR::Index::DBI( $dbname, @args ); - } elsif ( $dbname =~ /^DBM:/i ) { + $index = new LXR::Index::DBI($dbname, @args); + } elsif ($dbname =~ /^DBM:/i) { require LXR::Index::DB; - $index = new LXR::Index::DB( $dbname, @args ); + $index = new LXR::Index::DB($dbname, @args); } else { die "Can't find database, $dbname"; } Index: Lang.pm =================================================================== RCS file: /cvsroot/lxr/lxr/lib/LXR/Lang.pm,v retrieving revision 1.31 retrieving revision 1.32 diff -u -d -r1.31 -r1.32 --- Lang.pm 19 Jul 2004 19:50:20 -0000 1.31 +++ Lang.pm 21 Jul 2004 20:44:30 -0000 1.32 @@ -24,11 +24,11 @@ use LXR::Common; sub new { - my ( $self, $pathname, $release, @itag ) = @_; - my ( $lang, $type ); + my ($self, $pathname, $release, @itag) = @_; + my ($lang, $type); - foreach $type ( values %{ $config->filetype } ) { - if ( $pathname =~ /$$type[1]/ ) { + foreach $type (values %{ $config->filetype }) { + if ($pathname =~ /$$type[1]/) { eval "require $$type[2]"; die "Unable to load $$type[2] Lang class, $@" if $@; my $create = "new $$type[2]" . '($pathname, $release, $$type[0])'; @@ -38,10 +38,10 @@ } } - if ( !defined $lang ) { + if (!defined $lang) { # Try to see if it's a script - my $fh = $files->getfilehandle( $pathname, $release ); + my $fh = $files->getfilehandle($pathname, $release); return undef if !defined $fh; $fh->getline =~ /^\#!\s*(\S+)/s; @@ -49,8 +49,8 @@ my %filetype = %{ $config->filetype }; my %inter = %{ $config->interpreters }; - foreach my $patt ( keys %inter ) { - if ( $shebang =~ /\/$patt/ ) { + foreach my $patt (keys %inter) { + if ($shebang =~ /\/$patt/) { eval "require $filetype{$inter{$patt}}[2]"; die "Unable to load $filetype{$inter{$patt}}[2] Lang class, $@" if $@; my $create = "new " @@ -72,7 +72,7 @@ } sub processinclude { - my ( $self, $frag, $dir ) = @_; + my ($self, $frag, $dir) = @_; $$frag =~ s#(\")(.*?)(\")# $1.&LXR::Common::incref($2, "include", $2, $dir).$3 #e; @@ -81,7 +81,7 @@ } sub processcomment { - my ( $self, $frag ) = @_; + my ($self, $frag) = @_; $$frag = "<span class=\"comment\">$$frag</span>"; $$frag =~ s#\n#</span>\n<span class=\"comment\">#g; @@ -90,7 +90,7 @@ sub referencefile { my ($self) = @_; - print( STDERR ref($self), "->referencefile not implemented.\n" ); + print(STDERR ref($self), "->referencefile not implemented.\n"); } 1; Index: SimpleParse.pm =================================================================== RCS file: /cvsroot/lxr/lxr/lib/LXR/SimpleParse.pm,v retrieving revision 1.16 retrieving revision 1.17 diff -u -d -r1.16 -r1.17 --- SimpleParse.pm 19 Jul 2004 19:50:20 -0000 1.16 +++ SimpleParse.pm 21 Jul 2004 20:44:30 -0000 1.17 @@ -52,13 +52,13 @@ $tabwidth = 8; my $tabhint; - ( $fileh, $tabhint, @blksep ) = @_; + ($fileh, $tabhint, @blksep) = @_; $tabwidth = $tabhint || $tabwidth; - while ( @_ = splice( @blksep, 0, 3 ) ) { - push( @bodyid, $_[0] ); - push( @open, $_[1] ); - push( @term, $_[2] ); + while (@_ = splice(@blksep, 0, 3)) { + push(@bodyid, $_[0]); + push(@open, $_[1]); + push(@term, $_[2]); } foreach (@open) { @@ -79,7 +79,7 @@ $_[0] =~ s/^(\t+)/(' ' x ($t * length($1)))/ge; # Optimize for common case. $_[0] =~ s/([^\t]*)\t/$1.(' ' x ($t - (length($1) % $t)))/ge; - return ( $_[0] ); + return ($_[0]); } sub nextfrag { @@ -93,11 +93,11 @@ # read one more line if we have processed # all of the previously read line - if ( $#frags < 0 ) { + if ($#frags < 0) { $line = $fileh->getline; if ( $. <= 2 - && $line =~ /^.*-[*]-.*?[ \t;]tab-width:[ \t]*([0-9]+).*-[*]-/ ) + && $line =~ /^.*-[*]-.*?[ \t;]tab-width:[ \t]*([0-9]+).*-[*]-/) { # make sure there really is a non-zero tabwidth @@ -107,25 +107,25 @@ # &untabify($line, $tabwidth); # We inline this for performance. # Optimize for common case. - if ( defined($line) ) { + if (defined($line)) { $line =~ s/^(\t+)/' ' x ($tabwidth * length($1))/ge; $line =~ s/([^\t]*)\t/$1.(' ' x ($tabwidth - (length($1) % $tabwidth)))/ge; # split the line into fragments - @frags = split( /($split)/, $line ); + @frags = split(/($split)/, $line); } } last if $#frags < 0; # skip empty fragments - if ( $frags[0] eq '' ) { + if ($frags[0] eq '') { shift(@frags); } # check if we are inside a fragment - if ( defined($frag) ) { - if ( defined($btype) ) { + if (defined($frag)) { + if (defined($btype)) { my $next = shift(@frags); # Add to the fragment @@ -135,7 +135,7 @@ last if $next =~ /^$term[$btype]$/; } else { - if ( $frags[0] =~ /^$open$/ ) { + if ($frags[0] =~ /^$open$/) { # print "encountered open token while btype was $btype\n"; last; @@ -147,7 +147,7 @@ # print "start of new fragment\n"; # Find the blocktype of the current block $frag = shift(@frags); - if ( defined($frag) && ( @_ = $frag =~ /^$open$/ ) ) { + if (defined($frag) && (@_ = $frag =~ /^$open$/)) { # print "hit\n"; # grep in a scalar context returns the number of times @@ -156,7 +156,7 @@ my $i = 1; $btype = grep { $i &&= !defined($_) } @_; - if ( !defined( $term[$btype] ) ) { + if (!defined($term[$btype])) { print "fragment without terminator\n"; last; } @@ -165,7 +165,7 @@ } $btype = $bodyid[$btype] if defined($btype); - return ( $btype, $frag ); + return ($btype, $frag); } 1; Index: Tagger.pm =================================================================== RCS file: /cvsroot/lxr/lxr/lib/LXR/Tagger.pm,v retrieving revision 1.21 retrieving revision 1.22 diff -u -d -r1.21 -r1.22 --- Tagger.pm 19 Jul 2004 19:50:20 -0000 1.21 +++ Tagger.pm 21 Jul 2004 20:44:30 -0000 1.22 @@ -25,72 +25,72 @@ use LXR::Lang; sub processfile { - my ( $pathname, $release, $config, $files, $index ) = @_; + my ($pathname, $release, $config, $files, $index) = @_; - my $lang = new LXR::Lang( $pathname, $release ); + my $lang = new LXR::Lang($pathname, $release); return unless $lang; - my $revision = $files->filerev( $pathname, $release ); + my $revision = $files->filerev($pathname, $release); return unless $revision; - print( STDERR "--- $pathname $release $revision\n" ); + print(STDERR "--- $pathname $release $revision\n"); if ($index) { - my $fileid = $index->fileid( $pathname, $revision ); + my $fileid = $index->fileid($pathname, $revision); - $index->release( $fileid, $release ); + $index->release($fileid, $release); - if ( $index->toindex($fileid) ) { + if ($index->toindex($fileid)) { $index->empty_cache(); - print( STDERR "--- $pathname $fileid\n" ); + print(STDERR "--- $pathname $fileid\n"); - my $path = $files->tmpfile( $pathname, $release ); + my $path = $files->tmpfile($pathname, $release); - $lang->indexfile( $pathname, $path, $fileid, $index, $config ); + $lang->indexfile($pathname, $path, $fileid, $index, $config); $index->setindexed($fileid); unlink($path); } else { - print( STDERR "$pathname was already indexed\n" ); + print(STDERR "$pathname was already indexed\n"); } } else { - print( STDERR " **** FAILED ****\n" ); + print(STDERR " **** FAILED ****\n"); } $lang = undef; $revision = undef; } sub processrefs { - my ( $pathname, $release, $config, $files, $index ) = @_; + my ($pathname, $release, $config, $files, $index) = @_; - my $lang = new LXR::Lang( $pathname, $release ); + my $lang = new LXR::Lang($pathname, $release); return unless $lang; - my $revision = $files->filerev( $pathname, $release ); + my $revision = $files->filerev($pathname, $release); return unless $revision; - print( STDERR "--- $pathname $release $revision\n" ); + print(STDERR "--- $pathname $release $revision\n"); if ($index) { - my $fileid = $index->fileid( $pathname, $revision ); + my $fileid = $index->fileid($pathname, $revision); - if ( $index->toreference($fileid) ) { + if ($index->toreference($fileid)) { $index->empty_cache(); - print( STDERR "--- $pathname $fileid\n" ); + print(STDERR "--- $pathname $fileid\n"); - my $path = $files->tmpfile( $pathname, $release ); + my $path = $files->tmpfile($pathname, $release); - $lang->referencefile( $pathname, $path, $fileid, $index, $config ); + $lang->referencefile($pathname, $path, $fileid, $index, $config); $index->setreferenced($fileid); unlink($path); } else { print STDERR "$pathname was already referenced\n"; } } else { - print( STDERR " **** FAILED ****\n" ); + print(STDERR " **** FAILED ****\n"); } $lang = undef; |