diff options
| -rw-r--r-- | SBO-Lib/lib/SBO/Lib.pm | 26 | ||||
| -rwxr-xr-x | sbocheck | 2 | ||||
| -rwxr-xr-x | sboconfig | 2 | ||||
| -rwxr-xr-x | sbofind | 2 | ||||
| -rwxr-xr-x | sboinstall | 1 | ||||
| -rwxr-xr-x | sboupgrade | 55 | ||||
| -rwxr-xr-x | t/prep.pl | 19 | ||||
| -rwxr-xr-x | t/test.t | 17 |
8 files changed, 67 insertions, 57 deletions
diff --git a/SBO-Lib/lib/SBO/Lib.pm b/SBO-Lib/lib/SBO/Lib.pm index ff3c681..2325153 100644 --- a/SBO-Lib/lib/SBO/Lib.pm +++ b/SBO-Lib/lib/SBO/Lib.pm @@ -10,8 +10,8 @@ # license: WTFPL <http://sam.zoy.org/wtfpl/COPYING> use 5.16.0; -use warnings FATAL => 'all'; use strict; +use warnings FATAL => 'all'; package SBO::Lib 1.0; my $version = "1.0"; @@ -56,8 +56,8 @@ 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 @@ -131,7 +131,7 @@ sub get_slack_version () { # does the SLACKBUILDS.TXT file exist in the sbo tree? sub chk_slackbuilds_txt () { - return -f $slackbuilds_txt ? 1 : 0; + return -f $slackbuilds_txt ? 1 : undef; } # check for the validity of new $config{SBO_HOME} @@ -151,7 +151,7 @@ sub check_home () { # 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}; @@ -160,13 +160,13 @@ sub rsync_sbo_tree () { # wrappers for differing checks and output sub fetch_tree () { - check_home; + check_home; say 'Pulling SlackBuilds tree...'; rsync_sbo_tree, return 1; } sub update_tree () { - fetch_tree, return unless chk_slackbuilds_txt; + fetch_tree, return unless chk_slackbuilds_txt; say 'Updating SlackBuilds tree...'; rsync_sbo_tree, return 1; } @@ -184,7 +184,7 @@ sub slackbuilds_or_fetch () { } # 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 @@ -245,14 +245,14 @@ sub get_from_info (%) { $$vars{$key} = [$$vars{$key}]; } } - return exists $$vars{$args{GET}} ? $$vars{$args{GET}} : 0; + return exists $$vars{$args{GET}} ? $$vars{$args{GET}} : undef; } # 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.'; my $version = get_from_info (LOCATION => shift, GET => 'VERSION'); - return $$version[0] ? $$version[0] : 0; + return $$version[0] ? $$version[0] : undef; } # for each installed sbo, find out whether or not the version in the tree is @@ -360,7 +360,7 @@ sub compute_md5sum ($) { sub compare_md5s ($$) { exists $_[1] or script_error 'compare_md5s requires two arguments.'; my ($first, $second) = @_; - return $first eq $second ? 1 : 0; + return $first eq $second ? 1 : undef; } # for a given distfile, see whether or not it exists, and if so, if its md5sum @@ -405,7 +405,7 @@ sub get_symlink_from_filename ($$) { sub check_x32 ($) { exists $_[0] or script_error 'check_x32 requires an argument.'; my $dl = get_from_info (LOCATION => shift, GET => 'DOWNLOAD_x86_64'); - return $$dl[0] =~ /UN(SUPPOR|TES)TED/ ? 1 : 0; + return $$dl[0] =~ /UN(SUPPOR|TES)TED/ ? 1 : undef; } # can't do 32-bit on x86_64 without this file, so we'll use it as the test to @@ -649,7 +649,7 @@ sub make_clean ($$$) { # remove distfiles sub make_distclean (%) { my %args = ( - SRC => '', + SRC => '', VERSION => '', LOCATION => '', @_ @@ -19,7 +19,7 @@ use Text::Tabulate; my %options; getopts ('v',\%options); -show_version && exit 0 if (exists $options{v}); +show_version && exit 0 if exists $options{v}; update_tree; @@ -121,7 +121,7 @@ sub config_write ($$) { } while (my ($key, $value) = each %changes) { - print "Setting $key to $value...\n"; + say "Setting $key to $value..."; config_write $key, $value or warn "Unable to write to $conf_file\n"; } @@ -94,7 +94,7 @@ if (exists $$findings[0]) { push @listing, "info: ". get_file_contents "$value/$key.info" if $show_info; push @listing, "README: ". get_file_contents "$value/README" - if $show_readme; + if $show_readme; push @listing, "\n"; } } @@ -59,4 +59,3 @@ for my $opt (@opts2) { system '/usr/sbin/sboupgrade', '-oN', @ARGV; exit 0; - @@ -67,7 +67,7 @@ $jobs = 0 if $jobs eq 'FALSE'; show_usage and exit 1 unless exists $ARGV[0]; # if we can't find SLACKBUILDS.TXT in $config{HOME}, prompt to fetch the tree -slackbuilds_or_fetch; +slackbuilds_or_fetch; # build a hash of locations for each item provided on command line, at the same # time verifying each item is a valid slackbuild @@ -96,7 +96,8 @@ sub get_inst_names ($) { # pull list of requirements sub get_requires ($$) { - exists $_[1] or script_error 'get_requires requires an argument.'; + return if $no_reqs; + exists $_[1] or script_error 'get_requires requires two arguments.'; my ($sbo, $location) = @_; my $requires = get_from_info (LOCATION => $location, GET => 'REQUIRES'); return unless $$requires[0]; @@ -115,27 +116,33 @@ sub get_requires ($$) { sub ask_requires ($$$) { exists $_[2] or script_error 'ask_requires requires three arguments.'; my ($requires, $readme, $sbo) = shift; - for my $req (@$requires) { + FIRST: for my $req (@$requires) { + my $name = $compat32 ? "$req-compat32" : $req; my $inst = get_installed_sbos; - my $inst_names= get_inst_names $inst; - unless ($req ~~ @$inst_names) { - say $readme; - say "$sbo has $req listed as a requirement."; - print "Shall I attempt to install it first? [y] "; - if (<STDIN> =~ /^[Yy\n]/) { - system ('/usr/sbin/sboupgrade', '-oN', $req) == 0 or - die "$req failed to install.\n"; + my $inst_names = get_inst_names $inst; + next FIRST if $name ~~ @$inst_names; + say $readme; + say "$sbo has $name listed as a requirement."; + print "Shall I attempt to install it first? [y] "; + if (<STDIN> =~ /^[Yy\n]/) { + my @args = ('/usr/sbin/sboupgrade', '-oN'); + # populate args so that they carry over correctly + for my $arg (qw(c d p)) { + push @args, "-$arg" if exists $options{$arg}; } + push @args, "-j $options{j}" if exists $options{j}; + system (@args, $req) == 0 or die "$name failed to install.\n"; } } + return; } # look for any (user|group)add commands in the README sub get_user_group ($) { - exists $_[0] or script_error 'grok_user_group requires an argument'; + exists $_[0] or script_error 'get_user_group requires an argument'; my $readme = shift; my @cmds = $readme =~ /^\s*#*\s*(useradd.*|groupadd.*)/mg; - return @cmds; + return \@cmds; } # offer to run any user/group add commands @@ -156,7 +163,7 @@ sub ask_user_group ($$) { # see if the README mentions any options sub get_opts ($) { - exists $_[0] or script_error 'grok_options requires an argument'; + exists $_[0] or script_error 'get_opts requires an argument'; my $readme = shift; return $readme =~ /[A-Z]+=[^\s]/ ? 1 : undef; } @@ -278,23 +285,23 @@ goto INSTALL_NEW if $only_new; # doesn't matter what's updatable and what's not if force is specified my @updates unless $force; unless ($force) { - my $updates = get_available_updates; + my $updates = get_available_updates; push @updates, $$_{name} for @$updates; } my $todo_upgrade; # but without force, we only want to update what there are updates for unless ($force) { for my $sbo (@ARGV) { - push $$todo_upgrades, $sbo if $sbo ~~ @updates; + push @$todo_upgrade, $sbo if $sbo ~~ @updates; } } else { - my $inst = get_installed_sbos; - my $inst_names= get_inst_names $inst; + 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: @@ -302,12 +309,12 @@ exit 0 unless $install_new; my $todo_install; FIRST: for my $sbo (@ARGV) { my $name = $compat32 ? "$sbo-compat32" : $sbo; - my $inst = get_installed_sbos; + my $inst = get_installed_sbos; my $inst_names = get_inst_names $inst;; warn "$name already installed\n", next FIRST if $name ~~ @$inst_names; # if compat32 is TRUE, we need to see if the non-compat version exists. if ($compat32) { - my $inst = get_installed_sbos; + my $inst = get_installed_sbos; my $inst_names = get_inst_names $inst; unless ($sbo ~~ @$inst_names) { print "\nYou are attempting to install $name, however, $sbo is not"; @@ -320,9 +327,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; @@ -12,14 +12,17 @@ copy ('/home/d4wnr4z0r/projects/slack14/sbotools/SBO-Lib/lib/SBO/Lib.pm', "$pwd/ open my $write, '>>', "$pwd/SBO/Lib.pm"; -print {$write} "my \$interactive = 1;\n"; -print {$write} "my \%locations;"; -print {$write} "my \$compat32 = 1;\n"; -print {$write} "my \$no_readme = 1;\n"; -print {$write} "my \$jobs = 1;\n"; -print {$write} "my \$distclean = 1;\n"; -print {$write} "my \$noclean = 1;\n"; -print {$write} "my \$no_install = 1;\n"; +sub pr ($) { + my $thing = shift; + print {$write} "our \$$thing = 1;\n"; +} + +for my $thing (qw(interactive compat32 no_readme jobs distclean noclean no_install no_reqs)) { + pr $thing; +} + +print {$write} "my \%locations;\n"; +print {$write} "my \%options = (nothing => 'to see here');\n"; sub get_subs ($) { my $read = shift; @@ -34,7 +34,7 @@ is (get_slack_version, '14.0', 'get_slack_version is good'); # 10-11, chk_slackbuilds_txt tests is (chk_slackbuilds_txt, 1, 'chk_slackbuilds_txt is good'); move ("$sbo_home/SLACKBUILDS.TXT", "$sbo_home/SLACKBUILDS.TXT.moved"); -is (chk_slackbuilds_txt, 0, 'chk_slackbuilds_txt returns false with no SLACKBUILDS.TXT'); +is (chk_slackbuilds_txt, undef, 'chk_slackbuilds_txt returns false with no SLACKBUILDS.TXT'); move ("$sbo_home/SLACKBUILDS.TXT.moved", "$sbo_home/SLACKBUILDS.TXT"); #ok (rsync_sbo_tree == 1, 'rsync_sbo_tree is good'); @@ -148,7 +148,7 @@ ok (! get_sbo_from_loc 'omg_wtf_bbq', 'get_sbo_from_loc returns false with inval # 48-49, compare_md5s tests is (compare_md5s ('omgwtf123456789', 'omgwtf123456789'), 1, 'compare_md5s returns true for matching parameters'); -is (compare_md5s ('omgwtf123456788', 'somethingelsebbq'), 0, 'compare_md5s returns false for not-matching parameters'); +is (compare_md5s ('omgwtf123456788', 'somethingelsebbq'), undef, 'compare_md5s returns false for not-matching parameters'); # 50, get_distfile tests my $distfile = "$sbo_home/distfiles/Sort-Versions-1.5.tar.gz"; @@ -250,6 +250,7 @@ my $inst_names = get_inst_names $installed; ok ('zdoom' ~~ @$inst_names, 'get_inst_names is good'); # 76-81, get_reqs tests +$SBO::Lib::no_reqs = 0; ok (! (get_requires 'stops', "$sbo_home/audio/stops"), 'get_requires good for circular requirements'); ok (! (get_requires 'smc', "$sbo_home/games/smc"), 'get_requires good for REQUIRES="%README%"'); ok (! (get_requires 'krb5', "$sbo_home/network/krb5"), 'get_requires good for REQUIRES=""'); @@ -263,15 +264,15 @@ is ($$reqs[2], 'matchbox-common', $say); $fh = open_read "$sbo_home/network/nagios/README"; my $readme = do {local $/; <$fh>}; close $fh; -my @cmds = get_user_group $readme; -is ($cmds[0], 'groupadd -g 213 nagios', 'get_user_group good for # groupadd'); -is ($cmds[1], 'useradd -u 213 -d /dev/null -s /bin/false -g nagios nagios', 'get_user_group for # useradd'); +my $cmds = get_user_group $readme; +is ($$cmds[0], 'groupadd -g 213 nagios', 'get_user_group good for # groupadd'); +is ($$cmds[1], 'useradd -u 213 -d /dev/null -s /bin/false -g nagios nagios', 'get_user_group for # useradd'); $fh = open_read "$sbo_home/network/havp/README"; $readme = do {local $/; <$fh>}; close $fh; -@cmds = get_user_group $readme; -is ($cmds[0], 'groupadd -g 210 clamav', 'get_user_group good for groupadd'); -is ($cmds[1], 'useradd -u 256 -d /dev/null -s /bin/false -g clamav havp', 'get_user_group good for useradd'); +$cmds = get_user_group $readme; +is ($$cmds[0], 'groupadd -g 210 clamav', 'get_user_group good for groupadd'); +is ($$cmds[1], 'useradd -u 256 -d /dev/null -s /bin/false -g clamav havp', 'get_user_group good for useradd'); # 86-87, get_opts test $fh = open_read "$sbo_home/games/vbam/README"; |