[Lxr-commits] CVS: lxr/lib/LXR/Files CVS.pm,1.30,1.31 Plain.pm,1.23,1.24
Brought to you by:
ajlittoz
From: Dave B. <bro...@us...> - 2004-07-21 20:44:42
|
Update of /cvsroot/lxr/lxr/lib/LXR/Files In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv25090/lib/LXR/Files Modified Files: CVS.pm Plain.pm Log Message: perltidy with options: -ce -pt=2 -nolq -nsfs Index: CVS.pm =================================================================== RCS file: /cvsroot/lxr/lxr/lib/LXR/Files/CVS.pm,v retrieving revision 1.30 retrieving revision 1.31 diff -u -d -r1.30 -r1.31 --- CVS.pm 21 Jul 2004 14:08:38 -0000 1.30 +++ CVS.pm 21 Jul 2004 20:44:30 -0000 1.31 @@ -28,16 +28,17 @@ use vars qw(%cvs $cache_filename $gnu_diff); sub new { - my ( $self, $rootpath ) = @_; + my ($self, $rootpath) = @_; - $self = bless( {}, $self ); + $self = bless({}, $self); $self->{'rootpath'} = $rootpath; $self->{'rootpath'} =~ s@/*$@/@; unless (defined $gnu_diff) { + # the rcsdiff command (used in getdiff) uses parameters only supported by GNU diff $ENV{'PATH'} = '/bin:/usr/local/bin:/usr/bin:/usr/sbin'; - if ( `diff --version` =~ /GNU/ ) { + if (`diff --version` =~ /GNU/) { $gnu_diff = 1; } else { $gnu_diff = 0; @@ -48,11 +49,11 @@ } sub filerev { - my ( $self, $filename, $release ) = @_; + my ($self, $filename, $release) = @_; - if ( $release =~ /rev_([\d\.]+)/ ) { + if ($release =~ /rev_([\d\.]+)/) { return $1; - } elsif ( $release =~ /^([\d\.]+)$/ ) { + } elsif ($release =~ /^([\d\.]+)$/) { return $1; } else { $self->parsecvs($filename); @@ -61,17 +62,17 @@ } sub getfiletime { - my ( $self, $filename, $release ) = @_; + my ($self, $filename, $release) = @_; - return undef if $self->isdir( $filename, $release ); + return undef if $self->isdir($filename, $release); $self->parsecvs($filename); - my $rev = $self->filerev( $filename, $release ); + my $rev = $self->filerev($filename, $release); return undef unless defined($rev); - my @t = reverse( split( /\./, $cvs{'branch'}{$rev}{'date'} ) ); + my @t = reverse(split(/\./, $cvs{'branch'}{$rev}{'date'})); return undef unless @t; @@ -80,53 +81,53 @@ } sub getfilesize { - my ( $self, $filename, $release ) = @_; + my ($self, $filename, $release) = @_; - return length( $self->getfile( $filename, $release ) ); + return length($self->getfile($filename, $release)); } sub getfile { - my ( $self, $filename, $release ) = @_; + my ($self, $filename, $release) = @_; - my $fileh = $self->getfilehandle( $filename, $release ); + my $fileh = $self->getfilehandle($filename, $release); return undef unless $fileh; - return join( '', $fileh->getlines ); + return join('', $fileh->getlines); } sub getannotations { - my ( $self, $filename, $release ) = @_; + my ($self, $filename, $release) = @_; $self->parsecvs($filename); - my $rev = $self->filerev( $filename, $release ); + my $rev = $self->filerev($filename, $release); return () unless defined($rev); my $hrev = $cvs{'header'}{'head'}; my $lrev; my @anno; - my $headfh = $self->getfilehandle( $filename, $release ); + my $headfh = $self->getfilehandle($filename, $release); my @head = $headfh->getlines; while (1) { - if ( $rev eq $hrev ) { + if ($rev eq $hrev) { @head = 0 .. $#head; } $lrev = $hrev; $hrev = $cvs{'branch'}{$hrev}{'next'} || last; - my @diff = $self->getdiff( $filename, $lrev, $hrev ); + my @diff = $self->getdiff($filename, $lrev, $hrev); my $off = 0; while (@diff) { my $dir = shift(@diff); - if ( $dir =~ /^a(\d+)\s+(\d+)/ ) { - splice( @diff, 0, $2 ); - splice( @head, $1 - $off, 0, ('') x $2 ); + if ($dir =~ /^a(\d+)\s+(\d+)/) { + splice(@diff, 0, $2); + splice(@head, $1 - $off, 0, ('') x $2); $off -= $2; - } elsif ( $dir =~ /^d(\d+)\s+(\d+)/ ) { - map { $anno[$_] = $lrev if $_ ne ''; } splice( @head, $1 - $off - 1, $2 ); + } elsif ($dir =~ /^d(\d+)\s+(\d+)/) { + map { $anno[$_] = $lrev if $_ ne ''; } splice(@head, $1 - $off - 1, $2); $off += $2; } else { @@ -134,7 +135,7 @@ } } } - + if (@anno) { map { $anno[$_] = $lrev if $_ ne ''; } @head; } @@ -144,7 +145,7 @@ } sub getauthor { - my ( $self, $filename, $revision ) = @_; + my ($self, $filename, $revision) = @_; $self->parsecvs($filename); @@ -152,161 +153,161 @@ } sub getfilehandle { - my ( $self, $filename, $release ) = @_; + my ($self, $filename, $release) = @_; my ($fileh); $self->parsecvs($filename); - my $rev = $self->filerev( $filename, $release ); + my $rev = $self->filerev($filename, $release); return undef unless defined($rev); - return undef unless defined( $self->toreal( $filename, $release ) ); + return undef unless defined($self->toreal($filename, $release)); $rev =~ /([\d\.]*)/; $rev = $1; # untaint - my $clean_filename = $self->cleanstring( $self->toreal( $filename, $release ) ); + my $clean_filename = $self->cleanstring($self->toreal($filename, $release)); $clean_filename =~ /(.*)/; $clean_filename = $1; # technically untaint here (cleanstring did the real untainting) $ENV{'PATH'} = '/bin:/usr/local/bin:/usr/bin:/usr/sbin'; - open( $fileh, "-|", "co -q -p$rev $clean_filename" ); + open($fileh, "-|", "co -q -p$rev $clean_filename"); die("Error executing \"co\"; rcs not installed?") unless $fileh; return $fileh; } sub getdiff { - my ( $self, $filename, $release1, $release2 ) = @_; + my ($self, $filename, $release1, $release2) = @_; my ($fileh); - + return () if $gnu_diff == 0; $self->parsecvs($filename); - my $rev1 = $self->filerev( $filename, $release1 ); + my $rev1 = $self->filerev($filename, $release1); return () unless defined($rev1); - my $rev2 = $self->filerev( $filename, $release2 ); + my $rev2 = $self->filerev($filename, $release2); return () unless defined($rev2); $rev1 =~ /([\d\.]*)/; $rev1 = $1; # untaint $rev2 =~ /([\d\.]*)/; $rev2 = $1; # untaint - my $clean_filename = $self->cleanstring( $self->toreal( $filename, $release1 ) ); + my $clean_filename = $self->cleanstring($self->toreal($filename, $release1)); $clean_filename =~ /(.*)/; $clean_filename = $1; # technically untaint here (cleanstring did the real untainting) $ENV{'PATH'} = '/bin:/usr/local/bin:/usr/bin:/usr/sbin'; - open( $fileh, "-|", "rcsdiff -q -a -n -r$rev1 -r$rev2 $clean_filename" ); + open($fileh, "-|", "rcsdiff -q -a -n -r$rev1 -r$rev2 $clean_filename"); die("Error executing \"rcsdiff\"; rcs not installed?") unless $fileh; return $fileh->getlines; } sub tmpfile { - my ( $self, $filename, $release ) = @_; - my ( $tmp, $buf ); + my ($self, $filename, $release) = @_; + my ($tmp, $buf); - $buf = $self->getfile( $filename, $release ); + $buf = $self->getfile($filename, $release); return undef unless defined($buf); $tmp = $config->tmpdir . '/lxrtmp.' . time . '.' . $$ . '.' . &LXR::Common::tmpcounter; - open( TMP, "> $tmp" ) || return undef; - print( TMP $buf ); + open(TMP, "> $tmp") || return undef; + print(TMP $buf); close(TMP); return $tmp; } sub dirempty { - my ( $self, $pathname, $release ) = @_; - my ( $node, @dirs, @files ); + my ($self, $pathname, $release) = @_; + my ($node, @dirs, @files); my $DIRH = new IO::Handle; - my $real = $self->toreal( $pathname, $release ); + my $real = $self->toreal($pathname, $release); - opendir( $DIRH, $real ) || return 1; - while ( defined( $node = readdir($DIRH) ) ) { + opendir($DIRH, $real) || return 1; + while (defined($node = readdir($DIRH))) { next if $node =~ /^\.|~$|\.orig$/; next if $node eq 'CVS'; - if ( -d $real . $node ) { - push( @dirs, $node . '/' ); - } elsif ( $node =~ /(.*),v$/ ) { - push( @files, $1 ); + if (-d $real . $node) { + push(@dirs, $node . '/'); + } elsif ($node =~ /(.*),v$/) { + push(@files, $1); } } closedir($DIRH); foreach $node (@files) { - return 0 if $self->filerev( $pathname . $node, $release ); + return 0 if $self->filerev($pathname . $node, $release); } foreach $node (@dirs) { - return 0 unless $self->dirempty( $pathname . $node, $release ); + return 0 unless $self->dirempty($pathname . $node, $release); } return 1; } sub getdir { - my ( $self, $pathname, $release ) = @_; - my ( $node, @dirs, @files ); + my ($self, $pathname, $release) = @_; + my ($node, @dirs, @files); my $DIRH = new IO::Handle; - my $real = $self->toreal( $pathname, $release ); + my $real = $self->toreal($pathname, $release); - opendir( $DIRH, $real ) || return (); - FILE: while ( defined( $node = readdir($DIRH) ) ) { + opendir($DIRH, $real) || return (); + FILE: while (defined($node = readdir($DIRH))) { next if $node =~ /^\.|~$|\.orig$/; next if $node eq 'CVS'; - if ( -d $real . $node ) { - foreach my $ignoredir ( $config->ignoredirs ) { + if (-d $real . $node) { + foreach my $ignoredir ($config->ignoredirs) { next FILE if $node eq $ignoredir; } - if ( $node eq 'Attic' ) { - push( @files, $self->getdir( $pathname . $node . '/', $release ) ); + if ($node eq 'Attic') { + push(@files, $self->getdir($pathname . $node . '/', $release)); } else { - push( @dirs, $node . '/' ) + push(@dirs, $node . '/') unless defined($release) - && $self->dirempty( $pathname . $node . '/', $release ); + && $self->dirempty($pathname . $node . '/', $release); } - } elsif ( $node =~ /(.*),v$/ ) { - if ( !$$LXR::Common::HTTP{'param'}{'showattic'} ) { + } elsif ($node =~ /(.*),v$/) { + if (!$$LXR::Common::HTTP{'param'}{'showattic'}) { # you can't just check for 'Attic' because for certain versions the file is alive even if in Attic - $self->parsecvs( $pathname . substr( $node, 0, length($node) - 2 ) ) + $self->parsecvs($pathname . substr($node, 0, length($node) - 2)) ; # substr is to remove the ',v' my $rev = $cvs{'header'}{'symbols'}{$release}; - if ( $cvs{'branch'}{$rev}{'state'} eq "dead" ) { + if ($cvs{'branch'}{$rev}{'state'} eq "dead") { next; } } - push( @files, $1 ) + push(@files, $1) if !defined($release) - || $self->getfiletime( $pathname . $1, $release ); + || $self->getfiletime($pathname . $1, $release); } } closedir($DIRH); - return ( sort(@dirs), sort(@files) ); + return (sort(@dirs), sort(@files)); } sub toreal { - my ( $self, $pathname, $release ) = @_; + my ($self, $pathname, $release) = @_; my $real = $self->{'rootpath'} . $pathname; # nearly all (if not all) method calls eventually call toreal(), so this is a good place to block file access - foreach my $ignoredir ( $config->ignoredirs ) { + foreach my $ignoredir ($config->ignoredirs) { return undef if $real =~ m|/$ignoredir/|; } return $real if -d $real; - if ( !$$LXR::Common::HTTP{'param'}{'showattic'} ) { + if (!$$LXR::Common::HTTP{'param'}{'showattic'}) { # you can't just check for 'Attic' because for certain versions the file is alive even if in Attic $self->parsecvs($pathname); my $rev = $cvs{'header'}{'symbols'}{$release}; - if ( $cvs{'branch'}{$rev}{'state'} eq "dead" ) { + if ($cvs{'branch'}{$rev}{'state'} eq "dead") { return undef; } } @@ -322,11 +323,11 @@ } sub cleanstring { - my ( $self, $in ) = @_; + my ($self, $in) = @_; my $out = ''; - for ( split( '', $in ) ) { + for (split('', $in)) { s/[|&!`;\$%<>[:cntrl:]]// || # drop these in particular /[\w\/,.-_+=]/ || # keep these intact s/([ '"\x20-\x7E])/\\$1/ || # escape these out @@ -339,32 +340,32 @@ } sub isdir { - my ( $self, $pathname, $release ) = @_; + my ($self, $pathname, $release) = @_; - return -d $self->toreal( $pathname, $release ); + return -d $self->toreal($pathname, $release); } sub isfile { - my ( $self, $pathname, $release ) = @_; + my ($self, $pathname, $release) = @_; - return -f $self->toreal( $pathname, $release ); + return -f $self->toreal($pathname, $release); } sub getindex { - my ( $self, $pathname, $release ) = @_; + my ($self, $pathname, $release) = @_; - my $index = $self->getfile( $pathname, $release ); + my $index = $self->getfile($pathname, $release); return $index =~ /\n(\S*)\s*\n\t-\s*([^\n]*)/gs; } sub allreleases { - my ( $self, $filename ) = @_; + my ($self, $filename) = @_; $self->parsecvs($filename); # no header symbols for a directory, so we use the default and the current release - if ( defined %{ $cvs{'header'}{'symbols'} } ) { + if (defined %{ $cvs{'header'}{'symbols'} }) { return sort keys %{ $cvs{'header'}{'symbols'} }; } else { my @releases; @@ -384,15 +385,17 @@ my $ret = $one[$i] <=> $two[$i]; return $ret if $ret; } - return $#one <=> $#two; # if still no difference after we ran through all elements of @one, compare the length of the array + + # if still no difference after we ran through all elements of @one, compare the length of the array + return $#one <=> $#two; } sub allrevisions { - my ( $self, $filename ) = @_; + my ($self, $filename) = @_; $self->parsecvs($filename); - return sort byrevision keys( %{ $cvs{'branch'} } ); + return sort byrevision keys(%{ $cvs{'branch'} }); } sub parsecvs { @@ -400,7 +403,7 @@ # Actually, these days it just parses the header. # RCS tools are much better at parsing RCS files. # -pok - my ( $self, $filename ) = @_; + my ($self, $filename) = @_; return if $cache_filename eq $filename; $cache_filename = $filename; @@ -408,7 +411,7 @@ undef %cvs; my $file = ''; - open( CVS, $self->toreal( $filename, undef ) ); + open(CVS, $self->toreal($filename, undef)); close CVS and return if -d CVS; # we can't parse a directory while (<CVS>) { if (/^text\s*$/) { @@ -425,31 +428,31 @@ $cvs{'header'} = { map { s/@@/@/gs; - /^@/s && substr( $_, 1, -1 ) || $_ + /^@/s && substr($_, 1, -1) || $_ } shift(@cvs) =~ /(\w+)\s*((?:[^;@]+|@[^@]*@)*);/gs }; $cvs{'header'}{'symbols'} = { $cvs{'header'}{'symbols'} =~ /(\S+?):(\S+)/g }; - my ( $orel, $nrel, $rev ); - while ( ( $orel, $rev ) = each %{ $cvs{'header'}{'symbols'} } ) { + my ($orel, $nrel, $rev); + while (($orel, $rev) = each %{ $cvs{'header'}{'symbols'} }) { $nrel = $config->cvsversion($orel); next unless defined($nrel); - if ( $nrel ne $orel ) { - delete( $cvs{'header'}{'symbols'}{$orel} ); + if ($nrel ne $orel) { + delete($cvs{'header'}{'symbols'}{$orel}); $cvs{'header'}{'symbols'}{$nrel} = $rev if $nrel; } } $cvs{'header'}{'symbols'}{'head'} = $cvs{'header'}{'head'}; - while ( @cvs && $cvs[0] !~ /\s*desc/s ) { - my ( $r, $v ) = shift(@cvs) =~ /\s*(\S+)\s*(.*)/s; + while (@cvs && $cvs[0] !~ /\s*desc/s) { + my ($r, $v) = shift(@cvs) =~ /\s*(\S+)\s*(.*)/s; $cvs{'branch'}{$r} = { map { s/@@/@/gs; - /^@/s && substr( $_, 1, -1 ) || $_ + /^@/s && substr($_, 1, -1) || $_ } $v =~ /(\w+)\s*((?:[^;@]+|@[^@]*@)*);/gs }; } Index: Plain.pm =================================================================== RCS file: /cvsroot/lxr/lxr/lib/LXR/Files/Plain.pm,v retrieving revision 1.23 retrieving revision 1.24 diff -u -d -r1.23 -r1.24 --- Plain.pm 19 Jul 2004 19:50:21 -0000 1.23 +++ Plain.pm 21 Jul 2004 20:44:31 -0000 1.24 @@ -25,9 +25,9 @@ use LXR::Common; sub new { - my ( $self, $rootpath ) = @_; + my ($self, $rootpath) = @_; - $self = bless( {}, $self ); + $self = bless({}, $self); $self->{'rootpath'} = $rootpath; $self->{'rootpath'} =~ s@/*$@/@; @@ -35,54 +35,53 @@ } sub filerev { - my ( $self, $filename, $release ) = @_; + my ($self, $filename, $release) = @_; # return $release; - return join( "-", - $self->getfiletime( $filename, $release ), - $self->getfilesize( $filename, $release ) ); + return + join("-", $self->getfiletime($filename, $release), $self->getfilesize($filename, $release)); } sub getfiletime { - my ( $self, $filename, $release ) = @_; + my ($self, $filename, $release) = @_; - return ( stat( $self->toreal( $filename, $release ) ) )[9]; + return (stat($self->toreal($filename, $release)))[9]; } sub getfilesize { - my ( $self, $filename, $release ) = @_; + my ($self, $filename, $release) = @_; - return -s $self->toreal( $filename, $release ); + return -s $self->toreal($filename, $release); } sub getfile { - my ( $self, $filename, $release ) = @_; + my ($self, $filename, $release) = @_; my ($buffer); local ($/) = undef; - open( FILE, "<", $self->toreal( $filename, $release ) ) || return undef; + open(FILE, "<", $self->toreal($filename, $release)) || return undef; $buffer = <FILE>; close(FILE); return $buffer; } sub getfilehandle { - my ( $self, $filename, $release ) = @_; + my ($self, $filename, $release) = @_; my ($fileh); - $fileh = new FileHandle( $self->toreal( $filename, $release ) ); + $fileh = new FileHandle($self->toreal($filename, $release)); return $fileh; } sub tmpfile { - my ( $self, $filename, $release ) = @_; - my ( $tmp, $tries ); + my ($self, $filename, $release) = @_; + my ($tmp, $tries); local ($/) = undef; $tmp = $config->tmpdir . '/lxrtmp.' . time . '.' . $$ . '.' . &LXR::Common::tmpcounter; - open( TMP, "> $tmp" ) || return undef; - open( FILE, "<", $self->toreal( $filename, $release ) ) || return undef; - print( TMP <FILE> ); + open(TMP, "> $tmp") || return undef; + open(FILE, "<", $self->toreal($filename, $release)) || return undef; + print(TMP <FILE>); close(FILE); close(TMP); @@ -98,22 +97,22 @@ } sub getdir { - my ( $self, $pathname, $release ) = @_; - my ( $dir, $node, @dirs, @files ); + my ($self, $pathname, $release) = @_; + my ($dir, $node, @dirs, @files); - $dir = $self->toreal( $pathname, $release ); - opendir( DIR, $dir ) || return (); - FILE: while ( defined( $node = readdir(DIR) ) ) { + $dir = $self->toreal($pathname, $release); + opendir(DIR, $dir) || return (); + FILE: while (defined($node = readdir(DIR))) { next if $node =~ /^\.|~$|\.orig$/; next if $node eq 'CVS'; - if ( -d $dir . $node ) { - foreach my $ignoredir ( $config->ignoredirs ) { + if (-d $dir . $node) { + foreach my $ignoredir ($config->ignoredirs) { next FILE if $node eq $ignoredir; } - push( @dirs, $node . '/' ); + push(@dirs, $node . '/'); } else { - push( @files, $node ); + push(@files, $node); } } closedir(DIR); @@ -127,35 +126,35 @@ # other possible File classes.) sub toreal { - my ( $self, $pathname, $release ) = @_; + my ($self, $pathname, $release) = @_; # nearly all (if not all) method calls eventually call toreal(), so this is a good place to block file access - foreach my $ignoredir ( $config->ignoredirs ) { + foreach my $ignoredir ($config->ignoredirs) { return undef if $pathname =~ m|/$ignoredir/|; } - return ( $self->{'rootpath'} . $release . $pathname ); + return ($self->{'rootpath'} . $release . $pathname); } sub isdir { - my ( $self, $pathname, $release ) = @_; + my ($self, $pathname, $release) = @_; - return -d $self->toreal( $pathname, $release ); + return -d $self->toreal($pathname, $release); } sub isfile { - my ( $self, $pathname, $release ) = @_; + my ($self, $pathname, $release) = @_; - return -f $self->toreal( $pathname, $release ); + return -f $self->toreal($pathname, $release); } sub getindex { - my ( $self, $pathname, $release ) = @_; - my ( $index, %index ); - my $indexname = $self->toreal( $pathname, $release ) . "00-INDEX"; + my ($self, $pathname, $release) = @_; + my ($index, %index); + my $indexname = $self->toreal($pathname, $release) . "00-INDEX"; - if ( -f $indexname ) { - open( INDEX, "<", $indexname ) + if (-f $indexname) { + open(INDEX, "<", $indexname) || warning("Existing $indexname could not be opened."); local ($/) = undef; $index = <INDEX>; @@ -166,13 +165,13 @@ } sub allreleases { - my ( $self, $filename ) = @_; + my ($self, $filename) = @_; - opendir( SRCDIR, $self->{'rootpath'} ); + opendir(SRCDIR, $self->{'rootpath'}); my @dirs = readdir(SRCDIR); closedir(SRCDIR); - return grep { /^[^\.]/ && -r $self->toreal( $filename, $_ ) } @dirs; + return grep { /^[^\.]/ && -r $self->toreal($filename, $_) } @dirs; } 1; |