[Lxr-commits] CVS: lxr/lib/LXR Common.pm,1.47,1.48 Config.pm,1.30,1.31 Files.pm,1.6,1.7 Index.pm,1.9
Brought to you by:
ajlittoz
Menu
▾
▴
[Lxr-commits] CVS: lxr/lib/LXR Common.pm,1.47,1.48 Config.pm,1.30,1.31 Files.pm,1.6,1.7 Index.pm,1.9,1.10 Lang.pm,1.30,1.31 SimpleParse.pm,1.15,1.16 Tagger.pm,1.20,1.21
|
From: Dave B. <bro...@us...> - 2004-07-19 19:50:37
|
Update of /cvsroot/lxr/lxr/lib/LXR In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7323/lib/LXR Modified Files: Common.pm Config.pm Files.pm Index.pm Lang.pm SimpleParse.pm Tagger.pm Log Message: formatting (with eclipse EPIC plugin which uses PerlTidy. options used: line width 100, cuddle else, use tabs, tab-width 4) Index: Common.pm =================================================================== RCS file: /cvsroot/lxr/lxr/lib/LXR/Common.pm,v retrieving revision 1.47 retrieving revision 1.48 diff -u -d -r1.47 -r1.48 --- Common.pm 15 Jul 2004 14:41:04 -0000 1.47 +++ Common.pm 19 Jul 2004 19:50:20 -0000 1.48 @@ -13,7 +13,7 @@ # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. -# +# # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. @@ -26,22 +26,21 @@ require Exporter; [...1174 lines suppressed...] - 'variables' => sub { varexpand(@_, $who) }, - 'devinfo' => sub { devinfo(@_) })), - "</html>\n"); + print( + expandtemplate( + $template, + ( + 'banner' => sub { bannerexpand( @_, $who ) }, + 'thisurl' => sub { thisurl(@_) }, + 'modes' => sub { modeexpand( @_, $who ) }, + 'variables' => sub { varexpand( @_, $who ) }, + 'devinfo' => sub { devinfo(@_) } + ) + ), + "</html>\n" + ); } - 1; Index: Config.pm =================================================================== RCS file: /cvsroot/lxr/lxr/lib/LXR/Config.pm,v retrieving revision 1.30 retrieving revision 1.31 diff -u -d -r1.30 -r1.31 --- Config.pm 15 Jul 2004 20:20:12 -0000 1.30 +++ Config.pm 19 Jul 2004 19:50:20 -0000 1.31 @@ -11,7 +11,7 @@ # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. -# +# # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. @@ -31,198 +31,183 @@ $confname = 'lxr.conf'; sub new { - my ($class, @parms) = @_; - my $self = {}; - bless($self); - $self->_initialize(@parms); - return($self); + my ( $class, @parms ) = @_; + my $self = {}; + bless($self); + $self->_initialize(@parms); + return ($self); die("Foo!\n"); } sub readfile { - local($/) = undef; # Just in case; probably redundant. - my $file = shift; - my @data; + local ($/) = undef; # Just in case; probably redundant. + my $file = shift; + my @data; - open(INPUT, $file) || fatal("Config: cannot open $file\n"); - $file = <INPUT>; - close(INPUT); + open( INPUT, $file ) || fatal("Config: cannot open $file\n"); + $file = <INPUT>; + close(INPUT); - @data = $file =~ /([^\s]+)/gs; + @data = $file =~ /([^\s]+)/gs; - return wantarray ? @data : $data[0]; + return wantarray ? @data : $data[0]; } - 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'}; + unless ($url) { + $url = 'http://' . $ENV{'SERVER_NAME'} . ':' . $ENV{'SERVER_PORT'}; $url =~ s/:80$//; - } - - $url =~ s|^http://([^/]*):443/|https://$1/|; - $url .= '/' unless $url =~ m#/$#; # append / if necessary + } - unless ($confpath) { - ($confpath) = ($0 =~ /(.*?)[^\/]*$/); + $url =~ s|^http://([^/]*):443/|https://$1/|; + $url .= '/' unless $url =~ m#/$#; # append / if necessary + + unless ($confpath) { + ($confpath) = ( $0 =~ /(.*?)[^\/]*$/ ); $confpath .= $confname; - } - - unless (open(CONFIG, $confpath)) { + } + + unless ( open( CONFIG, $confpath ) ) { die("Couldn't open configuration file \"$confpath\"."); - } + } $$self{'confpath'} = $confpath; - - local($/) = undef; - my $config_contents = <CONFIG>; - $config_contents =~ /(.*)/s ; $config_contents = $1; #untaint it - my @config = eval("\n#line 1 \"configuration file\"\n". - $config_contents); - die($@) if $@; - my $config; - if (scalar(@config) > 0) { - %$self = (%$self, %{$config[0]}); + local ($/) = undef; + my $config_contents = <CONFIG>; + $config_contents =~ /(.*)/s; + $config_contents = $1; #untaint it + my @config = eval( "\n#line 1 \"configuration file\"\n" . $config_contents ); + die($@) if $@; + + my $config; + if ( scalar(@config) > 0 ) { + %$self = ( %$self, %{ $config[0] } ); } - CANDIDATE: foreach $config (@config) { - if ($config->{baseurl}) { + CANDIDATE: foreach $config (@config) { + if ( $config->{baseurl} ) { my @aliases; - if ($config->{baseurl_aliases}) { - @aliases = @{$config->{baseurl_aliases}}; + if ( $config->{baseurl_aliases} ) { + @aliases = @{ $config->{baseurl_aliases} }; } my $root = $config->{baseurl}; push @aliases, $root; foreach my $rt (@aliases) { - $rt .= '/' unless $rt =~ m#/$#; # append / if necessary + $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; } } } - } + } die "Can't find config for $url\n" if !defined $$self{baseurl}; } - sub allvariables { - my $self = shift; + 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} || - $self->vardefault($var); + $self->{variables}{$var}{value} = $val if defined($val); + return $self->{variables}{$var}{value} + || $self->vardefault($var); } - sub vardefault { - my ($self, $var) = @_; + my ( $self, $var ) = @_; - return $self->{variables}{$var}{default} || - $self->{variables}{$var}{range}[0]; + 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); + $self->{variables}{$var}{name} = $val if defined($val); - return $self->{variables}{$var}{name}; + return $self->{variables}{$var}{name}; } - sub varrange { - my ($self, $var) = @_; + my ( $self, $var ) = @_; - if (ref($self->{variables}{$var}{range}) eq "CODE") { - return &{$self->{variables}{$var}{range}}; + if ( ref( $self->{variables}{$var}{range} ) eq "CODE" ) { + return &{ $self->{variables}{$var}{range} }; } - return @{$self->{variables}{$var}{range} || []}; + return @{ $self->{variables}{$var}{range} || [] }; } - sub varexpand { - my ($self, $exp) = @_; - $exp =~ s/\$\{?(\w+)\}?/$self->variable($1)/ge; + my ( $self, $exp ) = @_; + $exp =~ s/\$\{?(\w+)\}?/$self->variable($1)/ge; - return $exp; + 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 { + } else { return $self->varexpand($val); } - } - else { + } else { return undef; - } + } } - sub AUTOLOAD { - my $self = shift; - (my $var = $AUTOLOAD) =~ s/.*:://; + my $self = shift; + ( 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 { + } else { return wantarray ? @val : $val[0]; - } + } } - sub mappath { - my ($self, $path, @args) = @_; - my %oldvars; - my ($m, $n); - - foreach $m (@args) { - if ($m =~ /(.*?)=(.*)/) { + my ( $self, $path, @args ) = @_; + my %oldvars; + my ( $m, $n ); + + foreach $m (@args) { + 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; + return $path; } - 1; Index: Files.pm =================================================================== RCS file: /cvsroot/lxr/lxr/lib/LXR/Files.pm,v retrieving revision 1.6 retrieving revision 1.7 diff -u -d -r1.6 -r1.7 --- Files.pm 15 Aug 2001 15:50:27 -0000 1.6 +++ Files.pm 19 Jul 2004 19:50:20 -0000 1.7 @@ -11,7 +11,7 @@ # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. -# +# # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. @@ -23,20 +23,18 @@ 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); - } - else { + $files = new LXR::Files::CVS($srcroot); + } else { require LXR::Files::Plain; $files = new LXR::Files::Plain($srcroot); } return $files; } - 1; Index: Index.pm =================================================================== RCS file: /cvsroot/lxr/lxr/lib/LXR/Index.pm,v retrieving revision 1.9 retrieving revision 1.10 diff -u -d -r1.9 -r1.10 --- Index.pm 15 Aug 2001 15:50:27 -0000 1.9 +++ Index.pm 19 Jul 2004 19:50:20 -0000 1.10 @@ -11,7 +11,7 @@ # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. -# +# # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. @@ -24,19 +24,17 @@ 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) { - require LXR::Index::DB; - $index = new LXR::Index::DB($dbname, @args); - } - else { - die "Can't find database, $dbname"; + $index = new LXR::Index::DBI( $dbname, @args ); + } elsif ( $dbname =~ /^DBM:/i ) { + require LXR::Index::DB; + $index = new LXR::Index::DB( $dbname, @args ); + } else { + die "Can't find database, $dbname"; } return $index; } Index: Lang.pm =================================================================== RCS file: /cvsroot/lxr/lxr/lib/LXR/Lang.pm,v retrieving revision 1.30 retrieving revision 1.31 diff -u -d -r1.30 -r1.31 --- Lang.pm 1 Jul 2004 20:41:25 -0000 1.30 +++ Lang.pm 19 Jul 2004 19:50:20 -0000 1.31 @@ -11,7 +11,7 @@ # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. -# +# # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. @@ -24,36 +24,38 @@ 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])'; + my $create = "new $$type[2]" . '($pathname, $release, $$type[0])'; $lang = eval($create); die "Unable to create $$type[2] Lang object, $@" unless defined $lang; last; - } - } - - if (!defined $lang) { - # Try to see if it's a script - my $fh = $files->getfilehandle($pathname, $release); + } + } + + if ( !defined $lang ) { + + # Try to see if it's a script + my $fh = $files->getfilehandle( $pathname, $release ); return undef if !defined $fh; $fh->getline =~ /^\#!\s*(\S+)/s; - my $shebang = $1; - my %filetype = %{$config->filetype}; - my %inter = %{$config->interpreters}; - - foreach my $patt (keys %inter) { - if ($shebang =~ /\/$patt/) { + my $shebang = $1; + my %filetype = %{ $config->filetype }; + my %inter = %{ $config->interpreters }; + + 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 ". - $filetype{$inter{$patt}}[2].'($pathname, $release, $filetype{$inter{$patt}}[0])'; + my $create = "new " + . $filetype{ $inter{$patt} }[2] + . '($pathname, $release, $filetype{$inter{$patt}}[0])'; $lang = eval($create); last if defined $lang; die "Unable to create $filetype{$inter{$patt}}[2] Lang object, $@"; @@ -63,23 +65,23 @@ # No match for this file return undef if !defined $lang; - + $$lang{'itag'} = \@itag if $lang; return $lang; } sub processinclude { - my ($self, $frag, $dir) = @_; + my ( $self, $frag, $dir ) = @_; $$frag =~ s#(\")(.*?)(\")# $1.&LXR::Common::incref($2, "include", $2, $dir).$3 #e; - $$frag =~ s#(\0<)(.*?)(\0>)# + $$frag =~ s#(\0<)(.*?)(\0>)# $1.&LXR::Common::incref($2, "include", $2).$3 #e; - } +} sub processcomment { - my ($self, $frag) = @_; + my ( $self, $frag ) = @_; $$frag = "<span class=\"comment\">$$frag</span>"; $$frag =~ s#\n#</span>\n<span class=\"comment\">#g; @@ -87,9 +89,8 @@ 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.15 retrieving revision 1.16 diff -u -d -r1.15 -r1.16 --- SimpleParse.pm 22 Mar 2003 01:00:58 -0000 1.15 +++ SimpleParse.pm 19 Jul 2004 19:50:20 -0000 1.16 @@ -11,7 +11,7 @@ # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. -# +# # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. @@ -27,144 +27,145 @@ use vars qw(@ISA @EXPORT); -@ISA = qw(Exporter); +@ISA = qw(Exporter); @EXPORT = qw(&doparse &untabify &init &nextfrag); -my $fileh; # File handle -my @frags; # Fragments in queue -my @bodyid; # Array of body type ids -my @open; # Fragment opening delimiters -my @term; # Fragment closing delimiters -my $split; # Fragmentation regexp -my $open; # Fragment opening regexp -my $tabwidth; # Tab width +my $fileh; # File handle +my @frags; # Fragments in queue +my @bodyid; # Array of body type ids +my @open; # Fragment opening delimiters +my @term; # Fragment closing delimiters +my $split; # Fragmentation regexp +my $open; # Fragment opening regexp +my $tabwidth; # Tab width sub init { - my @blksep; - - $fileh = ""; - @frags = (); - @bodyid = (); - @open = (); - @term = (); - $split = ""; - $open = ""; + my @blksep; + + $fileh = ""; + @frags = (); + @bodyid = (); + @open = (); + @term = (); + $split = ""; + $open = ""; $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]); - } - foreach (@open) { - $open .= "($_)|"; + while ( @_ = splice( @blksep, 0, 3 ) ) { + push( @bodyid, $_[0] ); + push( @open, $_[1] ); + push( @term, $_[2] ); + } + + foreach (@open) { + $open .= "($_)|"; $split .= "$_|"; - } - chop($open); - - foreach (@term) { + } + chop($open); + + foreach (@term) { next if $_ eq ''; $split .= "$_|"; - } - chop($split); + } + chop($split); } - sub untabify { - my $t = $_[1] || 8; + my $t = $_[1] || 8; - $_[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]); + $_[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] ); } - sub nextfrag { - my $btype = undef; - my $frag = undef; - my $line = ''; + my $btype = undef; + my $frag = undef; + my $line = ''; -# print "nextfrag called\n"; + # print "nextfrag called\n"; - while (1) { + while (1) { - # read one more line if we have processed + # 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]+).*-[*]-/) { + + if ( $. <= 2 + && $line =~ /^.*-[*]-.*?[ \t;]tab-width:[ \t]*([0-9]+).*-[*]-/ ) + { + # make sure there really is a non-zero tabwidth if ($1) { $tabwidth = $1; } } - -# &untabify($line, $tabwidth); # We inline this for performance. - + + # &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 $frag .= $next; + # We are done if this was the terminator last if $next =~ /^$term[$btype]$/; - } - else { - if ($frags[0] =~ /^$open$/) { -# print "encountered open token while btype was $btype\n"; + } else { + if ( $frags[0] =~ /^$open$/ ) { + + # print "encountered open token while btype was $btype\n"; last; } $frag .= shift(@frags); } - } - else { -# print "start of new fragment\n"; + } else { + + # print "start of new fragment\n"; # Find the blocktype of the current block $frag = shift(@frags); - if (defined($frag) && (@_ = $frag =~ /^$open$/)) { -# print "hit\n"; + if ( defined($frag) && ( @_ = $frag =~ /^$open$/ ) ) { + + # print "hit\n"; # grep in a scalar context returns the number of times # EXPR evaluates to true, which is this case will be # the index of the first defined element in @_. my $i = 1; $btype = grep { $i &&= !defined($_) } @_; - if(!defined($term[$btype])) { + if ( !defined( $term[$btype] ) ) { print "fragment without terminator\n"; last; } } } - } - $btype = $bodyid[$btype] if defined($btype); - - return($btype, $frag); -} + } + $btype = $bodyid[$btype] if defined($btype); + return ( $btype, $frag ); +} 1; Index: Tagger.pm =================================================================== RCS file: /cvsroot/lxr/lxr/lib/LXR/Tagger.pm,v retrieving revision 1.20 retrieving revision 1.21 diff -u -d -r1.20 -r1.21 --- Tagger.pm 21 Apr 2004 22:52:08 -0000 1.20 +++ Tagger.pm 19 Jul 2004 19:50:20 -0000 1.21 @@ -11,7 +11,7 @@ # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. -# +# # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. @@ -25,73 +25,76 @@ 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); - - $index->release($fileid, $release); - - if ($index->toindex($fileid)) { - $index->empty_cache(); - print(STDERR "--- $pathname $fileid\n"); - - my $path = $files->tmpfile($pathname, $release); - - $lang->indexfile($pathname, $path, $fileid, $index, $config); - $index->setindexed($fileid); - unlink($path); - } else { - print(STDERR "$pathname was already indexed\n"); - } - } else { print(STDERR " **** FAILED ****\n"); } - $lang = undef; + my $fileid = $index->fileid( $pathname, $revision ); + + $index->release( $fileid, $release ); + + if ( $index->toindex($fileid) ) { + $index->empty_cache(); + print( STDERR "--- $pathname $fileid\n" ); + + my $path = $files->tmpfile( $pathname, $release ); + + $lang->indexfile( $pathname, $path, $fileid, $index, $config ); + $index->setindexed($fileid); + unlink($path); + } else { + print( STDERR "$pathname was already indexed\n" ); + } + } else { + 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); - - if ($index->toreference($fileid)) { - $index->empty_cache(); - print(STDERR "--- $pathname $fileid\n"); - - my $path = $files->tmpfile($pathname, $release); - - $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"); } + my $fileid = $index->fileid( $pathname, $revision ); - $lang = undef; + if ( $index->toreference($fileid) ) { + $index->empty_cache(); + print( STDERR "--- $pathname $fileid\n" ); + + my $path = $files->tmpfile( $pathname, $release ); + + $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" ); + } + + $lang = undef; $revision = undef; - } +} 1; |
