From 43447dae9a616c92bd4ca5910002d162c06a611f Mon Sep 17 00:00:00 2001 From: Thierry Vignaud Date: Sat, 24 Mar 2012 15:36:34 +0000 Subject: perl_checker cleanups --- .perl_checker | 1 + emi | 26 +++++++++++++------------- iurt2 | 40 +++++++++++++++++++--------------------- iurt_root_command | 8 ++++---- lib/Iurt/Chroot.pm | 10 +++------- lib/Iurt/Mail.pm | 4 ++-- lib/Iurt/Urpmi.pm | 2 +- ulri | 2 +- 8 files changed, 44 insertions(+), 49 deletions(-) diff --git a/.perl_checker b/.perl_checker index 28a87e1..5a8c0b5 100644 --- a/.perl_checker +++ b/.perl_checker @@ -23,5 +23,6 @@ MDV::Distribconf::Build MIME::Words RPM4::Header Scalar::Util +String::Escape Text::Wrap XSLoader diff --git a/emi b/emi index 87ad8a1..1908504 100755 --- a/emi +++ b/emi @@ -124,7 +124,7 @@ my %archdone; # sub done_func { - my ($_todo, $f, $m, $s, $r) = @_; + my ($_todo, $_f, $m, $s, $r) = @_; my $section = "$m/$s"; @@ -176,8 +176,8 @@ check_upload_tree(\%run, $todo, \&todo_func,); # Decide what should be uploaded # -# $targets{$target}{$section}{'arch_finisher'}{$arch}: prefix on which we need to actions to get this arch updated -# $targets{$target}{$section}{'to_upload'}: list of prefixes to upload +# $targets{$target}{$section}{arch_finisher}{$arch}: prefix on which we need to actions to get this arch updated +# $targets{$target}{$section}{to_upload}: list of prefixes to upload my %targets; foreach my $prefix (sort keys %pkg_tree) { @@ -210,29 +210,29 @@ foreach my $prefix (sort keys %pkg_tree) { next; } } - next unless ($ok); + next unless $ok; # # All mandatory archs found, mark for upload # foreach my $section (keys %{$pkg_tree{$prefix}{section}}) { - $targets{$target}{$section} ||= {'arch_finisher' => {}, 'is_finisher' => {}, 'to_upload' => []}; + $targets{$target}{$section} ||= { 'arch_finisher' => {}, 'is_finisher' => {}, 'to_upload' => [] }; - push @{$targets{$target}{$section}{'to_upload'}}, $prefix; + push @{$targets{$target}{$section}{to_upload}}, $prefix; # We already have found universal finisher in that section, we're fine - next if exists $targets{$target}{$section}{'arch_finisher'}{'noarch'}; + next if exists $targets{$target}{$section}{arch_finisher}{noarch}; if ($pkg_tree{$prefix}{section}{$section}{arch}{noarch}) { # This package is noarch, genhdlist for it will touch all archs - $targets{$target}{$section}{'arch_finisher'} = { 'noarch' => $prefix }; + $targets{$target}{$section}{arch_finisher} = { 'noarch' => $prefix }; } else { - my $has_new_arch = scalar(difference2([ keys %{$pkg_tree{$prefix}{section}{$section}{arch}} ], [ keys %{$targets{$target}{$section}{'arch_finisher'}} ])); + my $has_new_arch = scalar(difference2([ keys %{$pkg_tree{$prefix}{section}{$section}{arch}} ], [ keys %{$targets{$target}{$section}{arch_finisher}} ])); if ($has_new_arch) { # We need this package to cover the new arch # Set it for all, it may allow getting rid of some others foreach (keys %{$pkg_tree{$prefix}{section}{$section}{arch}}) { - $targets{$target}{$section}{'arch_finisher'}{$_} = $prefix; + $targets{$target}{$section}{arch_finisher}{$_} = $prefix; } } } @@ -308,11 +308,11 @@ foreach my $target (keys %targets) { foreach my $section (keys %{$targets{$target}}) { my %is_finisher; - foreach (values %{$targets{$target}{$section}{'arch_finisher'}}) { + foreach (values %{$targets{$target}{$section}{arch_finisher}}) { $is_finisher{$_} = 1; } - foreach my $prefix (@{$targets{$target}{$section}{'to_upload'}}) { + foreach my $prefix (@{$targets{$target}{$section}{to_upload}}) { next if $is_finisher{$prefix}; upload_prefix_in_section($prefix, $section); } @@ -321,7 +321,7 @@ foreach my $target (keys %targets) { upload_prefix_in_section($prefix, $section, 1); } - foreach my $prefix (@{$targets{$target}{$section}{'to_upload'}}) { + foreach my $prefix (@{$targets{$target}{$section}{to_upload}}) { my $path = $pkg_tree{$prefix}{section}{$section}{path}; open FOO, ">$done/$path/$prefix.upload" unless -f "$reject/$path/$prefix.youri"; } diff --git a/iurt2 b/iurt2 index 95418bb..bd2620d 100755 --- a/iurt2 +++ b/iurt2 @@ -77,7 +77,7 @@ $SIG{TERM} = sub { }; my $program_name = 'iurt2'; -my $VERSION = '0.6.5'; + # sessing parameters my $sudo = '/usr/bin/sudo'; my $arg = @ARGV; @@ -232,7 +232,7 @@ $run{todo} = []; } ($srpm, $path) = fileparse(rel2abs($_)); - ($srpm =~ /\.src\.rpm$/) or die "FATAL: $_ doesn't look like an SRPM"; + $srpm =~ /\.src\.rpm$/ or die "FATAL: $_ doesn't look like an SRPM"; if (check_arch($_, $run{my_arch})) { plog('DEBUG', "force build for $2 (from $1)"); @@ -303,13 +303,13 @@ $run{todo} = []; [ "", "with", 1, "", "Use specified --with flag with rpm (can be used multiple times)", sub { - ($run{with_flags}) = $run{with_flags} . " --with " . @_[0]; + $run{with_flags} .= " --with " . $_[0]; 1; }, "Adding specified extra --with parameter to rpm" ], [ "", "without", 1, "", "Use specified --without flag with rpm (can be used multiple times)", sub { - ($run{with_flags}) = $run{with_flags} . " --without " . @_[0]; + $run{with_flags} .= " --without " . $_[0]; 1; }, "Adding specified extra --without parameter to rpm" ], # [ short option, long option, # of args, syntax description, @@ -348,20 +348,19 @@ $run{todo} = []; [ "", "icecream", 1, "", "Enables icecream usage by procs", sub { - $run{icecream} = @_[0]; + $run{icecream} = $_[0]; }, "Enabling icecream usage" ], ); open(my $LOG, ">&STDERR"); -plog_init($program_name, $run{logfd}||$LOG, 7, 1); # For parsing command line +plog_init($program_name, $run{logfd} || $LOG, 7, 1); # For parsing command line # Display version information # (my $iurt_rev = '$Rev$') =~ s/.*: (\d+).*/$1/; (my $iurt_aut = '$Author$') =~ s/.*: (..).*/$1/; -(my $iurt_dat = '$Date$') - =~ s/.*: ([\d-]* [\d:]*) .*/$1/; +(my $iurt_dat = '$Date$') =~ s/.*: ([\d-]* [\d:]*) .*/$1/; plog("MSG", "This is iurt2 revision $iurt_rev-$iurt_aut ($iurt_dat)"); @@ -373,7 +372,7 @@ foreach my $t (@$todo) { } # Use the real verbose level -plog_init($program_name, $run{logfd}||$LOG, $run{verbose}, 1); +plog_init($program_name, $run{logfd} || $LOG, $run{verbose}, 1); $run{distro_tag} = $run{distro}; $run{distro_tag} =~ s,/,-,g; @@ -508,7 +507,7 @@ my %config_usage = ( }, prompt => { desc => 'Default prompt in the chroot', - default => qq{PS1='[\\[\\033[00;33m\\]iurt $run{distro}\\[\\033[00m\\]] \\[\\033[00;31m\\]\\u\\[\\033[00;32m\\]\\h\\[\\033[00m\\]\\w\$ '}, + default => qq(PS1='[\\[\\033[00;33m\\]iurt $run{distro}\\[\\033[00m\\]] \\[\\033[00;31m\\]\\u\\[\\033[00;32m\\]\\h\\[\\033[00m\\]\\w\$ '), }, repository => { desc => 'Prefix of the repositories', @@ -562,14 +561,11 @@ if ($run{distro} ne 'cooker') { } my $lock = $run{media}; -my $local; # FIXME: (tv) variable $local assigned, but not read if (!$lock && $run{chroot}) { $lock = 'chroot'; - $local = 1; } if (!$lock && $run{dkms}) { $lock = 'dkms'; - $local = 0; } $run{lock} = $lock; @@ -739,8 +735,7 @@ if ($df->{per} >= 99) { if ($run{shell}) { if (!$run{use_old_chroot}) { - my $chroot_tmp = create_temp_chroot(\%run, $config, - $cache, $chroot_tmp, $chroot_tar) + create_temp_chroot(\%run, $config, $cache, $chroot_tmp, $chroot_tar) or die "FATAL $program_name: could not create temporary chroot"; } add_local_user($chroot_tmp, \%run, $config, $luser, $run{uid}) or die "FATAL $program_name: could not add local user"; @@ -803,7 +798,8 @@ my $prev_done = $done; do { $rebuild = 0; $done = $prev_done; - for (my $i; $i < @{$run{todo}}; $i++) { + my $i; + for ($i; $i < @{$run{todo}}; $i++) { my ($dir, $srpm, $status) = @{$run{todo}[$i]}; # CM: Set argv[0] (in the C sense) to something we can easily spot and @@ -844,7 +840,7 @@ retry: if (!$urpmi->urpmi_command($chroot_tmp, $luser)) { plog('DEBUG', "Creating chroot failed.\nCommand was: $chroot_tmp"); next; - }; + } $srpm =~ /(.*)-[^-]+-[^-]+\.src\.rpm$/ or next; my ($maintainer, $cc); if (!$run{warn}) { @@ -862,7 +858,8 @@ retry: add_local_user($chroot_tmp, \%run, $config, $luser, $run{uid}) or next; my $old_srpm = $srpm; - my ($ret, $srpm, $spec) = $urpmi->recreate_srpm(\%run, $config, + my ($ret, $spec); + ($ret, $srpm, $spec) = $urpmi->recreate_srpm(\%run, $config, $chroot_tmp, $dir, $srpm, $luser, $retry); if ($ret == -1) { $retry = 1; @@ -932,7 +929,7 @@ retry: error => "[REBUILD] $srpm from $run{distro_tag} does not build correctly on $run{my_arch}", logname => "build", hash => "build_$srpm", - timeout => $config->{build_timeout}{$srpm_name} ? $config->{build_timeout}{$srpm_name} : $config->{build_timeout}{default}, + timeout => $config->{build_timeout}{$srpm_name} || $config->{build_timeout}{default}, srpm => $srpm, debug_mail => $run{debug}, cc => $cc, @@ -947,7 +944,7 @@ retry: exit(); } plog('DEBUG', "calling callback for $opt->{hash}"); - if ($output =~ /bin\/ld: cannot find -l(\S*)|configure.*error.* (?:-l([^\s]+)|([^\s]+) includes)/) { + if ($output =~ m!/bin/ld: cannot find -l(\S*)|configure.*error.* (?:-l(\S+)|(\S+) includes)!) { my $missing = $1; my @rpm = find_provides(\%run, \%pack_provide, $missing); plog(5, "likely @rpm ($missing-devel) needed to rebuilt $srpm is not in build_requires"); @@ -1037,7 +1034,8 @@ retry: dump_cache_par(\%run) if $run{concurrent_run}; } if ($run{group}) { - for (my $i; $i < @{$run{todo}}; $i++) { + my $i; + for ($i; $i < @{$run{todo}}; $i++) { my (undef, $srpm) = @{$run{todo}[$i]}; if (!$run{done}{$srpm}) { $rebuild = $urpmi->order_packages(\%provides, $luser); diff --git a/iurt_root_command b/iurt_root_command index b02f5ad..fad6c13 100755 --- a/iurt_root_command +++ b/iurt_root_command @@ -23,7 +23,7 @@ use strict; my $program_name = 'iurt_root_command'; use Mkcd::Commandline qw(parseCommandLine usage); -use MDK::Common qw(if_); +use MDK::Common qw(any if_); use File::NCopy qw(copy); use Iurt::Util qw(plog_init plog); use Cwd 'realpath'; @@ -35,7 +35,7 @@ my $arg = @ARGV; my (@params, %run); $run{program_name} = $program_name; -my %authorized_modules = (); +my %authorized_modules; my %authorized_rw_bindmounts = (map { $_ => 1 } qw(/proc /dev/pts /var/cache/icecream)); $run{todo} = []; @@ -203,7 +203,7 @@ sub modprobe { return 0; } - return 1 if grep { /^$module\b/ } read_file("/proc/modules"); + return 1 if any { /^$module\b/ } read_file("/proc/modules"); system("/sbin/depmod", "-a"); !system("/sbin/modprobe", "-f", $module); @@ -373,7 +373,7 @@ sub untar { return; } check_path_authorized($file) && check_path_authorized($dir) or return; - if (grep { /^-/ } @o_files) { + if (any { /^-/ } @o_files) { plog('FAIL', "untar: options forbidden"); return; } diff --git a/lib/Iurt/Chroot.pm b/lib/Iurt/Chroot.pm index 77a1463..f5d9880 100644 --- a/lib/Iurt/Chroot.pm +++ b/lib/Iurt/Chroot.pm @@ -55,7 +55,7 @@ sub clean_chroot { open(my $FP, "/proc/mounts") or die $!; my @list = grep { /$chroot/ } <$FP>; close($FP); - if ($#list >= 0) { + if (@list >= 0) { # Still referenced return 1; } @@ -180,7 +180,6 @@ sub dump_rpmmacros { sub add_local_user { my ($chroot_tmp, $run, $config, $luser, $uid) = @_; - my $program_name = $run->{program_name}; # change the builder user to the local user id # FIXME it seems that unionfs does not handle well the change of the @@ -205,10 +204,7 @@ sub add_local_user { } sub create_temp_chroot { - my ($run, $config, $cache, $chroot_tmp, $chroot_tar, $o_srpm) = @_; - - my $home = $config->{local_home}; - my $debug_tag = $run->{debug_tag}; + my ($run, $config, $_cache, $chroot_tmp, $chroot_tar, $o_srpm) = @_; plog("Install new chroot"); plog('DEBUG', "... in $chroot_tmp"); @@ -328,7 +324,7 @@ sub create_chroot { sudo($run, $config, '--untar', $chroot_tar, $tmp_chroot, "./var/log/qa"); my $tmp_urpmi = mktemp("$chroot.tmp.XXXXXX"); - my @installed_pkgs = grep(!/^gpg-pubkey/, chomp_(cat_("$tmp_chroot/var/log/qa"))); + my @installed_pkgs = grep { !/^gpg-pubkey/ } chomp_(cat_("$tmp_chroot/var/log/qa")); my @available_pkgs = chomp_(`urpmq --urpmi-root $tmp_urpmi --use-distrib $run->{urpmi}{distrib_url} --list -f 2>/dev/null`); my @removed_pkgs = difference2(\@installed_pkgs, \@available_pkgs); rm_rf($tmp_urpmi); diff --git a/lib/Iurt/Mail.pm b/lib/Iurt/Mail.pm index 6a9edb6..a268b2c 100644 --- a/lib/Iurt/Mail.pm +++ b/lib/Iurt/Mail.pm @@ -9,7 +9,7 @@ our @EXPORT = qw( ); sub expand_email { - my($email, $config) = @_; + my ($email, $config) = @_; return $email unless $config->{email_domain}; my $name = ""; my $addr = $email; @@ -35,7 +35,7 @@ sub sendmail { if ($cc) { $cc = expand_email($cc, $config); $cc = encode_mimewords($cc); - print $MAIL "Cc: $cc\n" + print $MAIL "Cc: $cc\n"; } print $MAIL "From: $from\n"; print $MAIL "Subject: $subject\n"; diff --git a/lib/Iurt/Urpmi.pm b/lib/Iurt/Urpmi.pm index 3ec70d3..3c5e4e3 100644 --- a/lib/Iurt/Urpmi.pm +++ b/lib/Iurt/Urpmi.pm @@ -302,7 +302,7 @@ sub get_build_requires { $run->{todo_requires} = {}; plog("get_build_requires"); - my ($u_id, $chroot_tmp) = create_temp_chroot($run, $config, $cache, $run->{chroot_tmp}, $run->{chroot_tar}) or return; + my (undef, $chroot_tmp) = create_temp_chroot($run, $config, $cache, $run->{chroot_tmp}, $run->{chroot_tar}) or return; add_local_user($chroot_tmp, $run, $config, $luser, $run->{uid}) or return; my $urpm = new URPM; diff --git a/ulri b/ulri index aa661d7..27bdf35 100755 --- a/ulri +++ b/ulri @@ -718,7 +718,7 @@ foreach my $prefix (sort keys %pkg_tree) { create_file($lock_file, "$program_name $$", time()); # Fork to wait for the build to finish - if ((my $fpid = fork()) == 0) { + if (fork() == 0) { local $SIG{ALRM} = sub { # Run ourselves to kill the build exec "ulri"; -- cgit v1.2.1