diff options
| -rw-r--r-- | SBO-Lib/lib/SBO/Lib.pm | 240 | ||||
| -rw-r--r-- | man1/sboinstall.1 | 2 | ||||
| -rw-r--r-- | man1/sboupgrade.1 | 15 | ||||
| -rwxr-xr-x | sboinstall | 120 | ||||
| -rwxr-xr-x | sboupgrade | 391 | ||||
| -rwxr-xr-x | t/test.t | 28 |
6 files changed, 437 insertions, 359 deletions
diff --git a/SBO-Lib/lib/SBO/Lib.pm b/SBO-Lib/lib/SBO/Lib.pm index 653eee2..c138846 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); @@ -226,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($) { @@ -374,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() { @@ -393,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 @@ -530,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; @@ -582,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 @@ -674,7 +680,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 +742,6 @@ sub do_slackbuild { JOBS => 0, LOCATION => '', COMPAT32 => 0, - SYMLINKS => '', @_ ); $args{LOCATION} or script_error 'do_slackbuild requires LOCATION.'; @@ -770,7 +774,6 @@ sub do_slackbuild { X32 => $x32, ); $pkg = do_convertpkg $pkg if $args{COMPAT32}; - unlink $_ for @{$args{SYMLINKS}}; return $version, $pkg, $src; } @@ -922,3 +925,174 @@ 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 <STDIN> =~ /^[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 (<STDIN> =~ /^[Yy]/) { + my $ask = sub() { + print "\nPlease supply any options here, or enter to skip: "; + chomp(my $opts = <STDIN>); + 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 <STDIN> =~ /^[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 + ); }; + # if $@ is defined, $temp_syms will be empty and the script will error + # instead of having a proper failure message. + $@ ? $failures{$sbo} = $@ : 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 { + my $failures = shift; + if (keys %$failures > 0) { + 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. @@ -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 <j@dawnrazor.net> -# Luke Williams <xocel@iquidus.org> +# authors: Jacob Pipkin <j@dawnrazor.net> +# Luke Williams <xocel@iquidus.org> # license: WTFPL <http://sam.zoy.org/wtfpl/COPYING> 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 <STDIN> =~ /^[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; @@ -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 <j@dawnrazor.net> # Luke Williams <xocel@iquidus.org> @@ -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 <STDIN> =~ /^[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 (<STDIN> =~ /^[Yy]/) { - my $ask = sub() { - print "\nPlease supply any options here, or enter to skip: "; - chomp(my $opts = <STDIN>); - 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 <STDIN> =~ /^[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 <STDIN> =~ /^[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; +exit keys %$failures > 0 ? 1 : 0; @@ -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; |