From 9221124593fd089c6627d0847d02fc30a6ca9d3f Mon Sep 17 00:00:00 2001 From: Tom Ryder Date: Wed, 27 Jun 2012 18:48:35 +1200 Subject: Trying to get this perlcritic compliant --- clubber | 187 +++++++++++++++++++++++++++++++++++++++------------------------- 1 file changed, 113 insertions(+), 74 deletions(-) diff --git a/clubber b/clubber index 537a8da..35568bf 100755 --- a/clubber +++ b/clubber @@ -8,6 +8,13 @@ # @author Tom Ryder # @copyright 2012 Sanctum # +# $Author$ +# $Date$ +# $Id$ +# $Revision$ +# $Source$ +# +package Sanctum::Clubber; # # Force me to write this properly. @@ -15,49 +22,55 @@ use strict; use warnings; +# +# Set a version number to shut perlcritic up. +# +our $VERSION => 1.0; + # # Import required Perl libraries; these are all pretty standard. # use Cwd qw(abs_path); use Digest::MD5; +use English qw(-no_match_vars); use File::Basename; use File::Find; use Getopt::Long; -# -# Ignore stupid and useless messages from File::Find. -# -no warnings 'File::Find'; - # # Check ldd is available. # -chomp(my $ldd = `which ldd`); -if (!$ldd) { - error("Couldn't find ldd in your \$PATH."); +chomp( my $ldd = qx/which ldd/ ); +if ( !$ldd ) { + error('Could not find ldd in your PATH.'); } # # Check options. # -my ($chroot, $dry) = ("", 0); -my $config = GetOptions("chroot=s" => \$chroot, - "dry" => \$dry); +my ( $chroot, $dry ) = ( q{}, 0 ); +my $config = GetOptions( + 'chroot=s' => \$chroot, + 'dry' => \$dry +); if ($chroot) { $chroot = abs_path($chroot); - if (!-d $chroot) { - error("Nominated chroot %s doesn't seem to be a directory.", $chroot); + if ( !-d $chroot ) { + error( 'Nominated chroot %s does not seem to be a directory.', + $chroot ); } -} elsif ($dry) { - error("Doesn't make sense to specify --dry without --chroot."); +} +elsif ($dry) { + error('Does not make sense to specify --dry without --chroot.'); } # # Check we were passed at least one parameter, otherwise print a helpful # message. # -if (!@ARGV) { - printf STDOUT "USAGE: ${0} [--chroot] [--dry] binary1 binary2 ... \n"; +if ( !@ARGV ) { + printf {*STDOUT} "USAGE: %s [--chroot] [--dry] binary1 binary2 ... \n", + $PROGRAM_NAME; exit 0; } @@ -67,10 +80,11 @@ if (!@ARGV) { my $binaries = []; foreach my $argument (@ARGV) { $argument = abs_path($argument); - if (-f $argument) { - push @$binaries, $argument; - } else { - error("File %s doesn't seem to exist.", $argument); + if ( -f $argument ) { + push @{$binaries}, $argument; + } + else { + error( 'File %s does not seem to exist.', $argument ); } } @@ -78,15 +92,7 @@ foreach my $argument (@ARGV) { # Run ldd on all the files and slurp all the absolute paths; put them into a # hash to keep things unique. # -my $libraries = {}; -foreach my $binary (@$binaries) { - my $output = [qx/${ldd} ${binary}/]; - foreach my $line (@$output) { - if ($line =~ m#(/\S*lib\S+)#) { - $libraries->{$1} = 1; - } - } -} +my $libraries = get_libraries($binaries); # # Include all libnss libraries available, because even static binaries depend @@ -101,15 +107,17 @@ foreach my $binary (@$binaries) { my $nsslibs = {}; my $nssfind = sub { my $basename = $_; - if ($File::Find::name =~ /libnss.+\.so/) { - if (!exists $nsslibs->{$basename} or length($File::Find::name) < length($nsslibs->{$basename})) { + if ( $File::Find::name =~ /libnss.+[.]so/msx ) { + if ( not exists $nsslibs->{$basename} + or length($File::Find::name) < length( $nsslibs->{$basename} ) ) + { $nsslibs->{$basename} = $File::Find::name; } } }; -find($nssfind, qw(/lib /usr/lib)); -foreach my $nsslib (keys(%$nsslibs)) { - $libraries->{$nsslibs->{$nsslib}} = 1; +find( $nssfind, qw(/lib /usr/lib) ); +foreach my $nsslib ( keys %{$nsslibs} ) { + $libraries->{ $nsslibs->{$nsslib} } = 1; } # @@ -117,7 +125,7 @@ foreach my $nsslib (keys(%$nsslibs)) { # and which directories require creating. # if ($chroot) { - my ($directories, $imports) = ({}, {}); + my ( $directories, $imports ) = ( {}, {} ); # # First we'll recurse through the list of libraries and flag any @@ -129,13 +137,13 @@ if ($chroot) { # library. If it doesn't exist or if it's different, we'll flag it for # overwriting. # - foreach my $library (keys(%$libraries)) { + foreach my $library ( keys %{$libraries} ) { my $directory = dirname($library); # # If the directory doesn't exist, flag it for creation. # - if (!-d "${chroot}${directory}") { + if ( !-d "${chroot}${directory}" ) { $directories->{$directory} = 1; } @@ -143,39 +151,44 @@ if ($chroot) { # If the library exists, we need to see if it's the same as our source # library. # - if (-f "${chroot}${library}") { + if ( -f "${chroot}${library}" ) { # # Get MD5 checksum of source library. # - open(my $src, "<", $library) - or error("Couldn't read file %s to checksum it.", $library); - binmode($src); + open my $src, '<', $library + or error( 'Could not read file %s to checksum it.', $library ); + binmode $src; my $src_checksum = Digest::MD5->new->addfile($src)->hexdigest; - close($src); + close $src + or error( 'Could not close file %s.', $library ); # # Get MD5 checksum of library presently occupying the path to # which we intend to copy this library. # - open(my $dst, "<", "${chroot}${library}") - or error("Couldn't read file %s to checksum it.", "${chroot}${library}"); - binmode($dst); + open my $dst, '<', "${chroot}${library}" + or error( 'Could not read file %s to checksum it.', + "${chroot}${library}" ); + binmode $dst; my $dst_checksum = Digest::MD5->new->addfile($dst)->hexdigest; - close($dst); + close $dst + or error( 'Could not close file %s.', $library ); # # Compare checksums; if they're different, we need to copy the # library in. # - if ($src_checksum ne $dst_checksum) { + if ( $src_checksum ne $dst_checksum ) { $imports->{$library} = 1; } + } + # # The library doesn't exist, so we need to copy it in. # - } else { + else { $imports->{$library} = 1; } } @@ -183,63 +196,72 @@ if ($chroot) { # # Check there's something for us to do. # - if (keys %$directories || keys %$imports) { + if ( keys %{$directories} || keys %{$imports} ) { # # If we're just supposed to print what we do, all the better, do # that and then quit; and for that, we don't require root privileges. # if ($dry) { - if (keys %$directories) { - printf STDOUT "Create directories:\n"; - foreach my $directory (sort(keys(%$directories))) { - printf STDOUT " %s\n", "${chroot}${directory}"; + if ( keys %{$directories} ) { + printf {*STDOUT} "Create directories:\n"; + foreach my $directory ( sort keys %{$directories} ) { + printf {*STDOUT} " %s\n", "${chroot}${directory}"; } } - if (keys %$imports) { - printf STDOUT "Copy libraries:\n"; - foreach my $import (sort(keys(%$imports))) { - printf STDOUT " %s -> %s\n", $import, "${chroot}${import}"; + if ( keys %{$imports} ) { + printf {*STDOUT} "Copy libraries:\n"; + foreach my $import ( sort keys %{$imports} ) { + printf {*STDOUT} " %s -> %s\n", $import, + "${chroot}${import}"; } } + } + # # Otherwise, we'd best get started, and we need root privileges. # - } else { + else { # # Bail if we're not root. # - if ($< != 0 || $> != 0) { - error("You must have root permissions to use the --chroot parameter."); + if ( $UID != 0 || $EUID != 0 ) { + error( +'You must have root permissions to use the --chroot parameter.' + ); } # # Create directories and import libraries. # - foreach my $directory (sort(keys(%$directories))) { - system("mkdir -pv ${chroot}${directory}"); + foreach my $directory ( sort keys %{$directories} ) { + system "mkdir -pv ${chroot}${directory}"; } - foreach my $import (sort(keys(%$imports))) { - system("cp -pv ${import} ${chroot}${import}"); + foreach my $import ( sort keys %{$imports} ) { + system "cp -pv ${import} ${chroot}${import}"; } } + } + # # If there's nothing we need to do, say so. # - } else { - printf STDOUT "Nothing to do.\n"; + else { + printf {*STDOUT} "Nothing to do.\n"; } +} + # # If we don't have a chroot, we can just print the list of libraries, and we're # done. # -} else { - foreach my $library (sort(keys(%$libraries))) { - printf STDOUT "%s\n", $library; +else { + foreach my $library ( sort keys %{$libraries} ) { + printf {*STDOUT} "%s\n", $library; } } @@ -248,12 +270,29 @@ if ($chroot) { # exit 0; +# +# Run ldd on all the files and slurp all the absolute paths; put them into a +# hash to keep things unique. +# +sub get_libraries { + my ($targets) = @_; + foreach my $target ( @{$targets} ) { + my $output = [qx/${ldd} ${target}/]; + foreach my $line ( @{$output} ) { + if ( $line =~ m/(\/\S*lib\S+)/msx ) { + $libraries->{$1} = 1; + } + } + } + return $libraries; +} + # # Print a usage message and exit with non-zero. # sub usage { - my $message = shift @_; - printf STDERR "USAGE: ${message}\n", @_; + my ( $message, @params ) = @_; + printf {*STDERR} "USAGE: ${message}\n", @params; exit 1; } @@ -261,8 +300,8 @@ sub usage { # Print a usage message and exit with non-zero. # sub error { - my $message = shift @_; - printf STDERR "ERROR: ${message}\n", @_; + my ( $message, @params ) = @_; + printf {*STDERR} "ERROR: ${message}\n", @params; exit 1; } -- cgit v1.2.3