From 475d5b279433dbf5b755a0b52bbdce7e1ed49ab0 Mon Sep 17 00:00:00 2001 From: Thierry Vignaud Date: Mon, 2 Aug 2004 04:35:24 +0000 Subject: perl_checker cleanups --- clean_files | 6 ++-- compress_files | 94 ++++++++++++++++++++++++++++--------------------------- relative_me_babe | 7 ++--- strip_files | 31 +++++++++--------- translate_menu.pl | 14 ++++----- 5 files changed, 76 insertions(+), 76 deletions(-) diff --git a/clean_files b/clean_files index e39a58a..f0ae5e8 100755 --- a/clean_files +++ b/clean_files @@ -10,10 +10,10 @@ #--------------------------------------------------------------- ################################################################################ -$RPM_BUILD_ROOT=$ENV{RPM_BUILD_ROOT}; -chdir($RPM_BUILD_ROOT) || die "Can't cd to $ENV{RPM_BUILD_ROOT}: $!"; +my $RPM_BUILD_ROOT = $ENV{RPM_BUILD_ROOT}; +chdir($RPM_BUILD_ROOT) or die "Can't cd to $ENV{RPM_BUILD_ROOT}: $!"; -system(split(/\s+/,"find . -type f -a +system(split(/\s+/, "find . -type f -a ( -name #*# -o -name *~ -o -name DEADJOE -o -name .cvsignore -o -name *.orig -o -name *.rej -o -name *.bak -o -name .*.orig -o -name .*.rej -o -name .SUMS diff --git a/compress_files b/compress_files index 2550b95..bdeb408 100755 --- a/compress_files +++ b/compress_files @@ -15,8 +15,8 @@ use File::Find; ################################################################################ # Returns the basename of the argument passed to it. sub basename { - my $fn=shift; - $fn=~s:^.*/(.*?)$:$1:; + my $fn = shift; + $fn =~ s!^.*/(.*?)$!$1!; return $fn; } @@ -24,7 +24,7 @@ sub basename { # Returns the directory name of the argument passed to it. sub dirname { my $fn=shift; - $fn=~s:^(.*)/.*?$:$1:; + $fn =~ s!^(.*)/.*?$!$1!; return $fn; } @@ -45,11 +45,11 @@ sub xargs { $static_length+=length($_)+1; } - my @collect=(); + my @collect; my $length=$static_length; foreach (@$args) { if (length($_) + 1 + $static_length > $command_max) { - error("This command is greater than the maximum command size allowed by the kernel, and cannot be split up further. What on earth are you doing? \"@_ $_\""); + error(qq(This command is greater than the maximum command size allowed by the kernel, and cannot be split up further. What on earth are you doing? "@_ $_")); } $length+=length($_) + 1; if ($length < $command_max) { @@ -57,7 +57,7 @@ sub xargs { } else { system(@_,@collect) if $#collect > -1; - @collect=($_); + @collect = $_; $length=$static_length + length($_) + 1; } } @@ -68,7 +68,8 @@ sub xargs { # Check if a file is a .so man page, for use by File::Find. my @sofiles; my @sodests; -sub find_so_man { +sub find_so_man() { + local $_ = $_; # The -s test is becuase a .so file tends to be small. We don't want # to open every man page. 1024 is arbitrary. if (! -f $_ || -s $_ > 1024) { @@ -76,10 +77,11 @@ sub find_so_man { } # Test first line of file for the .so thing. - open (SOTEST,$_); - my $l=; - close SOTEST; - if ($l=~m/\.so\s+(.*)/) { + my $SOTEST; + open($SOTEST, $_); + my $l=<$SOTEST>; + close $SOTEST; + if ($l =~ m/\.so\s+(.*)/) { my $solink=$1; # This test is here to prevent links like ... man8/../man8/foo.8 if (basename($File::Find::dir) eq dirname($solink)) { @@ -89,39 +91,37 @@ sub find_so_man { $solink="../$solink"; } - push @sofiles,"$File::Find::dir/$_"; - push @sodests,$solink; + push @sofiles, "$File::Find::dir/$_"; + push @sodests, $solink; } } ################################################################################ -$RPM_BUILD_ROOT=$ENV{RPM_BUILD_ROOT}; -chdir($RPM_BUILD_ROOT) || die "Can't cd to $ENV{RPM_BUILD_ROOT}: $!"; +my $RPM_BUILD_ROOT = $ENV{RPM_BUILD_ROOT}; +chdir($RPM_BUILD_ROOT) or die "Can't cd to $ENV{RPM_BUILD_ROOT}: $!"; # Now the .so conversion. -@sofiles=@sodests=(); -foreach $dir (qw{usr/man usr/X11R6/man usr/lib/perl5/man}) { - if (-e "$dir") { - find(\&find_so_man, "$dir"); - } +@sofiles = @sodests = (); +foreach my $dir (qw{usr/man usr/X11R6/man usr/lib/perl5/man}) { + find(\&find_so_man, $dir) if -e $dir; } -foreach $sofile (@sofiles) { - my $sodest=shift(@sodests); - system "rm","-f",$sofile; - system "ln","-sf",$sodest,$sofile; +foreach my $sofile (@sofiles) { + my $sodest = shift(@sodests); + system "rm", "-f",$sofile; + system "ln", "-sf",$sodest,$sofile; } -push @files, split(/\n/,`find usr/info usr/share/info usr/man usr/share/man usr/X11*/man usr/lib/perl5/man -type f ! -name "*.gz" -a ! -name "*.bz2" ! -name 'dir' ! -name 'whatis' 2>/dev/null || true`); +my @files = split(/\n/, `find usr/info usr/share/info usr/man usr/share/man usr/X11*/man usr/lib/perl5/man -type f ! -name "*.gz" -a ! -name "*.bz2" ! -name 'dir' ! -name 'whatis' 2>/dev/null || true`); -push @gz_files, split(/\n/,`find usr/info usr/share/info usr/man usr/share/man usr/X11*/man usr/lib/perl5/man -type f -name "*.gz" 2>/dev/null || true`); -if (@gz_files) {xargs(\@gz_files,"gzip", "-d"); $? ? die "Something wrong with the decompression of the gzip man/info file, fix this ASAP" : exec($0);} +my @gz_files = split(/\n/, `find usr/info usr/share/info usr/man usr/share/man usr/X11*/man usr/lib/perl5/man -type f -name "*.gz" 2>/dev/null || true`); +if (@gz_files) { xargs(\@gz_files, "gzip", "-d"); $? ? die "Something wrong with the decompression of the gzip man/info file, fix this ASAP" : exec($0) } # Exclude files from compression. if (@files && defined($ENV{EXCLUDE_FROM_COMPRESS})) { - @new=(); + my @new; foreach (@files) { - $ok=1; - foreach $x (split(' ',$ENV{EXCLUDE_FROM_COMPRESS})) { + my $ok = 1; + foreach my $x (split(' ', $ENV{EXCLUDE_FROM_COMPRESS})) { if (/\Q$x\E/) { $ok=''; last; @@ -135,18 +135,18 @@ if (@files && defined($ENV{EXCLUDE_FROM_COMPRESS})) { # Look for files with hard links. If we are going to compress both, # we can preserve the hard link across the compression and save # space in the end. -my @f=(); -my %hardlinks; +my @f; +my (%hardlinks, %seen); foreach (@files) { - ($dev, $inode, undef, $nlink)=stat($_); + my ($dev, $inode, undef, $nlink)=stat($_); if ($nlink > 1) { if (! $seen{"$inode.$dev"}) { - $seen{"$inode.$dev"}=$_; + $seen{"$inode.$dev"} = $_; push @f, $_; } else { # This is a hardlink. - $hardlinks{$_}=$seen{"$inode.$dev"}; + $hardlinks{$_} = $seen{"$inode.$dev"}; } } else { @@ -156,9 +156,9 @@ foreach (@files) { if (@f) { # Make executables not be anymore. - xargs(\@f,"chmod","a-x"); + xargs(\@f, "chmod", "a-x"); - xargs(\@f,"bzip2","-9f"); + xargs(\@f, "bzip2", "-9f"); } @@ -166,23 +166,25 @@ if (@f) { # they are again. foreach (keys %hardlinks) { # Remove old file. - system("rm","-f","$_"); + system("rm", "-f", $_); # Make new hardlink. - system("ln","$hardlinks{$_}.bz2","$_.bz2"); + system("ln", "$hardlinks{$_}.bz2", "$_.bz2"); } # Fix up symlinks that were pointing to the uncompressed files. -open (FIND,"find $RPM_BUILD_ROOT -type l |"); -while () { +my $FIND; +open($FIND, "find $RPM_BUILD_ROOT -type l |"); +while (<$FIND>) { + local $_ = $_; chomp; - ($directory)=m:(.*)/:; - $linkval=readlink($_); + my ($directory) = m!(.*)/!; + my $linkval = readlink($_); if (! -e "$directory/$linkval" && -e "$directory/$linkval.bz2") { - system("rm","-f",$_); - system("ln","-sf","$linkval.bz2","$_.bz2"); + system("rm", "-f", $_); + system("ln", "-sf", "$linkval.bz2", "$_.bz2"); } elsif (! -e "$directory/$linkval" && ! -e "$directory/linkval.bz2" && $directory =~ m|man/|) { #Bad link go on nowhere (any better idea) ? - unlink("$_"); + unlink($_); } } diff --git a/relative_me_babe b/relative_me_babe index e390a18..e55b9df 100755 --- a/relative_me_babe +++ b/relative_me_babe @@ -9,10 +9,9 @@ my $r=$ENV{RPM_BUILD_ROOT}; chdir($r) or "Can't cd to $ENV{RPM_BUILD_ROOT}: $!"; push my @files, split(/\n/, `find -type l 2> /dev/null`); -for (@files) { - my $file = $_; - my $link=readlink($file); - if ($link =~ /^\//) { +foreach my $file (@files) { + my $link = readlink($file); + if ($link =~ m!^/!) { $link =~ s|^/||; # Ugly ? no simply chmou. (my $dirname = $file) =~ s|/[^/]*$||; $dirname =~ s|/[^/]+|../|g; $dirname =~ s|^\.||; diff --git a/strip_files b/strip_files index 0afe4d7..0898ce1 100755 --- a/strip_files +++ b/strip_files @@ -16,36 +16,35 @@ use File::Find; # for use by File::Find. It'll fill the following 3 arrays with anything # it finds: my (@shared_libs, @executables, @static_libs); -my @exclude_files = (split(' ',$ENV{EXCLUDE_FROM_STRIP}),"/usr/lib/debug"); +my @exclude_files = (split(' ', $ENV{EXCLUDE_FROM_STRIP}), "/usr/lib/debug"); -sub testfile { - - return if -l $_ or -d $_; # Skip directories and symlinks always. - - $fn="$File::Find::dir/$_"; +sub testfile() { + local $_ = $_; + return if -l $_ || -d $_; # Skip directories and symlinks always. + my $fn = "$File::Find::dir/$_"; # See if we were asked to exclude this file. # Note that we have to test on the full filename, including directory. foreach my $f (@exclude_files) { - return if ($fn=~m/\Q$f\E/); + return if $fn =~ m/\Q$f\E/; } # Does its filename look like a shared library? if (m/.*\.so.*?/) { # Ok, do the expensive test. my $type=`file $_`; - if ($type=~m/.*ELF.*shared/) { + if ($type =~ m/.*ELF.*shared/) { push @shared_libs, $fn; return; } } # Is it executable? -x isn't good enough, so we need to use stat. - (undef,undef,$mode,undef)=stat(_); + my (undef, undef, $mode, undef) = stat(_); if ($mode & 0111) { # Ok, expensive test. my $type=`file $_`; - if ($type=~m/.*ELF.*executable/) { + if ($type =~ m/.*ELF.*executable/) { push @executables, $fn; return; } @@ -59,20 +58,20 @@ sub testfile { } ################################################################################ -$RPM_BUILD_ROOT=$ENV{RPM_BUILD_ROOT}; -chdir($RPM_BUILD_ROOT) || die "Can't cd to $ENV{RPM_BUILD_ROOT}: $!"; +my $RPM_BUILD_ROOT = $ENV{RPM_BUILD_ROOT}; +chdir($RPM_BUILD_ROOT) or die "Can't cd to $ENV{RPM_BUILD_ROOT}: $!"; -@shared_libs=@executables=@static_libs=(); -find(\&testfile,$RPM_BUILD_ROOT); +@shared_libs = @executables = @static_libs = (); +find(\&testfile, $RPM_BUILD_ROOT); foreach (@shared_libs) { # Note that all calls to strip on shared libs # *must* inclde the --strip-unneeded. - system("strip","--remove-section=.comment","--remove-section=.note","--strip-unneeded",$_); + system("strip", "--remove-section=.comment", "--remove-section=.note", "--strip-unneeded",$_); } foreach (@executables) { - system("strip","--remove-section=.comment","--remove-section=.note",$_); + system("strip", "--remove-section=.comment", "--remove-section=.note",$_); } # strip_files ends here diff --git a/translate_menu.pl b/translate_menu.pl index c634e14..57845fb 100755 --- a/translate_menu.pl +++ b/translate_menu.pl @@ -9,7 +9,7 @@ # Purpose : change the menu sections #--------------------------------------------------------------- -@nested = (["Configuration", "System/Configuration"], +my @nested = (["Configuration", "System/Configuration"], ["Applications/Monitoring", "System/Monitoring"], ["Applications/Publishing", "Office/Publishing"], @@ -36,7 +36,7 @@ sub translate { my ($str) = @_; foreach my $t (@nested) { - if ($str =~ /(.*)$t->[0](.*)/ and not ($str =~ /$t->[1]/) ) { + if ($str =~ /(.*)$t->[0](.*)/ && $str !~ /$t->[1]/) { print "$str => $1$t->[1]$2\n"; return "$1$t->[1]$2"; } @@ -46,16 +46,16 @@ sub translate { # process each file passed on cli: foreach my $file (@ARGV) { - open (my $FILE, "<$file"); + open(my $FILE, "<$file"); my @lines = <$FILE>; close($FILE); - open ($FILE, ">$file"); - for my $l (@lines) { + open($FILE, ">$file"); + foreach my $l (@lines) { chomp($l); - if (( $l =~ /(.*section=)"([^"]+)"(\s+.*)/ ) or ( $l =~ /(.*section=)([^"].+?)((\s|\\)+.*)/ )) { + if ($l =~ /(.*section=)"([^"]+)"(\s+.*)/ || $l =~ /(.*section=)([^"].+?)((\s|\\)+.*)/) { my ($beg, $section, $end) = ($1, $2, $3); $section = translate($section); - $l = "$beg\"$section\"$end"; + $l = qq($beg"$section"$end); } print $FILE "$l\n"; } -- cgit v1.2.1