diff options
| -rwxr-xr-x | sboconfig | 4 | ||||
| -rwxr-xr-x | sboupgrade | 21 | ||||
| -rw-r--r-- | t/SBO/Lib.pm | 108 |
3 files changed, 77 insertions, 56 deletions
@@ -64,7 +64,7 @@ my %params = reverse %valid_confs; if (exists $options{l}) { my @keys = sort {$a cmp $b} keys %config; - print "$_=$config{$_}\n" for @keys; + say "sboconfig -$params{$_}:\n $_=$config{$_}" for @keys; exit 0; } @@ -101,7 +101,7 @@ sub config_write ($$) { my $has = 0; my $regex = qr/\A\Q$key\E=/; FIRST: for my $tmpline (@temp) { - $has++, $tmpline = "$key=$val", last FIRST if $templine =~ $regex; + $has++, $tmpline = "$key=$val", last FIRST if $tmpline =~ $regex; } untie @temp; # otherwise, append our new $key=$value pair @@ -63,6 +63,7 @@ if (exists $options{j}) { ($options{j} =~ /^\d+$/ || $options{j} eq 'FALSE'); } my $jobs = exists $options{j} ? $options{j} : $config{JOBS}; +$jobs = 0 if $jobs eq 'FALSE'; show_usage and exit 1 unless exists $ARGV[0]; @@ -89,7 +90,9 @@ sub get_readme_path ($) { sub get_inst_names ($) { exists $_[0] or script_error 'get_inst_names requires an argument.'; my $inst = shift; - return [$$_{name} for @$inst]; + my @installed; + push @installed, $$_{name} for @$inst; + return \@installed; } # this subroutine may be getting a little out of hand. @@ -204,7 +207,7 @@ sub grok_options ($) { } # prompt for the readme, and grok the readme at this time also. -sub readme_prompt ($$) { +sub readme_prompt ($) { exists $_[0] or script_error 'readme_prompt requires an argument.'; my $sbo = shift; my $fh = open_read (get_readme_path $sbo); @@ -214,7 +217,7 @@ sub readme_prompt ($$) { grok_requirements $sbo, $readme; grok_user_group $readme; my $opts = grok_options $readme; - print "\n". $readme unless $opts + print "\n". $readme unless $opts; # present the name as -compat32 if appropriate my $name = $compat32 ? "$sbo-compat32" : $sbo; print "\nProceed with $name? [y]: "; @@ -294,16 +297,16 @@ my $todo_upgrade; # but without force, we only want to update what there are updates for unless ($force) { for my $sbo (@ARGV) { - push @todo_upgrade, $sbo if $sbo ~~ @updates; + push @$todo_upgrade, $sbo if $sbo ~~ @updates; } } else { - my @inst = get_installed_sbos; + my $inst = get_installed_sbos; my $inst_names = get_inst_names $inst; FIRST: for my $sbo (@ARGV) { - push $todo_upgrade, $sbo if $sbo ~~ @$inst_names; + push @$todo_upgrade, $sbo if $sbo ~~ @$inst_names; } } -my @failures = process_sbos $todo_upgrade if exists $todo_upgrade[0]; +my @failures = process_sbos $todo_upgrade if exists $$todo_upgrade[0]; print_failures @failures; INSTALL_NEW: @@ -329,9 +332,9 @@ FIRST: for my $sbo (@ARGV) { } } } - push $todo_install, $sbo; + push @$todo_install, $sbo; } -@failures = process_sbos $todo_install if exists $todo_install[0]; +@failures = process_sbos $todo_install if exists $$todo_install[0]; print_failures @failures; exit 0; diff --git a/t/SBO/Lib.pm b/t/SBO/Lib.pm index 398e6a3..20be10b 100644 --- a/t/SBO/Lib.pm +++ b/t/SBO/Lib.pm @@ -9,16 +9,16 @@ # date: Setting Orange, the 37th day of Discord in the YOLD 3178 # license: WTFPL <http://sam.zoy.org/wtfpl/COPYING> -use 5.16.0; +use 5.12.3; use warnings FATAL => 'all'; use strict; -package SBO::Lib 1.0; -my $version = "1.0"; +package SBO::Lib 0.7; +my $version = "0.7"; require Exporter; our @ISA = qw(Exporter); -our @EXPORT = qw(get_slack_version chk_slackbuilds_txt check_home rsync_sbo_tree get_sbo_from_loc get_sbo_version get_download_info get_arch get_sbo_downloads get_filename_from_link compute_md5sum compare_md5s verify_distfile get_distfile get_symlink_from_filename check_x32 check_multilib rewrite_slackbuild revert_slackbuild check_distfiles create_symlinks grok_temp_file get_src_dir get_pkg_name perform_sbo do_convertpkg +our @EXPORT = qw(get_slack_version chk_slackbuilds_txt check_home rsync_sbo_tree get_sbo_from_loc get_sbo_version get_download_info get_arch get_sbo_downloads get_filename_from_link compute_md5sum compare_md5s verify_distfile get_distfile get_symlink_from_filename check_x32 check_multilib rewrite_slackbuild revert_slackbuild check_distfiles create_symlinks grok_temp_file get_src_dir get_pkg_name clear_coe_bit perform_sbo do_convertpkg script_error open_fh open_read @@ -34,7 +34,8 @@ our @EXPORT = qw(get_slack_version chk_slackbuilds_txt check_home rsync_sbo_tree do_upgradepkg get_sbo_location get_from_info - get_tmp_fn + get_tmp_extfn + get_tmp_perlfn ); #$< == 0 or die "This script requires root privileges.\n"; @@ -47,21 +48,22 @@ use File::Path qw(make_path remove_tree); use Fcntl; use File::Find; use File::Temp qw(tempdir tempfile); -use Data::Dumper; use Fcntl qw(F_SETFD F_GETFD); our $tempdir = tempdir (CLEANUP => 1); # subroutine for throwing internal script errors sub script_error (;$) { - exists $_[0] ? die "A fatal script error has occured:\n$_[0]\nExiting.\n" - : die "A fatal script error has occured. Exiting.\n"; + exists $_[0] ? die "A fatal script error has occurred:\n$_[0]\nExiting.\n" + : die "A fatal script error has occurred: Exiting.\n"; } # sub for opening files, second arg is like '<','>', etc -sub open_fh ($$) { - exists $_[1] or script_error 'open_fh requires two arguments'; - -f $_[0] or script_error 'open_fh first argument not a file'; +sub open_fh { + exists $_[1] or script_error ('open_fh requires two arguments'); + unless ($_[1] eq '>') { + -f $_[0] or script_error 'open_fh first argument not a file'; + } my ($file, $op) = @_; open my $fh, $op, $file or die "Unable to open $file.\n"; return $fh; @@ -85,7 +87,7 @@ our %config = ( # if the conf file exists, pull all the $key=$value pairs into a hash my %conf_values; if (-f $conf_file) { - my $fh = open_read $conf_file; + my $fh = open_read ($conf_file); my $text = do {local $/; <$fh>}; %conf_values = $text =~ /^(\w+)=(.*)$/mg; close $fh; @@ -104,15 +106,16 @@ my $name_regex = '\ASLACKBUILD\s+NAME:\s+'; sub show_version () { say "sbotools version $version"; - say 'licensed under the WTFPL'; - say '<http://sam.zoy.org/wtfpl/COPYING>'; + say "licensed under the WTFPL"; + say "<http://sam.zoy.org/wtfpl/COPYING>"; } # %supported maps what's in /etc/slackware-version to what's at SBo -# which is now not needed since this version drops support < 14.0 -# but it's already future-proofed, so leave it. sub get_slack_version () { - my %supported = ('14.0' => '14.0'); + my %supported = ( + '13.37.0' => '13.37', + '14.0' => '13.37', + ); my $fh = open_read '/etc/slackware-version'; chomp (my $line = <$fh>); close $fh; @@ -137,30 +140,30 @@ sub check_home () { die "$sbo_home exists and is not empty. Exiting.\n"; } } else { - make_path ($sbo_home) or die "Unable to create $sbo_home.\n"; + make_path ($sbo_home) or die "Unable to create $sbo_home.\n"; } } # rsync the sbo tree from slackbuilds.org to $config{SBO_HOME} sub rsync_sbo_tree () { - my $slk_version = get_slack_version; + my $slk_version = get_slack_version; my @arg = ('rsync', '-a', '--exclude=*.tar.gz', '--exclude=*.tar.gz.asc'); push @arg, "rsync://slackbuilds.org/slackbuilds/$slk_version/*"; my $out = system @arg, $config{SBO_HOME}; - say 'Finished.' and return $out; + say "Finished." and return $out; } # wrappers for differing checks and output sub fetch_tree () { - check_home; - say 'Pulling SlackBuilds tree...'; - rsync_sbo_tree, return $?; + check_home; + say "Pulling SlackBuilds tree..."; + rsync_sbo_tree, return 1; } sub update_tree () { - fetch_tree, return unless chk_slackbuilds_txt; - say 'Updating SlackBuilds tree...'; - rsync_sbo_tree, return $?; + fetch_tree, return unless chk_slackbuilds_txt; + say "Updating SlackBuilds tree..."; + rsync_sbo_tree, return 1; } # if the SLACKBUILDS.TXT is not in $config{SBO_HOME}, we assume the tree has @@ -168,15 +171,15 @@ sub update_tree () { sub slackbuilds_or_fetch () { unless (chk_slackbuilds_txt) { say 'It looks like you haven\'t run "sbosnap fetch" yet.'; - print 'Would you like me to do this now? [y] '; - <STDIN> =~ /^[Yy\n]/ ? fetch_tree : + print "Would you like me to do this now? [y] "; + <STDIN> =~ /^[Yy\n]/ ? fetch_tree () : die "Please run \"sbosnap fetch\"\n"; } return 1; } # pull an array of hashes, each hash containing the name and version of an sbo -# currently installed. +# currently installed. sub get_installed_sbos () { my @installed; # $1 == name, $2 == version @@ -242,7 +245,7 @@ sub get_from_info (%) { # find the version in the tree for a given sbo (provided a location) sub get_sbo_version ($) { - exists $_[0] or script_error 'get_sbo_version requires an argument.'; + exists $_[0] or script_error 'get_sbo_version requires an arguments'; my $version = get_from_info (LOCATION => shift, GET => 'VERSION'); return $$version[0] ? $$version[0] : 0; } @@ -381,7 +384,7 @@ sub get_distfile ($$) { return 1; } -# for a given distfile, figure out what the full path to its symlink will be +# for a given distfile, what will be the full path of the symlink? sub get_symlink_from_filename ($$) { exists $_[1] or script_error 'get_symlink_from_filename requires two arguments'; @@ -400,7 +403,7 @@ sub check_x32 ($) { # can't do 32-bit on x86_64 without this file, so we'll use it as the test to # to determine whether or not an x86_64 system is setup for multilib -sub check_multilib () { +sub check_multilib { return 1 if -f '/etc/profile.d/32dev.sh'; return; } @@ -416,7 +419,7 @@ sub rewrite_slackbuild ($$%) { my $libdir_regex = qr/^\s*LIBDIRSUFFIX="64"\s*$/; my $make_regex = qr/^\s*make(| \Q||\E exit 1)$/; my $arch_regex = qr/\$VERSION-\$ARCH-\$BUILD/; - # tie the slackbuild, because this is the easiest way to handle this. + # tie the slackbuilds, because this is the easiest way to handle this. tie my @sb_file, 'Tie::File', $slackbuild; for my $line (@sb_file) { # get the output of the tar and makepkg commands. hope like hell that v @@ -424,7 +427,7 @@ sub rewrite_slackbuild ($$%) { if ($line =~ $tar_regex || $line =~ $makepkg_regex) { $line = "$line | tee -a $tempfn"; } - # then check for and apply any other %changes + # then check for and apply any %changes if (exists $changes{libdirsuffix}) { $line =~ s/64/$changes{libdirsuffix}/ if $line =~ $libdir_regex; } @@ -445,7 +448,7 @@ sub revert_slackbuild ($) { my $slackbuild = shift; if (-f "$slackbuild.orig") { unlink $slackbuild if -f $slackbuild; - rename ("$slackbuild.orig", $slackbuild); + rename "$slackbuild.orig", $slackbuild; } return 1; } @@ -500,7 +503,6 @@ sub grok_temp_file (%) { last FIRST; } } -# close $fh; return $out; } @@ -516,11 +518,26 @@ sub get_pkg_name ($) { REGEX => qr/^Slackware\s+package\s+([^\s]+)\s+created\.$/); } -sub get_tmp_fn ($) { - exists $_[0] or script_error 'get_tmp_fn requires an argument.'; +# clear the close-on-exec bit from a temp file handle +sub clear_coe_bit ($) { + exists $_[0] or script_error 'clear_coe_bit requires an argument'; my $fh = shift; fcntl ($fh, F_SETFD, 0) or die "no unset exec-close thingy\n"; - return "/dev/fd/". fileno $fh; + return $fh; +} + +# return a filename from a temp fh for use externally +sub get_tmp_extfn ($) { + exists $_[0] or script_error 'get_tmp_extfn requires an argument.'; + my $fh = clear_coe_bit shift; + return '/dev/fd/'. fileno $fh; +} + +# return a filename from a temp fh for use internally +sub get_tmp_perlfn ($) { + exists $_[0] or script_error 'get_tmp_perlfn requires an argument.'; + my $fh = clear_coe_bit shift; + return '+<=&'. fileno $fh; } # prep and run .SlackBuild @@ -553,7 +570,7 @@ sub perform_sbo (%) { $cmd .= "/bin/sh $location/$sbo.SlackBuild"; $cmd = "$args{OPTS} $cmd" if $args{OPTS}; my $tempfh = tempfile (DIR => $tempdir); - my $fn = get_tmp_fn $tempfh; + my $fn = get_tmp_extfn $tempfh; rewrite_slackbuild "$location/$sbo.SlackBuild", $fn, %changes; chdir $location, my $out = system $cmd; revert_slackbuild "$location/$sbo.SlackBuild"; @@ -568,7 +585,7 @@ sub do_convertpkg ($) { exists $_[0] or script_error 'do_convertpkg requires an argument.'; my $pkg = shift; my $tempfh = tempfile (DIR => $tempdir); - my $fn = get_tmp_fn $tempfh; + my $fn = get_tmp_extfn $tempfh; my $cmd = "/usr/sbin/convertpkg-compat32 -i $pkg -d /tmp | tee $fn"; system ($cmd) == 0 or die; unlink $pkg; @@ -628,7 +645,7 @@ sub do_slackbuild (%) { # remove work directories (source and packaging dirs under /tmp/SBo) sub make_clean ($$$) { - exists $_[2] or script_error 'make_clean requires three arguments.'; + exists $_[1] or script_error 'make_clean requires two arguments.'; my ($sbo, $src, $version) = @_; say "Cleaning for $sbo-$version..."; my $tmpsbo = "/tmp/SBo"; @@ -640,7 +657,7 @@ sub make_clean ($$$) { # remove distfiles sub make_distclean (%) { my %args = ( - SRC => '', + SRC => '', VERSION => '', LOCATION => '', @_ @@ -650,8 +667,8 @@ sub make_distclean (%) { } my $sbo = get_sbo_from_loc $args{LOCATION}; make_clean $sbo, $args{SRC}, $args{VERSION}; - say "Distcleaning for $sbo-$args{VERSION}..."; - # remove any distfiles for this particular SBo. + say "Distcleaning for $sbo-$version..."; + # remove any distfiles for this particular SBo my %downloads = get_sbo_downloads (LOCATION => $args{LOCATION}); for my $key (keys %downloads) { my $filename = get_filename_from_link $key; @@ -666,3 +683,4 @@ sub do_upgradepkg ($) { system ('/sbin/upgradepkg', '--reinstall', '--install-new', shift); return 1; } + |