From 28b36a50f81f802e1cea830e14a76760e202a30b Mon Sep 17 00:00:00 2001 From: J Pipkin Date: Wed, 9 Jan 2013 23:11:19 -0600 Subject: split sboupgrade from sboinstall --- SBO-Lib/lib/SBO/Lib.pm | 194 +++++++++++++++++++++++- man1/sboinstall.1 | 2 +- man1/sboupgrade.1 | 15 -- sboinstall | 120 +++++++++++++-- sboupgrade | 389 ++++++++++++++----------------------------------- 5 files changed, 405 insertions(+), 315 deletions(-) diff --git a/SBO-Lib/lib/SBO/Lib.pm b/SBO-Lib/lib/SBO/Lib.pm index 653eee2..fe61f70 100644 --- a/SBO-Lib/lib/SBO/Lib.pm +++ b/SBO-Lib/lib/SBO/Lib.pm @@ -44,6 +44,14 @@ our @EXPORT = qw( merge_queues get_installed_cpans check_distfiles + get_user_group + ask_user_group + get_opts + ask_opts + user_prompt + process_sbos + print_failures + usage_error $tempdir $conf_dir $conf_file @@ -62,6 +70,11 @@ use File::Find; use File::Basename; use Fcntl qw(F_SETFD F_GETFD); +# define error statuses +use constant { + _ERR_USAGE => 1, +}; + our $tempdir = tempdir(CLEANUP => 1); # define this to facilitate unit testing - should only ever be modified from @@ -74,6 +87,12 @@ sub script_error(;$) { : die "A fatal script error has occurred. Exiting.\n"; } +# subroutine for usage errors +sub usage_error($) { + warn shift ."\n"; + exit _ERR_USAGE; +} + # sub for opening files, second arg is like '<','>', etc sub open_fh { exists $_[1] or script_error 'open_fh requires two arguments'; @@ -214,7 +233,7 @@ sub get_installed_packages($) { my ($name, $version, $build) = ($path =~ $regex)[0,1,2]; # valid types: STD, SBO my $type = 'STD'; - if ($build =~ m/_SBo*/) { + if ($build =~ m/_SBo(|compat32)$/) { my $sbo = $name; $sbo =~ s/-compat32//g if $name =~ /-compat32$/; $type = 'SBO' if get_sbo_location($sbo); @@ -674,7 +693,6 @@ sub perform_sbo { # set any changes we need to make to the .SlackBuild, setup the command $cmd = '( '; - $args{JOBS} = 0 if $args{JOBS} eq 'FALSE'; if ($args{ARCH} eq 'x86_64' and ($args{C32} || $args{X32})) { if ($args{C32}) { @@ -737,7 +755,6 @@ sub do_slackbuild { JOBS => 0, LOCATION => '', COMPAT32 => 0, - SYMLINKS => '', @_ ); $args{LOCATION} or script_error 'do_slackbuild requires LOCATION.'; @@ -770,7 +787,6 @@ sub do_slackbuild { X32 => $x32, ); $pkg = do_convertpkg $pkg if $args{COMPAT32}; - unlink $_ for @{$args{SYMLINKS}}; return $version, $pkg, $src; } @@ -922,3 +938,173 @@ sub get_installed_cpans() { # $cpans{$mods[$_]} = $vers[$_] for keys @mods; # return \%cpans; } + +# look for any (user|group)add commands in the README +sub get_user_group($) { + exists $_[0] or script_error 'get_user_group requires an argument'; + my $readme = shift; + my @cmds = $readme =~ /^\s*#*\s*(useradd.*|groupadd.*)/mg; + return \@cmds; +} + +# offer to run any user/group add commands +sub ask_user_group { + exists $_[1] or script_error 'ask_user_group requires two arguments'; + my ($cmds, $readme) = @_; + say "\n". $readme; + print "\nIt looks like this slackbuild requires the following"; + say ' command(s) to be run first:'; + say " # $_" for @$cmds; + print 'Shall I run them prior to building? [y] '; + return =~ /^[Yy\n]/ ? $cmds : undef; +} + +# see if the README mentions any options +sub get_opts($) { + exists $_[0] or script_error 'get_opts requires an argument'; + my $readme = shift; + return $readme =~ /[A-Z0-9]+=[^\s]/ ? 1 : undef; +} + +# provide an opportunity to set options +sub ask_opts { + exists $_[0] or script_error 'ask_opts requires an argument'; + my ($sbo, $readme) = @_; + say "\n". $readme; + print "\nIt looks like $sbo has options; would you like to set any"; + print ' when the slackbuild is run? [n] '; + if ( =~ /^[Yy]/) { + my $ask = sub() { + print "\nPlease supply any options here, or enter to skip: "; + chomp(my $opts = ); + return if $opts =~ /^\n/; + return $opts; + }; + my $kv_regex = qr/[A-Z0-9]+=[^\s]+(|\s([A-Z]+=[^\s]+){0,})/; + my $opts = &$ask; + return unless $opts; + while ($opts !~ $kv_regex) { + warn "Invalid input received.\n"; + $opts = &$ask; + } + return $opts; + } + return; +} + +# for a given sbo, check for cmds/opts, prompt the user as appropriate +sub user_prompt { + exists $_[1] or script_error 'user_prompt requires two arguments.'; + my ($sbo, $location) = @_; + my $readme = get_readme_contents $location; + # check for user/group add commands, offer to run any found + my $user_group = get_user_group $readme; + my $cmds; + $cmds = ask_user_group($user_group, $readme) if $$user_group[0]; + # check for options mentioned in the README + my $opts = 0; + $opts = ask_opts($sbo, $readme) if get_opts $readme; + print "\n". $readme unless $opts; + print "\nProceed with $sbo? [y]: "; + # we have to return something substantial if the user says no so that we + # can check the value of $cmds on the calling side. we should be able to + # assume that 'N' will never be a valid command to run. + return 'N' unless =~ /^[Yy\n]/; + return $cmds, $opts; +} + +# do the things with the provided sbos - whether upgrades or new installs. +sub process_sbos { + my %args = ( + TODO => '', + CMDS => '', + OPTS => '', + JOBS => 'FALSE', + LOCATIONS => '', + NOINSTALL => 0, + NOCLEAN => 'FALSE', + DISTCLEAN => 'FALSE', + @_ + ); + my $todo = $args{TODO}; + my $cmds = $args{CMDS}; + my $opts = $args{OPTS}; + my $locs = $args{LOCATIONS}; + my $jobs = $args{JOBS} =~ /^\d+$/ ? $args{JOBS} : 0; + exists $$todo[0] or script_error 'process_sbos requires TODO.'; + my (%failures, @symlinks, $temp_syms); + for my $sbo (@$todo) { + my $compat32 = $sbo =~ /-compat32$/ ? 1 : 0; + eval { $temp_syms = check_distfiles( + LOCATION => $$locs{$sbo}, COMPAT32 => $compat32 + ); }; + $failures{$sbo} = $@ if $@; + push @symlinks, @$temp_syms; + } + # return now if we were unable to download/verify everything - might want + # to not do this. not sure. + if (keys %failures > 0) { + unlink for @symlinks; + return \%failures; + } + for my $sbo (@$todo) { + my $options = 0; + $options = $$opts{$sbo} if defined $$opts{$sbo}; + my $cmds = $$cmds{$sbo} if defined $$cmds{$sbo}; + for my $cmd (@$cmds) { + system($cmd) == 0 or warn "\"$cmd\" exited non-zero\n"; + } + # switch compat32 on if upgrading/installing a -compat32 + # else make sure compat32 is off + my $compat32 = $sbo =~ /-compat32$/ ? 1 : 0; + my ($version, $pkg, $src); + eval { ($version, $pkg, $src) = do_slackbuild( + OPTS => $options, + JOBS => $jobs, + LOCATION => $$locs{$sbo}, + COMPAT32 => $compat32, + ); }; + if ($@) { + $failures{$sbo} = $@; + } else { + do_upgradepkg $pkg unless $args{NOINSTALL}; + + unless ($args{DISTCLEAN}) { + make_clean(SBO => $sbo, SRC => $src, VERSION => $version) + unless $args{NOCLEAN}; + } else { + make_distclean( + SBO => $sbo, + SRC => $src, + VERSION => $version, + LOCATION => $$locs{$sbo}, + ); + } + # move package to $config{PKG_DIR} if defined + unless ($config{PKG_DIR} eq 'FALSE') { + my $dir = $config{PKG_DIR}; + unless (-d $dir) { + mkdir($dir) or warn "Unable to create $dir\n"; + } + if (-d $dir) { + move($pkg, $dir), say "$pkg stored in $dir"; + } else { + warn "$pkg left in /tmp\n"; + } + } elsif ($args{DISTCLEAN}) { + unlink $pkg; + } + } + } + unlink for @symlinks; + return \%failures; +} + +# subroutine to print out failures +sub print_failures { + if (exists $_[0]) { + my $failures = shift; + say 'Failures:'; + say " $_: $$failures{$_}" for keys %$failures; + } +} diff --git a/man1/sboinstall.1 b/man1/sboinstall.1 index 673a24c..819f9bc 100644 --- a/man1/sboinstall.1 +++ b/man1/sboinstall.1 @@ -7,7 +7,7 @@ sboinstall - install slackbuilds sboinstall [-h|-v] [-d TRUE|FALSE] [-j #|FALSE] [-c TRUE|FALSE] [-NrRip] sbo_name (sbo_name) .SH DESCRIPTION .P -sboinstall is equivalent to sboupgrade -N, but is faster since it only installs new slackbuilds, so is preferred for installs. If the -r flag is NOT specified, sboinstall will pull the list of requirements from the .info file for any specified slackbuild. If such a list exists, sboinstall will look to see whether or not those requirements are already installed, and if not, it will ask whether or not it should attempt to install them first. This is recursive, so that ordering happens correctly. sboinstall will refuse to handle circular requirements. sboinstall will also note groupadd and useradd commands in README files and offer to run those first. If the README documents options of the KEY=value form, sboinstall will offer the opportunity to set options. +sboinstall is used to install SBos. If the -r flag is NOT specified, sboinstall will pull the list of requirements from the .info file for any specified slackbuild. If such a list exists, sboinstall will look to see whether or not those requirements are already installed, and if not, it will ask whether or not it should attempt to install them first. This is recursive, so that ordering happens correctly. sboinstall will refuse to handle circular requirements. sboinstall will attempt to note groupadd and useradd commands in README files and offer to run those first. If the README appears to document options of the KEY=value form, sboinstall will offer the opportunity to set options. .SH OPTIONS .P -h|--help diff --git a/man1/sboupgrade.1 b/man1/sboupgrade.1 index c5966fd..4dfeeb0 100644 --- a/man1/sboupgrade.1 +++ b/man1/sboupgrade.1 @@ -45,30 +45,15 @@ Do not actually install the package created at the end of the build process. So, If numeric (2,5,10, etc), then that number will be fed to the "-j" argument to make when a slackbuild which invokes "make" is run. This only makes sense on multicore systems, where one might set the JOBS to the number of available cores, or half that number, etc. .RE .P --N|--installnew -.RS -Install any new slackbuilds specified. So, if you want to upgrade some things and install new things with the same command, then you would use the -N flag. Note that upgrades are handled prior to new installs. -.RE -.P -r|--nointeractive .RS Skip viewing of the README and the yes or no question which accompanies it. Anytime sboupgrade is run, the first thing the command will attempt to do is show you the README for a given slackbuild and ask whether or not you wish to proceed; this option skips the README and bypasses the question. If multiple slackbuilds are specified, this option bypasses them all. .RE .P --R|--norequirements -.RS -This option causes sboupgrade to skip requirement handling, but still show the README and prompt the user to proceed. -.RE -.P -z|--force-reqs .RS When used in combination with the -f option, to force an update even if it would not constitute an update, this will cause sboupgrade to also rebuild all of that slackbuild's requirements. Normally with -f, only the slackbuild(s) specified, and any requirements not already installed, will be rebuilt. This allows for recursive upgrades, among other things. .RE -.P --z|--force-reqs -.RS -When used in combination with the -f option, to force an update even if it would not constitute an update, this will cause sboupgrade to also rebuild all of that slackbuild's requirements that it can grok. Normally with -f, only the slackbuild(s) specified, and any requirements not already installed, will be rebuilt. This allows for recursive upgrades, among other things. -.RE .SH BUGS .P None known, but there may be some. Please report any found to j@dawnrazor.net or xocel@iquidus.org; patches are always welcome. diff --git a/sboinstall b/sboinstall index bd05025..fe9c3ef 100755 --- a/sboinstall +++ b/sboinstall @@ -3,10 +3,10 @@ # vim: set ts=4:noet # # sboinstall -# script to install a SlackBuild by name +# script to install (a) SlackBuild(s) by name # -# authors: Jacob Pipkin -# Luke Williams +# authors: Jacob Pipkin +# Luke Williams # license: WTFPL use 5.16.0; @@ -69,15 +69,109 @@ show_usage and exit 0 unless exists $ARGV[0]; $noclean = $noclean eq 'TRUE' ? 1 : 0; $distclean = $distclean eq 'TRUE' ? 1 : 0; -# setup any options -unshift @ARGV, $noclean ? '-cTRUE' : '-cFALSE'; -unshift @ARGV, $distclean ? '-dTRUE' : '-dFALSE'; -unshift @ARGV, '-i' if $no_install; -unshift @ARGV, '-p' if $compat32; -unshift @ARGV, '-r' if $non_int; -unshift @ARGV, '-R' if $no_reqs; -unshift @ARGV, "-j$jobs" if $jobs; +if ($jobs) { + usage_error "You have provided an invalid value for -j|--jobs" + unless ($jobs =~ /^\d+$/ || $jobs eq 'FALSE'); +} + +if ($compat32) { + usage_error "compat32 only works on x86_64." unless get_arch eq 'x86_64'; +} + +# if we can't find SLACKBUILDS.TXT in $config{HOME}, prompt to fetch the tree +slackbuilds_or_fetch; -system '/usr/sbin/sboupgrade', '-oN', @ARGV; +my (%warnings, $build_queue, %locations); + +if ($no_reqs or $non_int) { + $build_queue = \@ARGV; +} else { + for my $sbo (@ARGV) { + my $queue = get_build_queue([$sbo], \%warnings); + $build_queue = merge_queues($build_queue, $queue); + } +} + +# populate %locations and sanity check +$locations = get_sbo_location($build_queue); +for my $sbo (@$build_queue) { + usage_error "Unable to locate $sbo in the SlackBuilds.org tree." unless + defined $locations{$sbo}; + if ($compat32) { + usage_error "-p|--compat32 is not supported with Perl SBos." + if $locations{$sbo} =~ qr|/perl/[^/]+$|; + } +} + +# get lists of installed packages and perl modules from CPAN +my $inst_names = get_inst_names(get_installed_packages 'ALL'); +my $pms = get_installed_cpans; +s/::/-/g for @$pms; + +# check for already-installeds and prompt for the rest +my (@temp_queue, %commands, %options); +my $added = ' added to install queue.'; +FIRST: for my $sbo (@$build_queue) { + my $name = $compat32 ? "$sbo-compat32" : $sbo; + if ($name ~~ @$inst_names) { + say "$name already installed."; + next FIRST; + } else { + my $pm_name = $sbo; + $pm_name =~ s/^perl-//; + if (/$pm_name/i ~~ @$pms) { + say "$sbo installed via the cpan."; + next FIRST; + } + } + $locations{$name} = get_sbo_location($sbo) if $compat32; + unless ($non_int) { + # if compat32 is TRUE, we need to see if the non-compat version exists. + if ($compat32) { + unless ($sbo ~~ @$inst_names) { + say "$name requires $sbo."; + my ($cmds, $opts) = user_prompt($sbo, $locations{$sbo}); + if ($cmds) { + next FIRST if $cmds eq 'N'; + } + push(@temp_queue, $sbo); + $commands{$sbo} = $cmds; + $options{$sbo} = $cmds; + say "$sbo$added"; + } + } + my ($cmds, $opts) = user_prompt($name, $locations{$name}); + if ($cmds) { + next FIRST if $cmds eq 'N'; + } + push(@temp_queue, $name); + $commands{$sbo} = $cmds; + $options{$sbo} = $opts; + say "$name$added"; + } else { + push(@temp_queue, $sbo); + say "\n$name$added"; + } +} +@$build_queue = @temp_queue; + +exit 0 unless exists $$build_queue[0]; +say "\nInstall queue: " . join(' ', @$build_queue); +unless ($non_int) { + print "\nAre you sure you wish to continue? [y]: "; + exit 0 unless =~ /^[Yy\n]/; +} + +my %failures = process_sbos( + TODO => $build_queue, + CMDS => \%commands, + OPTS => \%options, + JOBS => $jobs, + LOCATIONS => \%locations, + NOINSTALL => $no_install, + NOCLEAN => $noclean, + DISTCLEAN => $distclean, +); +print_failures(%failures); -exit 0; +exit keys %failures > 0 ? 1 : 0; diff --git a/sboupgrade b/sboupgrade index 52e09d8..c1f242d 100755 --- a/sboupgrade +++ b/sboupgrade @@ -2,8 +2,8 @@ # # vim: set ts=4:noet # -# sboinstall -# script to install a SlackBuild by name +# sboupgrade +# script to upgrade (a) SlackBuild(s) by name # # authors: Jacob Pipkin # Luke Williams @@ -38,12 +38,8 @@ Options (defaults shown first where applicable): do not run installpkg at the end of the build process. -j|--jobs (FALSE|#): specify "-j" setting to make, for multicore systems; overrides conf file. - -N|--installnew: - install any new SBo's listed. -r|--nointeractive: non-interactive; skips README and all prompts. - -R|--norequirements: - view the README but do not handle requirements, commands, or options. -z|--force-reqs: when used with -f, will force rebuilding an SBo's requirements as well. @@ -53,8 +49,9 @@ EOF my $noclean = $config{NOCLEAN}; my $distclean = $config{DISTCLEAN}; my $jobs = $config{JOBS}; -my ($help, $vers, $force, $no_install, $install_new, $non_int, $no_reqs, - $force_reqs, $only_new, $compat32); +my ($help, $vers, $force, $no_install, $non_int, $force_reqs); +# backwards compatibility options +my ($install_new, $no_reqs, $compat32); GetOptions( 'help|h' => \$help, @@ -64,212 +61,82 @@ GetOptions( 'force|f' => \$force, 'noinstall|i' => \$no_install, 'jobs|j=s' => \$jobs, - 'installnew|N' => \$install_new, + 'installnew|N' => \$install_new, 'nointeractive|r' => \$non_int, 'norequirements|R' => \$no_reqs, 'force-reqs|z' => \$force_reqs, - 'only-new|o' => \$only_new, - 'compat32|p' => \$compat32, + 'compat32|p' => \$compat32, ); show_usage and exit 0 if $help; show_version and exit 0 if $vers; show_usage and exit 1 unless exists $ARGV[0]; -say "Invalid arguments: --force-reqs and --installnew can not be used together." - and exit 0 if $force_reqs and $install_new; $noclean = $noclean eq 'TRUE' ? 1 : 0; $distclean = $distclean eq 'TRUE' ? 1 : 0; if ($jobs) { - die "You have provided an invalid value for -j\n" + usage_error "You have provided an invalid value for -j|--jobs" unless ($jobs =~ /^\d+$/ || $jobs eq 'FALSE'); } -if ($compat32) { - die "compat32 only works on x86_64.\n" unless get_arch eq 'x86_64'; - die "-p|--compat32 requires -N|--installnew\n" unless $install_new; -} +usage_error "-r|--nointeractive and -z|--force-reqs can not be used together." + if $non_int && $force_reqs; +usage_error "-R|--norequirements does not make sense without -N|--installnew" + if $no_reqs && ! $install_new; +usage_error "-p|--compat32 does not make sense without -N|--installnew" + if $compat32 && ! $install_new; # if we can't find SLACKBUILDS.TXT in $config{HOME}, prompt to fetch the tree slackbuilds_or_fetch; -my %warnings; -my %options; -my $build_queue; -my %commands; -my %locations; +my @sbos = @ARGV; -if ($no_reqs or $non_int) { - $build_queue = \@ARGV; -} else { - for my $sbo (@ARGV) { - my $queue = get_build_queue([$sbo], \%warnings); - $build_queue = merge_queues($build_queue, $queue); - } -} -# p7zip fmodapi eawpats TiMidity++ zdoom OpenAL bsnes jdk DevIL spring -for my $sbo (@$build_queue) { - $locations{$sbo} = get_sbo_location($sbo); - die "Unable to locate $sbo in the SlackBuilds.org tree.\n" unless +# pull locations for everything specified on command line. +my %locations; +for my $sbo (@sbos) { + my $name = $sbo; + $name =~ s/-compat32//; + $locations{$sbo} = get_sbo_location($name); + usage_error "Unable to locate $sbo in the SlackBuilds.org tree." unless defined $locations{$sbo}; -} - -# look for any (user|group)add commands in the README -sub get_user_group($) { - exists $_[0] or script_error 'get_user_group requires an argument'; - my $readme = shift; - my @cmds = $readme =~ /^\s*#*\s*(useradd.*|groupadd.*)/mg; - return \@cmds; -} - -# offer to run any user/group add commands -sub ask_user_group { - exists $_[1] or script_error 'ask_user_group requires two arguments'; - my ($cmds, $readme) = @_; - say "\n". $readme; - print "\nIt looks like this slackbuild requires the following"; - say ' command(s) to be run first:'; - say " # $_" for @$cmds; - print 'Shall I run them prior to building? [y] '; - return =~ /^[Yy\n]/ ? $cmds : undef; -} - -# see if the README mentions any options -sub get_opts($) { - exists $_[0] or script_error 'get_opts requires an argument'; - my $readme = shift; - return $readme =~ /[A-Z0-9]+=[^\s]/ ? 1 : undef; -} - -# provide an opportunity to set options -sub ask_opts { - exists $_[0] or script_error 'ask_opts requires an argument'; - my ($sbo, $readme) = @_; - say "\n". $readme; - print "\nIt looks like $sbo has options; would you like to set any"; - print ' when the slackbuild is run? [n] '; - if ( =~ /^[Yy]/) { - my $ask = sub() { - print "\nPlease supply any options here, or enter to skip: "; - chomp(my $opts = ); - return if $opts =~ /^\n/; - return $opts; - }; - my $kv_regex = qr/[A-Z0-9]+=[^\s]+(|\s([A-Z]+=[^\s]+){0,})/; - my $opts = &$ask; - return unless $opts; - while ($opts !~ $kv_regex) { - warn "Invalid input received.\n"; - $opts = &$ask; - } - return $opts; - } - return; -} - -sub user_prompt { - exists $_[1] or script_error 'user_prompt requires two arguments.'; - my ($sbo, $location) = @_; - my $readme = get_readme_contents $location; - - # check for user/group add commands, offer to run any found - my $user_group = get_user_group $readme; - my $cmds; - $cmds = ask_user_group($user_group, $readme) if $$user_group[0]; - $commands{$sbo} = $cmds if defined $cmds; - # check for options mentioned in the README - my $opts = 0; - $opts = ask_opts($sbo, $readme) if get_opts $readme; - print "\n". $readme unless $opts; - $options{$sbo} = $opts if $opts; - - print "\nProceed with $sbo? [y]: "; - return 0 unless =~ /^[Yy\n]/; - return 1; -} - -# do the things with the provided sbos - whether upgrades or new installs. -sub process_sbos($) { - exists $_[0] or script_error 'process_sbos requires an argument.'; - my $todo = shift; - my %failures; - my %symlinks; - for my $sbo (@$todo) { - $compat32 = $sbo =~ /-compat32$/ ? 1 : 0; - eval { $symlinks{$sbo} = check_distfiles( - LOCATION => $locations{$sbo}, COMPAT32 => $compat32 - ); }; - $failures{$sbo} = $@ if $@; + if ($sbo =~ /-compat32$/) { + usage_error "compat32 Perl SBos are not supported." + if $locations{$sbo} =~ qr|/perl/[^/]+$|; } - return %failures if keys %failures > 0; - for my $sbo (@$todo) { - my $opts = 0; - $opts = $options{$sbo} if defined $options{$sbo}; - my $cmds = $commands{$sbo} if defined $commands{$sbo}; - for my $cmd (@$cmds) { - system($cmd) == 0 or warn "\"$cmd\" exited non-zero\n"; - } - # switch compat32 on if upgrading a -compat32 - # else make sure compat32 is off - $compat32 = $sbo =~ /-compat32$/ ? 1 : 0; - my ($version, $pkg, $src); - eval { ($version, $pkg, $src) = do_slackbuild( - OPTS => $opts, - JOBS => $jobs, - LOCATION => $locations{$sbo}, - COMPAT32 => $compat32, - SYMLINKS => $symlinks{$sbo}, - ); }; - if ($@) { - $failures{$sbo} = $@; - } else { - do_upgradepkg $pkg unless $no_install; - - unless ($distclean) { - make_clean(SBO => $sbo, SRC => $src, VERSION => $version) - unless $noclean; - } else { - make_distclean( - SBO => $sbo, - SRC => $src, - VERSION => $version, - LOCATION => $locations{$sbo}, - ); - } - # move package to $config{PKG_DIR} if defined - unless ($config{PKG_DIR} eq 'FALSE') { - my $dir = $config{PKG_DIR}; - unless (-d $dir) { - mkdir($dir) or warn "Unable to create $dir\n"; - } - if (-d $dir) { - move($pkg, $dir), say "$pkg stored in $dir"; - } else { - warn "$pkg left in /tmp\n"; - } - } elsif ($distclean) { - unlink $pkg; - } - } - } - return %failures; } -sub print_failures { - if (exists $_[0]) { - my %failures = @_; - say 'Failures:'; - say " $_: $failures{$_}" for keys %failures; - } +# get a list of installed SBos to check upgradability against +my $inst_names = get_inst_names(get_installed_packages 'SBO'); + +# backwards compatibility +if ($install_new) { + # warn about future removal and pause for five seconds - which hopefully + # might encourage the user to read and take note of the warning. + warn "-N is deprecated and will disappear in a future release.\n"; + select((select(STDOUT), $| = 1)[0]); + print("."), sleep 1 for 1..5; + say ''; + $| = 0; + for my $sbo (@sbos) { + my $name = $sbo; + $name =~ s/$/-compat32/ if $compat32 && $sbo !~ /-compat32$/; + unless ($name ~~ @$inst_names) { + my @args = ('/usr/sbin/sboinstall'); + push @args, $noclean ? '-cTRUE' : '-cFALSE'; + push @args, $distclean ? '-dTRUE' : '-dFALSE'; + push @args, '-R' if $no_reqs; + push @args, '-p' if $compat32; + push @args, '-i' if $no_install; + push @args, '-r' if $non_int; + push @args, '-R' if $no_reqs; + push @args, "-j$jobs" if $jobs; + system(@args, $sbo); + } + } } -my $inst_names = get_inst_names(get_installed_packages 'ALL'); my $upgrade_queue; -@$upgrade_queue = (); -# deal with any updates prior to any new installs. -# no reason to bother if only_new is specified, ie running from sboinstall. -goto INSTALL_NEW if $only_new; # doesn't matter what's updatable and what's not if force is specified my @updates unless $force; @@ -280,124 +147,82 @@ unless ($force) { # but without force, we only want to update what there are updates for unless ($force) { - for my $sbo (@$build_queue) { + for my $sbo (@sbos) { push @$upgrade_queue, $sbo if $sbo ~~ @updates; } } else { - if ($force_reqs) { - for my $sbo (@$build_queue) { - push @$upgrade_queue, $sbo if $sbo ~~ @$inst_names; + if ($force_reqs && ! $non_int) { + my $temp_queue; + for my $sbo (@sbos) { + my $name = $sbo; + $name =~ s/-compat32$//; + my $queue = get_build_queue([$name], my $warnings); + my $queue2; + for my $item (@$queue) { + push @$queue2, $item if $item ~~ @$inst_names; + } + $queue = $queue2; + my $cqueue; + # get locations for all the things + my %locs = get_sbo_location($queue); + my %clocs; + # -compat32-ify the queue and locations if appropriate + if ($sbo =~ /-compat32$/) { + $cqueue = $queue; + s/$/-compat32/g for @$cqueue; + $queue = $cqueue; + while (my ($key, $val) = each %locs) { + $key =~ s/$/-compat32/; + $clocs{$key} = $val; + } + %locs = %clocs; + } + @locations{keys %locs} = values %locs; + $temp_queue = merge_queues($temp_queue, $queue); } + $upgrade_queue = $temp_queue; } else { - for my $sbo (@ARGV) { + for my $sbo (@sbos) { push @$upgrade_queue, $sbo if $sbo ~~ @$inst_names; } } } # Get user input regarding upgrades -my @temp_queue; -for my $sbo (@$upgrade_queue) { - unless ($non_int) { - if (user_prompt($sbo, $locations{$sbo})) { - push(@temp_queue, $sbo); - say "$sbo added to upgrade queue."; - } else { - say "skipping $sbo."; - } - } else { - push(@temp_queue, $sbo); - say "\n$sbo added to upgrade queue."; - } -} - -# Remove upgrades from build queue +my (@temp_queue, %commands, %options); FIRST: for my $sbo (@$upgrade_queue) { - if ($sbo ~~ @$build_queue) { - my $count = 0; - SECOND: for my $i (@$build_queue) { - if ($i eq $sbo) { - splice(@$build_queue, $count, 1); - last SECOND; - } - $count++; - } - } -} -@$upgrade_queue = @temp_queue; - -INSTALL_NEW: -goto BEGIN_BUILD unless $install_new; - -my $pms = get_installed_cpans; -s/::/-/g for @$pms; - -@temp_queue = (); -FIRST: for my $sbo (@$build_queue) { - my $name = $compat32 ? "$sbo-compat32" : $sbo; - if ($name ~~ @$inst_names) { - say "$name already installed." unless $force; - next FIRST; - } else { - my $pm_name = $name; - $pm_name =~ s/^perl-//g; - if (/$pm_name/i ~~ @$pms) { - say "$name installed via the cpan." unless $force; - next FIRST; - } - } - $locations{$name} = get_sbo_location($sbo) if $compat32; unless ($non_int) { - # if compat32 is TRUE, we need to see if the non-compat version exists. - if ($compat32) { - unless ($sbo ~~ @$inst_names or $sbo ~~ @$upgrade_queue) { - if (user_prompt($sbo, $locations{$sbo})){ - push(@temp_queue, $sbo); - say "$sbo added to install queue."; - } else { - last FIRST; - } - } - } - if (user_prompt($name, $locations{$name})) { - push(@temp_queue, $name); - say "$name added to install queue."; - } else { - last FIRST; - } + my ($cmds, $opts) = user_prompt($sbo, $locations{$sbo}); + if ($cmds) { + next FIRST if $cmds eq 'N'; + } + push(@temp_queue, $sbo); + $commands{$sbo} = $cmds; + $options{$sbo} = $opts; + say "$sbo added to upgrade queue."; } else { push(@temp_queue, $sbo); - say "\n$name added to build queue."; + say "\n$sbo added to upgrade queue."; } } -@$build_queue = @temp_queue; -BEGIN_BUILD: -@$build_queue = () unless $install_new; -exit 0 unless @$upgrade_queue or @$build_queue; -print "\n"; -say "Upgrade queue: " . join(' ', @$upgrade_queue) if exists $$upgrade_queue[0]; -say "Install queue: " . join(' ', @$build_queue) if exists $$build_queue[0]; +exit 0 unless exists $$upgrade_queue[0]; +say "\nUpgrade queue: ". join(' ', @$upgrade_queue); unless ($non_int) { print "\nAre you sure you wish to continue? [y]: "; exit 0 unless =~ /^[Yy\n]/; } -my %failures; -if ( $force and ! $force_reqs) { - # Install missing reqs then rebuild sbo's - %failures = process_sbos $build_queue if exists $$build_queue[0]; - print_failures(%failures); - - %failures = process_sbos $upgrade_queue if exists $$upgrade_queue[0]; - print_failures(%failures); -} else { - # Upgrade any installed reqs/sbo's then build missing reqs/sbo's - %failures = process_sbos $upgrade_queue if exists $$upgrade_queue[0]; - print_failures(%failures); - - %failures = process_sbos $build_queue if exists $$build_queue[0]; - print_failures(%failures); -} +my %failures = process_sbos( + TODO => $upgrade_queue, + CMDS => \%commands, + OPTS => \%options, + JOBS => $jobs, + LOCATIONS => \%locations, + NOINSTALL => $no_install, + NOCLEAN => $noclean, + DISTCLEAN => $distclean, +); +print_failures(%failures); exit keys %failures > 0 ? 1 : 0; -- cgit v1.2.3 From 3673d4d416b509032daa7e1483bc24daa32ff3d4 Mon Sep 17 00:00:00 2001 From: xocel Date: Fri, 11 Jan 2013 16:11:11 +1300 Subject: %failures now declared as , sboinstall line 96: changed to %locations --- sboinstall | 8 ++++---- sboupgrade | 6 +++--- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/sboinstall b/sboinstall index fe9c3ef..a441c08 100755 --- a/sboinstall +++ b/sboinstall @@ -93,7 +93,7 @@ if ($no_reqs or $non_int) { } # populate %locations and sanity check -$locations = get_sbo_location($build_queue); +%locations = get_sbo_location($build_queue); for my $sbo (@$build_queue) { usage_error "Unable to locate $sbo in the SlackBuilds.org tree." unless defined $locations{$sbo}; @@ -162,7 +162,7 @@ unless ($non_int) { exit 0 unless =~ /^[Yy\n]/; } -my %failures = process_sbos( +my $failures = process_sbos( TODO => $build_queue, CMDS => \%commands, OPTS => \%options, @@ -172,6 +172,6 @@ my %failures = process_sbos( NOCLEAN => $noclean, DISTCLEAN => $distclean, ); -print_failures(%failures); +print_failures(%$failures); -exit keys %failures > 0 ? 1 : 0; +exit keys %$failures > 0 ? 1 : 0; diff --git a/sboupgrade b/sboupgrade index c1f242d..695d247 100755 --- a/sboupgrade +++ b/sboupgrade @@ -213,7 +213,7 @@ unless ($non_int) { exit 0 unless =~ /^[Yy\n]/; } -my %failures = process_sbos( +my $failures = process_sbos( TODO => $upgrade_queue, CMDS => \%commands, OPTS => \%options, @@ -223,6 +223,6 @@ my %failures = process_sbos( NOCLEAN => $noclean, DISTCLEAN => $distclean, ); -print_failures(%failures); +print_failures(%$failures); -exit keys %failures > 0 ? 1 : 0; +exit keys %$failures > 0 ? 1 : 0; -- cgit v1.2.3 From 705b5eadaf1126b135f3d5f3cc9569014462c9fb Mon Sep 17 00:00:00 2001 From: J Pipkin Date: Thu, 10 Jan 2013 22:26:47 -0600 Subject: This reverts commit 3673d4d416b509032daa7e1483bc24daa32ff3d4. it will be easier to be consistent with passing refs for arrays and hashes, so we'll fix it that way instead. --- sboinstall | 8 ++++---- sboupgrade | 6 +++--- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/sboinstall b/sboinstall index a441c08..fe9c3ef 100755 --- a/sboinstall +++ b/sboinstall @@ -93,7 +93,7 @@ if ($no_reqs or $non_int) { } # populate %locations and sanity check -%locations = get_sbo_location($build_queue); +$locations = get_sbo_location($build_queue); for my $sbo (@$build_queue) { usage_error "Unable to locate $sbo in the SlackBuilds.org tree." unless defined $locations{$sbo}; @@ -162,7 +162,7 @@ unless ($non_int) { exit 0 unless =~ /^[Yy\n]/; } -my $failures = process_sbos( +my %failures = process_sbos( TODO => $build_queue, CMDS => \%commands, OPTS => \%options, @@ -172,6 +172,6 @@ my $failures = process_sbos( NOCLEAN => $noclean, DISTCLEAN => $distclean, ); -print_failures(%$failures); +print_failures(%failures); -exit keys %$failures > 0 ? 1 : 0; +exit keys %failures > 0 ? 1 : 0; diff --git a/sboupgrade b/sboupgrade index 695d247..c1f242d 100755 --- a/sboupgrade +++ b/sboupgrade @@ -213,7 +213,7 @@ unless ($non_int) { exit 0 unless =~ /^[Yy\n]/; } -my $failures = process_sbos( +my %failures = process_sbos( TODO => $upgrade_queue, CMDS => \%commands, OPTS => \%options, @@ -223,6 +223,6 @@ my $failures = process_sbos( NOCLEAN => $noclean, DISTCLEAN => $distclean, ); -print_failures(%$failures); +print_failures(%failures); -exit keys %$failures > 0 ? 1 : 0; +exit keys %failures > 0 ? 1 : 0; -- cgit v1.2.3 From 76df5fd14186ca2492274f348f8f0be8d5e7bad6 Mon Sep 17 00:00:00 2001 From: J Pipkin Date: Thu, 10 Jan 2013 23:09:30 -0600 Subject: fix reference passing stuff, fix print_failures(), fix bug pushing empty list which caused sboupgrade/install to die instead of printing failures at the download/verify stage, remove old get_installed_sbos() --- SBO-Lib/lib/SBO/Lib.pm | 57 ++++++++++++++++++++++---------------------------- sboinstall | 8 +++---- sboupgrade | 6 +++--- t/test.t | 28 ++++++++++++------------- 4 files changed, 46 insertions(+), 53 deletions(-) diff --git a/SBO-Lib/lib/SBO/Lib.pm b/SBO-Lib/lib/SBO/Lib.pm index fe61f70..c249793 100644 --- a/SBO-Lib/lib/SBO/Lib.pm +++ b/SBO-Lib/lib/SBO/Lib.pm @@ -245,19 +245,6 @@ sub get_installed_packages($) { return \@installed; } -# pull an array of hashes, each hash containing the name and version of an sbo -# currently installed. -# sub get_installed_sbos() { -# my @installed; -# # $1 == name, $2 == version -# my $regex = qr#/([^/]+)-([^-]+)-[^-]+-[^-]+$#; -# for my $path (<$pkg_db/*_SBo>) { -# my ($name, $version) = ($path =~ $regex)[0,1]; -# push @installed, {name => $name, version => $version}; -# } -# return \@installed; -# } - # for a ref to an array of hashes of installed packages, return an array ref # consisting of just their names sub get_inst_names($) { @@ -393,7 +380,7 @@ sub get_download_info { $md5s = get_from_info(LOCATION => $args{LOCATION}, GET => $get); return unless $$md5s[0]; $return{$$downs[$_]} = $$md5s[$_] for (keys @$downs); - return %return; + return \%return; } sub get_arch() { @@ -412,14 +399,14 @@ sub get_sbo_downloads { my $location = $args{LOCATION}; -d $location or script_error 'get_sbo_downloads given a non-directory.'; my $arch = get_arch; - my %dl_info; + my $dl_info; if ($arch eq 'x86_64') { - %dl_info = get_download_info(LOCATION => $location) unless $args{32}; + $dl_info = get_download_info(LOCATION => $location) unless $args{32}; } - unless (keys %dl_info > 0) { - %dl_info = get_download_info(LOCATION => $location, X64 => 0); + unless (keys %$dl_info > 0) { + $dl_info = get_download_info(LOCATION => $location, X64 => 0); } - return %dl_info; + return $dl_info; } # given a link, grab the filename from it and prepend $distfiles @@ -549,11 +536,11 @@ sub rewrite_slackbuild { # that the 32-bit source is untarred if ($args{C32}) { my $location = get_sbo_location($args{SBO}); - my %downloads = get_sbo_downloads( + my $downloads = get_sbo_downloads( LOCATION => $location, 32 => 1, ); - my $fns = get_dl_fns [keys %downloads]; + my $fns = get_dl_fns [keys %$downloads]; for my $line (@sb_file) { if ($line =~ $dc_regex) { my ($regex, $initial) = get_dc_regex $line; @@ -601,32 +588,32 @@ sub check_distfiles { my $location = $args{LOCATION}; my $sbo = get_sbo_from_loc $location; - my %downloads = get_sbo_downloads( + my $downloads = get_sbo_downloads( LOCATION => $location, 32 => $args{COMPAT32} ); die "Unable to get download information from $location/$sbo.info.\n" unless - keys %downloads > 0; - while (my ($link, $md5) = each %downloads) { + keys %$downloads > 0; + while (my ($link, $md5) = each %$downloads) { get_distfile($link, $md5) unless verify_distfile($link, $md5); } - my @symlinks = create_symlinks($args{LOCATION}, %downloads); - return \@symlinks; + my $symlinks = create_symlinks($args{LOCATION}, $downloads); + return $symlinks; } # given a location and a list of download links, assemble a list of symlinks, # and create them. sub create_symlinks { exists $_[1] or script_error 'create_symlinks requires two arguments.'; - my ($location, %downloads) = @_; + my ($location, $downloads) = @_; my @symlinks; - for my $link (keys %downloads) { + for my $link (keys %$downloads) { my $filename = get_filename_from_link $link; my $symlink = get_symlink_from_filename($filename, $location); push @symlinks, $symlink; symlink $filename, $symlink; } - return @symlinks; + return \@symlinks; } # pull the created package name from the temp file we tee'd to @@ -1038,8 +1025,13 @@ sub process_sbos { eval { $temp_syms = check_distfiles( LOCATION => $$locs{$sbo}, COMPAT32 => $compat32 ); }; - $failures{$sbo} = $@ if $@; - push @symlinks, @$temp_syms; + # if $@ is defined, $temp_syms will be empty and the script will error + # instead of having a proper failure message. + if ($@) { + $failures{$sbo} = $@; + } else { + push @symlinks, @$temp_syms; + } } # return now if we were unable to download/verify everything - might want # to not do this. not sure. @@ -1102,7 +1094,8 @@ sub process_sbos { # subroutine to print out failures sub print_failures { - if (exists $_[0]) { + my $failures = shift; + if (keys %$failures > 0) { my $failures = shift; say 'Failures:'; say " $_: $$failures{$_}" for keys %$failures; diff --git a/sboinstall b/sboinstall index fe9c3ef..56e682e 100755 --- a/sboinstall +++ b/sboinstall @@ -93,7 +93,7 @@ if ($no_reqs or $non_int) { } # populate %locations and sanity check -$locations = get_sbo_location($build_queue); +%locations = get_sbo_location($build_queue); for my $sbo (@$build_queue) { usage_error "Unable to locate $sbo in the SlackBuilds.org tree." unless defined $locations{$sbo}; @@ -162,7 +162,7 @@ unless ($non_int) { exit 0 unless =~ /^[Yy\n]/; } -my %failures = process_sbos( +my $failures = process_sbos( TODO => $build_queue, CMDS => \%commands, OPTS => \%options, @@ -172,6 +172,6 @@ my %failures = process_sbos( NOCLEAN => $noclean, DISTCLEAN => $distclean, ); -print_failures(%failures); +print_failures($failures); -exit keys %failures > 0 ? 1 : 0; +exit keys %$failures > 0 ? 1 : 0; diff --git a/sboupgrade b/sboupgrade index c1f242d..b38b456 100755 --- a/sboupgrade +++ b/sboupgrade @@ -213,7 +213,7 @@ unless ($non_int) { exit 0 unless =~ /^[Yy\n]/; } -my %failures = process_sbos( +my $failures = process_sbos( TODO => $upgrade_queue, CMDS => \%commands, OPTS => \%options, @@ -223,6 +223,6 @@ my %failures = process_sbos( NOCLEAN => $noclean, DISTCLEAN => $distclean, ); -print_failures(%failures); +print_failures($failures); -exit keys %failures > 0 ? 1 : 0; +exit keys %$failures > 0 ? 1 : 0; diff --git a/t/test.t b/t/test.t index 19297d9..b8bb7fc 100755 --- a/t/test.t +++ b/t/test.t @@ -133,25 +133,25 @@ for my $key (keys @$updates) { is(get_arch, 'x86_64', 'get_arch is good'); # get_download_info tests -my %dl_info = get_download_info(LOCATION => "$sbo_home/system/wine", X64 => 0); +my $dl_info = get_download_info(LOCATION => "$sbo_home/system/wine", X64 => 0); my $link = 'http://downloads.sf.net/wine/source/1.4/wine-1.4.1.tar.bz2'; -is($dl_info{$link}, '0c28702ed478df7a1c097f3a9c4cabd6', +is($$dl_info{$link}, '0c28702ed478df7a1c097f3a9c4cabd6', 'get_download_info test 01 good.'); $link = 'http://www.unrealize.co.uk/source/dibeng-max-2010-11-12.zip'; -is($dl_info{$link}, '97159d77631da13952fe87e846cf1f3b', +is($$dl_info{$link}, '97159d77631da13952fe87e846cf1f3b', 'get_download_info test 02 good.'); # get_sbo_downloads tests -%dl_info = get_sbo_downloads(LOCATION => "$sbo_home/system/wine"); +$dl_info = get_sbo_downloads(LOCATION => "$sbo_home/system/wine"); $link = 'http://downloads.sf.net/wine/source/1.4/wine-1.4.1.tar.bz2'; -is($dl_info{$link}, '0c28702ed478df7a1c097f3a9c4cabd6', +is($$dl_info{$link}, '0c28702ed478df7a1c097f3a9c4cabd6', 'get_sbo_downloads test 01 good.'); $link = 'http://www.unrealize.co.uk/source/dibeng-max-2010-11-12.zip'; -is($dl_info{$link}, '97159d77631da13952fe87e846cf1f3b', +is($$dl_info{$link}, '97159d77631da13952fe87e846cf1f3b', 'get_sbo_downloads test 02 good.'); -my %downloads = get_sbo_downloads(LOCATION => "$sbo_home/system/ifuse"); +my $downloads = get_sbo_downloads(LOCATION => "$sbo_home/system/ifuse"); $link = 'http://www.libimobiledevice.org/downloads/ifuse-1.1.1.tar.bz2'; -is($downloads{$link}, '8d528a79de024b91f12f8ac67965c37c', +is($$downloads{$link}, '8d528a79de024b91f12f8ac67965c37c', 'get_sbo_downloads test 03 good.'); # get_filename_from_link test @@ -187,11 +187,11 @@ ok(!(check_x32("$sbo_home/system/ifuse")), ok(check_multilib, 'check_multilib good'); # create_symlinks tests -%downloads = get_sbo_downloads(LOCATION => "$sbo_home/system/wine", 32 => 1); -my @symlinks = create_symlinks "$sbo_home/system/wine", %downloads; -is($symlinks[0], "$sbo_home/system/wine/wine-1.4.1.tar.bz2", +$downloads = get_sbo_downloads(LOCATION => "$sbo_home/system/wine", 32 => 1); +my $symlinks = create_symlinks "$sbo_home/system/wine", $downloads; +is($$symlinks[0], "$sbo_home/system/wine/wine-1.4.1.tar.bz2", '$symlinks[0] good for create_symlinks'); -is($symlinks[1], "$sbo_home/system/wine/dibeng-max-2010-11-12.zip", +is($$symlinks[1], "$sbo_home/system/wine/dibeng-max-2010-11-12.zip", '$symlinks[1] good for create_symlinks'); # grok_temp_file, get_src_dir/get_pkg_name tests @@ -225,7 +225,7 @@ is(get_pkg_name $tempfh, 'skype-2.2.0.35-i486-1_SBo.tgz', 'get_pkg_name good'); #rmdir '/tmp/SBo/test.2.d'; # check_distfiles test -my $symlinks = check_distfiles(LOCATION => "$sbo_home/perl/perl-Sort-Versions"); +$symlinks = check_distfiles(LOCATION => "$sbo_home/perl/perl-Sort-Versions"); is($$symlinks[0], "$sbo_home/perl/perl-Sort-Versions/Sort-Versions-1.5.tar.gz", 'check_distfiles test 01'); @@ -447,7 +447,7 @@ is($count, 4, 'confirm_remove good for duplicate sbo'); ok((get_readme_contents "$sbo_home/network/nagios"), 'get_readme_contents is good'); # test get_dl_fns -my $downloads = [ +$downloads = [ 'http://developer.download.nvidia.com/cg/Cg_3.1/Cg-3.1_April2012_x86.tgz' ]; my $fns = get_dl_fns $downloads; -- cgit v1.2.3 From 8faf46df2a114cce9ad3537b86b6a68b04e91ce5 Mon Sep 17 00:00:00 2001 From: J Pipkin Date: Thu, 10 Jan 2013 23:19:05 -0600 Subject: fix to print_failures() fix, and a modification for conciseness --- SBO-Lib/lib/SBO/Lib.pm | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/SBO-Lib/lib/SBO/Lib.pm b/SBO-Lib/lib/SBO/Lib.pm index c249793..c138846 100644 --- a/SBO-Lib/lib/SBO/Lib.pm +++ b/SBO-Lib/lib/SBO/Lib.pm @@ -1027,11 +1027,7 @@ sub process_sbos { ); }; # if $@ is defined, $temp_syms will be empty and the script will error # instead of having a proper failure message. - if ($@) { - $failures{$sbo} = $@; - } else { - push @symlinks, @$temp_syms; - } + $@ ? $failures{$sbo} = $@ : push @symlinks, @$temp_syms; } # return now if we were unable to download/verify everything - might want # to not do this. not sure. @@ -1096,7 +1092,6 @@ sub process_sbos { sub print_failures { my $failures = shift; if (keys %$failures > 0) { - my $failures = shift; say 'Failures:'; say " $_: $$failures{$_}" for keys %$failures; } -- cgit v1.2.3