diff options
| -rw-r--r-- | SBO-Lib/lib/SBO/Lib.pm | 160 | ||||
| -rwxr-xr-x | sboconfig | 8 | ||||
| -rwxr-xr-x | sboremove | 4 | ||||
| -rwxr-xr-x | sboupgrade | 26 | ||||
| -rwxr-xr-x | sboupgradex | 24 | ||||
| -rwxr-xr-x | t/prep.pl | 2 | ||||
| -rwxr-xr-x | t/test.t | 171 |
7 files changed, 190 insertions, 205 deletions
diff --git a/SBO-Lib/lib/SBO/Lib.pm b/SBO-Lib/lib/SBO/Lib.pm index c2c1f4c..0a693e3 100644 --- a/SBO-Lib/lib/SBO/Lib.pm +++ b/SBO-Lib/lib/SBO/Lib.pm @@ -69,7 +69,7 @@ sub script_error (;$) { } # sub for opening files, second arg is like '<','>', etc -sub open_fh ($$) { +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'; @@ -80,7 +80,7 @@ sub open_fh ($$) { } sub open_read ($) { - return open_fh shift, '<'; + return open_fh (shift, '<'); } # global config variables @@ -161,7 +161,7 @@ sub check_home () { sub rsync_sbo_tree () { 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/*"; + push @arg, '--delete', "rsync://slackbuilds.org/slackbuilds/$slk_version/*"; my $out = system @arg, $config{SBO_HOME}; my $wanted = sub { $File::Find::name ? chown 0, 0, $File::Find::name @@ -220,17 +220,35 @@ sub get_inst_names ($) { } # search the SLACKBUILDS.TXT for a given sbo's directory -sub get_sbo_location ($) { +sub get_sbo_location { exists $_[0] or script_error 'get_sbo_location requires an argument.'; - my $sbo = shift; - my $regex = qr#LOCATION:\s+\.(/[^/]+/\Q$sbo\E)$#; + my @sbos = @_; + if (ref $sbos[0] eq 'ARRAY') { + my $tmp = $sbos[0]; + @sbos = @$tmp; + } + state $store = {}; + # if scalar context and we already have the location, return it now. + unless (wantarray) { + return $$store{$sbos[0]} if exists $$store{$sbos[0]}; + } + my %locations; my $fh = open_read $slackbuilds_txt; - while (my $line = <$fh>) { - if (my $loc = ($line =~ $regex)[0]) { - return "$config{SBO_HOME}$loc"; + FIRST: for my $sbo (@sbos) { + $locations{$sbo} = $$store{$sbo}, next FIRST if exists $$store{$sbo}; + my $regex = qr#LOCATION:\s+\.(/[^/]+/\Q$sbo\E)$#; + while (my $line = <$fh>) { + if (my $loc = ($line =~ $regex)[0]) { + # save what we found for later requests + $$store{$sbo} = "$config{SBO_HOME}$loc"; + return $$store{$sbo} unless wantarray; + $locations{$sbo} = $$store{$sbo}; + } } + seek $fh, 0, 0; } - return; + close $fh; + return keys %locations > 0 ? %locations : undef; } # pull the sbo name from a $location: $config{SBO_HOME}/system/wine, etc. @@ -240,7 +258,7 @@ sub get_sbo_from_loc ($) { } # pull piece(s) of data, GET, from the $sbo.info file under LOCATION. -sub get_from_info (%) { +sub get_from_info { my %args = ( LOCATION => '', GET => '', @@ -249,26 +267,26 @@ sub get_from_info (%) { unless ($args{LOCATION} && $args{GET}) { script_error 'get_from_info requires LOCATION and GET.'; } - state $vars = {PRGNAM => ['']}; + state $store = {PRGNAM => ['']}; my $sbo = get_sbo_from_loc $args{LOCATION}; - return $$vars{$args{GET}} if $$vars{PRGNAM}[0] eq $sbo; + return $$store{$args{GET}} if $$store{PRGNAM}[0] eq $sbo; # if we're here, we haven't read in the .info file yet. my $fh = open_read "$args{LOCATION}/$sbo.info"; - # suck it all in, clean it all up, stuff it all in $vars. + # suck it all in, clean it all up, stuff it all in $store. my $contents = do {local $/; <$fh>}; $contents =~ s/("|\\\n)//g; - $vars = {$contents =~ /^(\w+)=(.*)$/mg}; + $store = {$contents =~ /^(\w+)=(.*)$/mg}; # fill the hash with array refs - even for single values, # since consistency here is a lot easier than sorting it out later - for my $key (keys %$vars) { - if ($$vars{$key} =~ /\s/) { - my @array = split ' ', $$vars{$key}; - $$vars{$key} = \@array; + for my $key (keys %$store) { + if ($$store{$key} =~ /\s/) { + my @array = split ' ', $$store{$key}; + $$store{$key} = \@array; } else { - $$vars{$key} = [$$vars{$key}]; + $$store{$key} = [$$store{$key}]; } } - return exists $$vars{$args{GET}} ? $$vars{$args{GET}} : undef; + return exists $$store{$args{GET}} ? $$store{$args{GET}} : undef; } # find the version in the tree for a given sbo (provided a location) @@ -284,7 +302,7 @@ sub get_available_updates () { my @updates; my $pkg_list = get_installed_sbos; FIRST: for my $key (keys @$pkg_list) { - my $location = get_sbo_location $$pkg_list[$key]{name}; + my $location = get_sbo_location ($$pkg_list[$key]{name}); # if we can't find a location, assume invalid and skip next FIRST unless defined $location; my $version = get_sbo_version $location; @@ -301,7 +319,7 @@ sub get_available_updates () { # get downloads and md5sums from an sbo's .info file, first # checking for x86_64-specific info if we are told to -sub get_download_info (%) { +sub get_download_info { my %args = ( LOCATION => 0, X64 => 1, @@ -313,13 +331,7 @@ sub get_download_info (%) { $downs = get_from_info (LOCATION => $args{LOCATION}, GET => $get); # did we get nothing back, or UNSUPPORTED/UNTESTED? if ($args{X64}) { - my $nothing; - if (! $$downs[0]) { - $nothing++; - } elsif ($$downs[0] =~ qr/^UN(SUPPOR|TES)TED$/) { - $nothing++; - } - if ($nothing) { + if (! $$downs[0] || $$downs[0] =~ qr/^UN(SUPPOR|TES)TED$/) { $args{X64} = 0; $downs = get_from_info (LOCATION => $args{LOCATION}, GET => 'DOWNLOAD'); @@ -341,7 +353,7 @@ sub get_arch () { } # TODO: should probably combine this with get_download_info -sub get_sbo_downloads (%) { +sub get_sbo_downloads { my %args = ( LOCATION => '', 32 => 0, @@ -361,7 +373,7 @@ sub get_sbo_downloads (%) { return %dl_info; } -# given a link, grab the filename from the end of it +# given a link, grab the filename from it and prepend $distfiles sub get_filename_from_link ($) { exists $_[0] or script_error 'get_filename_from_link requires an argument'; my $fn = shift; @@ -371,7 +383,7 @@ sub get_filename_from_link ($) { return $filename; } -# for a given file, computer its md5sum +# for a given file, compute its md5sum sub compute_md5sum ($) { -f $_[0] or script_error 'compute_md5sum requires a file argument.'; my $fh = open_read shift; @@ -382,42 +394,34 @@ sub compute_md5sum ($) { return $md5sum; } -sub compare_md5s ($$) { - exists $_[1] or script_error 'compare_md5s requires two arguments.'; - my ($first, $second) = @_; - return $first eq $second ? 1 : undef; -} - # for a given distfile, see whether or not it exists, and if so, if its md5sum # matches the sbo's .info file -sub verify_distfile ($$) { +sub verify_distfile { exists $_[1] or script_error 'verify_distfile requires two arguments.'; - my ($link, $info_md5sum) = @_; + my ($link, $info_md5) = @_; my $filename = get_filename_from_link $link; - return unless -d $distfiles; return unless -f $filename; my $md5sum = compute_md5sum $filename; - return compare_md5s $info_md5sum, $md5sum; + return $info_md5 eq $md5sum ? 1 : 0; } # for a given distfile, attempt to retrieve it and, if successful, check its # md5sum against that in the sbo's .info file -sub get_distfile ($$) { +sub get_distfile { exists $_[1] or script_error 'get_distfile requires an argument'; - my ($link, $exp_md5) = @_; + my ($link, $info_md5) = @_; my $filename = get_filename_from_link $link; mkdir $distfiles unless -d $distfiles; chdir $distfiles; system ("wget --no-check-certificate $link") == 0 or die "Unable to wget $link\n"; - my $md5sum = compute_md5sum $filename; # can't do anything if the link in the .info doesn't lead to a good d/l - compare_md5s $md5sum, $exp_md5 or die "md5sum failure for $filename.\n"; + verify_distfile (@_) ? return 1 : die "md5sum failure for $filename.\n"; return 1; } # for a given distfile, figure out what the full path to its symlink will be -sub get_symlink_from_filename ($$) { +sub get_symlink_from_filename { exists $_[1] or script_error 'get_symlink_from_filename requires two arguments'; -f $_[0] or script_error @@ -441,40 +445,26 @@ sub check_multilib () { } # make a backup of the existent SlackBuild, and rewrite the original as needed -sub rewrite_slackbuild (%) { +sub rewrite_slackbuild { my %args = ( SLACKBUILD => '', - TEMPFN => '', CHANGES => {}, @_ ); - unless ($args{SLACKBUILD} && $args{TEMPFN}) { - script_error 'rewrite_slackbuild requires SLACKBUILD and TEMPFN.'; - } + $args{SLACKBUILD} or script_error 'rewrite_slackbuild requires SLACKBUILD.'; my $slackbuild = $args{SLACKBUILD}; my $changes = $args{CHANGES}; copy ($slackbuild, "$slackbuild.orig") or die "Unable to backup $slackbuild to $slackbuild.orig\n"; - my $tar_regex = qr/(un|)tar .*$/; - my $makepkg_regex = qr/makepkg/; 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 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 - # is specified among tar's arguments - if ($line =~ $tar_regex || $line =~ $makepkg_regex) { - $line = "$line | tee -a $args{TEMPFN}"; - } # then check for and apply any other %$changes if (exists $$changes{libdirsuffix}) { $line =~ s/64/$$changes{libdirsuffix}/ if $line =~ $libdir_regex; } - if (exists $$changes{make}) { - $line =~ s/make/make $$changes{make}/ if $line =~ $make_regex; - } if (exists $$changes{arch_out}) { $line =~ s/\$ARCH/$$changes{arch_out}/ if $line =~ $arch_regex; } @@ -496,25 +486,24 @@ sub revert_slackbuild ($) { # for each $download, see if we have it, and if the copy we have is good, # otherwise download a new copy -sub check_distfiles (%) { +sub check_distfiles { exists $_[0] or script_error 'check_distfiles requires an argument.'; my %dists = @_; - for my $link (keys %dists) { - my $md5sum = $dists{$link}; - get_distfile $link, $md5sum unless verify_distfile $link, $md5sum; + while (my ($link, $md5) = each %dists) { + get_distfile ($link, $md5) unless verify_distfile ($link, $md5); } return 1; } # given a location and a list of download links, assemble a list of symlinks, # and create them. -sub create_symlinks ($%) { +sub create_symlinks { exists $_[1] or script_error 'create_symlinks requires two arguments.'; my ($location, %downloads) = @_; my @symlinks; for my $link (keys %downloads) { my $filename = get_filename_from_link $link; - my $symlink = get_symlink_from_filename $filename, $location; + my $symlink = get_symlink_from_filename ($filename, $location); push @symlinks, $symlink; symlink $filename, $symlink; } @@ -523,7 +512,7 @@ sub create_symlinks ($%) { # pull the untarred source directory or created package name from the temp # file (the one we tee'd to) -sub grok_temp_file (%) { +sub grok_temp_file { my %args = ( FH => '', REGEX => '', @@ -566,7 +555,7 @@ sub get_tmp_extfn ($) { } # prep and run .SlackBuild -sub perform_sbo (%) { +sub perform_sbo { my %args = ( OPTS => 0, JOBS => 0, @@ -586,8 +575,6 @@ sub perform_sbo (%) { # set any changes we need to make to the .SlackBuild, setup the command $args{JOBS} = 0 if $args{JOBS} eq 'FALSE'; - $changes{make} = "-j $args{JOBS}" if $args{JOBS}; - if ($args{ARCH} eq 'x86_64' and ($args{C32} || $args{X32})) { if ($args{C32}) { @@ -597,13 +584,14 @@ sub perform_sbo (%) { } $cmd = '. /etc/profile.d/32dev.sh &&'; } - $cmd .= "/bin/sh $location/$sbo.SlackBuild"; - $cmd = "$args{OPTS} $cmd" if $args{OPTS}; + $cmd .= " $args{OPTS}" if $args{OPTS}; + $cmd .= " MAKEOPTS=\"-j$args{JOBS}\"" if $args{JOBS}; + $cmd .= " /bin/sh $location/$sbo.SlackBuild"; my $tempfh = tempfile (DIR => $tempdir); my $fn = get_tmp_extfn $tempfh; + $cmd .= " | tee -a $fn"; rewrite_slackbuild ( SLACKBUILD => "$location/$sbo.SlackBuild", - TEMPFN => $fn, CHANGES => \%changes, ); chdir $location, my $out = system $cmd; @@ -628,7 +616,7 @@ sub do_convertpkg ($) { } # "public interface", sort of thing. -sub do_slackbuild (%) { +sub do_slackbuild { my %args = ( OPTS => 0, JOBS => 0, @@ -640,18 +628,18 @@ sub do_slackbuild (%) { my $location = $args{LOCATION}; my $sbo = get_sbo_from_loc $location; my $arch = get_arch; - my $multi = check_multilib; + my $multilib = check_multilib; my $version = get_sbo_version $location; my $x32; # ensure x32 stuff is set correctly, or that we're setup for it if ($args{COMPAT32}) { - die "compat32 requires multilib.\n" unless $multi; + die "compat32 requires multilib.\n" unless $multilib; die "compat32 requires /usr/sbin/convertpkg-compat32.\n" unless -f '/usr/sbin/convertpkg-compat32'; } else { if ($arch eq 'x86_64') { $x32 = check_x32 $args{LOCATION}; - if ($x32 && ! $multi) { + if ($x32 && ! $multilib) { die "$sbo is 32-bit which requires multilib on x86_64.\n"; } } @@ -662,7 +650,7 @@ sub do_slackbuild (%) { 32 => $args{COMPAT32} ); check_distfiles %downloads; - my @symlinks = create_symlinks $args{LOCATION}, %downloads; + my @symlinks = create_symlinks ($args{LOCATION}, %downloads); # setup and run the .SlackBuild itself my ($pkg, $src) = perform_sbo ( OPTS => $args{OPTS}, @@ -678,7 +666,7 @@ sub do_slackbuild (%) { } # remove work directories (source and packaging dirs under /tmp/SBo) -sub make_clean (%) { +sub make_clean { my %args = ( SBO => '', SRC => '', @@ -697,7 +685,7 @@ sub make_clean (%) { } # remove distfiles -sub make_distclean (%) { +sub make_distclean { my %args = ( SRC => '', VERSION => '', @@ -735,7 +723,7 @@ sub add_to_queue ($) { my $sbo = \${$args}{NAME}; return unless $$sbo; unshift @$args{QUEUE}, $$sbo; - my $location = get_sbo_location $$sbo; + my $location = get_sbo_location ($$sbo); return unless $location; my $requires = get_from_info (LOCATION => $location, GET => 'REQUIRES'); FIRST: for my $req (@$requires) { @@ -750,7 +738,7 @@ sub add_to_queue ($) { } # recursively add a sbo's requirements to the build queue. -sub get_build_queue ($$) { +sub get_build_queue { exists $_[1] or script_error 'get_build_queue requires two arguments.'; my ($sbos, $warnings) = @_; my $temp_queue = []; @@ -105,7 +105,7 @@ if (exists $changes{SBO_HOME}) { # TODO: if multiple options are provided to this script, this sub should write # them all at once, instead of only a single one and having to call it once for # each option specified to the script. -sub config_write ($$) { +sub config_write { exists $_[1] or script_error 'config_write requires two arguments.'; my ($key, $val) = @_; if (! -d $conf_dir) { @@ -131,13 +131,13 @@ sub config_write ($$) { seek $tempfh, 0, 0; my $contents = do {local $/; <$tempfh>}; close $conffh; - eval { $conffh = open_fh $conf_file, '>' }; + eval { $conffh = open_fh ($conf_file, '>') }; warn "Cannot write configuration: $@\n" and return if $@; print {$conffh} $contents or return; close $conffh, close $tempfh; } else { # no config file, easiest case of all. - my $fh = open_fh $conf_file, '>' or return; + my $fh = open_fh ($conf_file, '>') or return; print {$fh} "$key=$val\n"; close $fh; } @@ -146,7 +146,7 @@ sub config_write ($$) { while (my ($key, $value) = each %changes) { say "Setting $key to $value..."; - config_write $key, $value or warn "Unable to write to $conf_file\n"; + config_write ($key, $value) or warn "Unable to write to $conf_file\n"; } exit 0; @@ -55,7 +55,7 @@ my $inst_names = get_inst_names $installed; my @remove; for my $sbo (@ARGV) { - my $test = get_sbo_location $sbo; + my $test = get_sbo_location ($sbo); if ( defined $test ) { if ($sbo ~~ @$inst_names) { push @remove, $sbo @@ -208,4 +208,4 @@ for my $instpkg (@confirmed) { say "All operations have completed successfully."; -exit 0;
\ No newline at end of file +exit 0; @@ -95,7 +95,7 @@ slackbuilds_or_fetch; # time verifying each item is a valid slackbuild my %locations; for my $sbo_name (@ARGV) { - $locations{$sbo_name} = get_sbo_location $sbo_name; + $locations{$sbo_name} = get_sbo_location ($sbo_name); die "Unable to locate $sbo_name in the SlackBuilds.org tree.\n" unless defined $locations{$sbo_name}; } @@ -118,8 +118,8 @@ sub get_requires ($$) { return if '%README%' ~~ @$requires; # do nothing if there's a circular requirement FIRST: for my $req (@$requires) { - my $req_req = get_from_info (LOCATION => get_sbo_location $req, - GET => 'REQUIRES'); + my $location = get_sbo_location ($req); + my $req_req = get_from_info (LOCATION => $location, GET => 'REQUIRES'); if ($sbo ~~ @$req_req) { say "I am seeing circular requirements between $sbo and $req."; say "Therefore, I am not going to handle requirements for $sbo."; @@ -145,7 +145,7 @@ sub clean_reqs ($) { } # ask to install any requirements found -sub ask_requires (%) { +sub ask_requires { my %args = ( REQUIRES => '', README => '', @@ -187,7 +187,7 @@ sub get_user_group ($) { } # offer to run any user/group add commands -sub ask_user_group ($$) { +sub ask_user_group { exists $_[1] or script_error 'ask_user_group requires two arguments'; my ($cmds, $readme) = @_; say "\n". $readme; @@ -236,7 +236,7 @@ sub ask_opts ($) { } # prompt for the readme -sub readme_prompt ($$) { +sub readme_prompt { exists $_[0] or script_error 'readme_prompt requires an argument.'; my ($sbo, $location) = @_; my $fh = open_read (get_readme_path $sbo); @@ -248,7 +248,7 @@ sub readme_prompt ($$) { ref $requires eq 'ARRAY'; # check for user/group add commands, offer to run any found my $user_group = get_user_group $readme; - ask_user_group $user_group, $readme if $$user_group[0]; + ask_user_group ($user_group, $readme) if $$user_group[0]; # check for options mentioned in the README my $opts; $opts = ask_opts $readme if get_opts $readme; @@ -267,7 +267,7 @@ sub process_sbos ($) { my %failures; FIRST: for my $sbo (@$todo) { my $opts = 0; - $opts = readme_prompt $sbo, $locations{$sbo} unless $non_int; + $opts = readme_prompt ($sbo, $locations{$sbo}) unless $non_int; # switch compat32 on if upgrading a -compat32 $compat32 = 1 if $sbo =~ /-compat32$/; my ($version, $pkg, $src); @@ -313,13 +313,11 @@ sub process_sbos ($) { return %failures; } -sub print_failures (;%) { +sub print_failures { if (exists $_[0]) { my %failures = @_; say 'Failures:'; - while (my ($key, $val) = each %failures) { - say " $key: $val"; - } + say " $_: $failures{$_}" for keys %failures; exit 1; } } @@ -365,7 +363,7 @@ unless ($force) { } } my %failures = process_sbos $todo_upgrade if exists $$todo_upgrade[0]; -print_failures %failures; +print_failures (%failures); INSTALL_NEW: exit 0 unless $install_new; @@ -397,6 +395,6 @@ FIRST: for my $sbo (@ARGV) { push @$todo_install, $sbo; } %failures = process_sbos $todo_install if exists $$todo_install[0]; -print_failures %failures; +print_failures (%failures); exit 0; diff --git a/sboupgradex b/sboupgradex index b48fed8..fee8a30 100755 --- a/sboupgradex +++ b/sboupgradex @@ -90,9 +90,7 @@ if ($no_reqs) { $build_queue = get_build_queue(\@ARGV, \%warnings); } -for my $sbo (@$build_queue) { - $locations{$sbo} = get_sbo_location $sbo; -} +my %locations = get_sbo_location ($build_queue); sub get_readme_path ($) { exists $_[0] or script_error 'get_readme_path requires an argument.'; @@ -109,7 +107,7 @@ sub get_user_group ($) { } # offer to run any user/group add commands -sub ask_user_group ($$) { +sub ask_user_group { exists $_[1] or script_error 'ask_user_group requires two arguments'; my ($cmds, $readme) = @_; say "\n". $readme; @@ -158,7 +156,7 @@ sub ask_opts ($) { return; } -sub user_prompt ($$) { +sub user_prompt { exists $_[1] or script_error 'user_prompt requires two arguments.'; my ($sbo, $location) = @_; my $fh = open_read ($location .'/README'); @@ -167,7 +165,7 @@ sub user_prompt ($$) { # check for user/group add commands, offer to run any found my $user_group = get_user_group $readme; - ask_user_group $user_group, $readme if $$user_group[0]; + ask_user_group ($user_group, $readme) if $$user_group[0]; # check for options mentioned in the README my $opts = 0; @@ -238,13 +236,11 @@ sub process_sbos ($) { return %failures; } -sub print_failures (;%) { +sub print_failures { if (exists $_[0]) { my %failures = @_; say 'Failures:'; - while (my ($key, $val) = each %failures) { - say " $key: $val"; - } + say " $_: $failures{$_}" for keys %failures; exit 1; } } @@ -317,7 +313,7 @@ goto BEGIN_BUILD unless $install_new; for my $sbo (@$build_queue) { my $name = $compat32 ? "$sbo-compat32" : $sbo; warn "$name already installed.\n" and next if $name ~~ @$inst_names; - $locations{$name} = get_sbo_location $sbo if $compat32; + $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) { @@ -356,9 +352,9 @@ unless ($non_int) { } my %failures = process_sbos $upgrade_queue if exists $$upgrade_queue[0]; -print_failures %failures; +print_failures (%failures); %failures = process_sbos $build_queue if exists $$build_queue[0]; -print_failures %failures; +print_failures (%failures); -exit 0;
\ No newline at end of file +exit 0; @@ -8,7 +8,7 @@ use Tie::File; chomp (my $pwd = `pwd`); mkdir "$pwd/SBO" unless -d "$pwd/SBO"; -copy ('/home/d4wnr4z0r/projects/slack14/sbotools/SBO-Lib/lib/SBO/Lib.pm', "$pwd/SBO"); +copy ('../SBO-Lib/lib/SBO/Lib.pm', "$pwd/SBO"); open my $write, '>>', "$pwd/SBO/Lib.pm"; @@ -4,20 +4,20 @@ use 5.16.0; use strict; use warnings FATAL => 'all'; use File::Temp qw(tempdir tempfile); -use Test::More tests => 90; +use Test::More; use File::Copy; use Text::Diff; use lib "."; use SBO::Lib; -my $sbo_home = '/home/d4wnr4z0r/sbo.git/slackbuilds'; +my $sbo_home = '/usr/sbo'; -# 1, open_read, open_fh tests +# open_read, open_fh tests my $fh = open_read ('./test.t'); is (ref $fh, 'GLOB', 'open_read works'); close $fh; -# 2-7, config settings tests; +# config settings tests; ok (defined $SBO::Lib::tempdir, '$tempdir is defined'); is ($SBO::Lib::config{DISTCLEAN}, 'FALSE', 'config{DISTCLEAN} is good'); is ($SBO::Lib::config{JOBS}, 2, 'config{JOBS} is good'); @@ -25,13 +25,13 @@ is ($SBO::Lib::config{NOCLEAN}, 'FALSE', 'config{NOCLEAN} is good'); is ($SBO::Lib::config{PKG_DIR}, 'FALSE', 'config{PKG_DIR} is good'); is ($SBO::Lib::config{SBO_HOME}, "$sbo_home", 'config{SBO_HOME} is good'); -# 8, show_version test +# show_version test is (show_version, 1, 'show_version is good'); -# 9, get_slack_version test +# get_slack_version test is (get_slack_version, '14.0', 'get_slack_version is good'); -# 10-11, chk_slackbuilds_txt tests +# 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, undef, @@ -41,10 +41,10 @@ move ("$sbo_home/SLACKBUILDS.TXT.moved", "$sbo_home/SLACKBUILDS.TXT"); #ok (rsync_sbo_tree == 1, 'rsync_sbo_tree is good'); #ok (update_tree == 1, 'update_tree is good'); -# 12, slackbuilds_or_fetch test +# slackbuilds_or_fetch test is (slackbuilds_or_fetch, 1, 'slackbuilds_or_fetch is good'); -# 13-18, get_installed_sbos test +# get_installed_sbos test print "pseudo-random sampling of get_installed_sbos output...\n"; my $installed = get_installed_sbos; for my $key (keys @$installed) { @@ -58,18 +58,28 @@ for my $key (keys @$installed) { 'libmodplug'; is ($$installed[$key]{version}, '3.12.4') if $$installed[$key]{name} eq 'mozilla-nss'; - is ($$installed[$key]{version}, '2.5.0') if $$installed[$key]{name} eq + is ($$installed[$key]{version}, '2.6.0') if $$installed[$key]{name} eq 'zdoom'; } print "completed pseudo-random testing of get_installed_sbos \n"; -# 19-20, get_sbo_location tests -is (get_sbo_location 'nginx', "$sbo_home/network/nginx", +# get_sbo_location tests +is (get_sbo_location ('nginx'), "$sbo_home/network/nginx", 'get_sbo_location is good'); -is (get_sbo_location 'omgwtfbbq', undef, +is (get_sbo_location ('omgwtfbbq'), undef, 'get_sbo_location returns false with not-an-sbo input'); - -# 21-22, get_available_updates tests +my @finds = qw(nginx gmpc); +my %locs = get_sbo_location (@finds); +is ($locs{nginx}, "$sbo_home/network/nginx", + 'get_sbo_location passed array #1 good'); +is ($locs{gmpc}, "$sbo_home/audio/gmpc", 'get_sbo_location passed array #2 good'); +%locs = get_sbo_location (\@finds); +is ($locs{nginx}, "$sbo_home/network/nginx", + 'get_sbo_location passed array ref #1 good'); +is ($locs{gmpc}, "$sbo_home/audio/gmpc", + 'get_sbo_location passed array ref #2 good'); + +# get_available_updates tests my $updates = get_available_updates; for my $key (keys @$updates) { is ($$updates[$key]{installed}, '1.15', @@ -80,10 +90,10 @@ for my $key (keys @$updates) { 'mutagen'; } -# 23, get_arch test +# get_arch test is (get_arch, 'x86_64', 'get_arch is good'); -# 24-25, get_download_info tests +# get_download_info tests 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', @@ -92,7 +102,7 @@ $link = 'http://www.unrealize.co.uk/source/dibeng-max-2010-11-12.zip'; is ($dl_info{$link}, '97159d77631da13952fe87e846cf1f3b', 'get_download_info test 02 good.'); -# 26-28, get_sbo_downloads tests +# get_sbo_downloads tests %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', @@ -105,40 +115,40 @@ $link = 'http://www.libimobiledevice.org/downloads/ifuse-1.1.1.tar.bz2'; is ($downloads{$link}, '8d528a79de024b91f12f8ac67965c37c', 'get_sbo_downloads test 03 good.'); -# 29, get_filename_from_link test +# get_filename_from_link test is (get_filename_from_link 'http://www.libimobiledevice.org/downloads/ifuse-1.1.1.tar.bz2', "$sbo_home/distfiles/ifuse-1.1.1.tar.bz2", 'get_file_from_link good'); is (get_filename_from_link 'adf;lkajsdfaksjdfalsdjfalsdkfjdsfj', undef, 'get_filename_from_link good with invalid input'); -# 31, compute_md5sum test +# compute_md5sum test is (compute_md5sum "$sbo_home/distfiles/laptop-mode-tools_1.61.tar.gz", '6685af5dbb34c3d51ca27933b58f484e', 'compute_md5sum good'); -# 32, verify_distfile test +# verify_distfile test is ((verify_distfile "$sbo_home/distfiles/laptop-mode-tools_1.61.tar.gz", '6685af5dbb34c3d51ca27933b58f484e'), 1, 'verify_distfile good'); -# 33, get_sbo_version test +# get_sbo_version test is (get_sbo_version "$sbo_home/system/wine", '1.4.1', 'get_sbo_version good'); -# 34, get_symlink_from_filename test +# get_symlink_from_filename test is ((get_symlink_from_filename "$sbo_home/distfiles/laptop-mode-tools_1.61.tar.gz", "$sbo_home/system/laptop-mode-tools"), "$sbo_home/system/laptop-mode-tools/laptop-mode-tools_1.61.tar.gz", 'get_symlink_from_filename good'); -# 35-36, check_x32 tests +# check_x32 tests ok (check_x32 "$sbo_home/system/wine", 'check_x32 true for 32-bit only wine'); ok (!(check_x32 "$sbo_home/system/ifuse"), 'check_x32 false for not-32-bit-only ifuse'); -# 37, check_multilib tests +# check_multilib tests ok (check_multilib, 'check_multilib good'); -# 38-39, create_symlinks tests +# 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", @@ -146,7 +156,7 @@ is ($symlinks[0], "$sbo_home/system/wine/wine-1.4.1.tar.bz2", is ($symlinks[1], "$sbo_home/system/wine/dibeng-max-2010-11-12.zip", '$symlinks[1] good for create_symlinks'); -# 40-41, grok_temp_file, get_src_dir/get_pkg_name tests +# grok_temp_file, get_src_dir/get_pkg_name tests my $tempdir = tempdir (CLEANUP => 1); my $tempfh = tempfile (DIR => $tempdir); my $lmt = 'laptop-mode-tools_1.60'; @@ -158,11 +168,11 @@ is (get_src_dir $tempfh, 'laptop-mode-tools_1.60', 'get_src_dir good'); is (get_pkg_name $tempfh, 'skype-2.2.0.35-i486-1_SBo.tgz', 'get_pkg_name good'); close $tempfh; -# 42, check_distfiles test +# check_distfiles test %downloads = get_sbo_downloads (LOCATION => "$sbo_home/system/wine", 32 => 1); is ((check_distfiles %downloads), 1, 'check_distfiles good'); -# 43-45, check_home tests +# check_home tests system ('sudo /usr/sbin/sboconfig -s /home/d4wnr4z0r/opt_sbo') == 0 or die "unable to set sboconfig -s\n"; read_config; @@ -174,19 +184,13 @@ system ("sudo /usr/sbin/sboconfig -s $sbo_home") == 0 or die read_config; rmdir "/home/d4wnr4z0r/opt_sbo"; -# 46-47 get_sbo_from_loc tests +# get_sbo_from_loc tests is (get_sbo_from_loc '/home/d4wnr4z0r/sbo.git/system/ifuse', 'ifuse', 'get_sbo_from_loc returns correctly with valid input'); ok (! get_sbo_from_loc 'omg_wtf_bbq', 'get_sbo_from_loc returns false with invalid input'); -# 48-49, compare_md5s tests -is (compare_md5s ('omgwtf123456789', 'omgwtf123456789'), 1, - 'compare_md5s returns true for matching parameters'); -is (compare_md5s ('omgwtf123456788', 'somethingelsebbq'), undef, - 'compare_md5s returns false for not-matching parameters'); - -# 50, get_distfile tests +# get_distfile tests my $distfile = "$sbo_home/distfiles/Sort-Versions-1.5.tar.gz"; unlink $distfile if -f $distfile; is (get_distfile @@ -194,7 +198,7 @@ is (get_distfile '5434f948fdea6406851c77bebbd0ed19'), 1, 'get_distfile is good'); unlink $distfile; -# 51-58, rewrite_slackbuilds/revert_slackbuild tests +# rewrite_slackbuilds/revert_slackbuild tests my $rewrite_dir = tempdir (CLEANUP => 1); copy ("$sbo_home/system/ifuse/ifuse.SlackBuild", $rewrite_dir); my $slackbuild = "$rewrite_dir/ifuse.SlackBuild"; @@ -204,17 +208,6 @@ my %changes = (); is (rewrite_slackbuild (SLACKBUILD => $slackbuild, TEMPFN => $tempfn, CHANGES => \%changes), 1, 'rewrite_slackbuild with no %changes good'); ok (-f "$slackbuild.orig", 'rewrite_slackbuild backing up original is good.'); -my $expected_out = "67c67 -< tar xvf \$CWD/\$PRGNAM-\$VERSION.tar.bz2 ---- -> tar xvf \$CWD/\$PRGNAM-\$VERSION.tar.bz2 | tee -a $tempfn -103c103 -< /sbin/makepkg -l y -c n \$OUTPUT/\$PRGNAM-\$VERSION-\$ARCH-\$BUILD\$TAG.\${PKGTYPE:-tgz} ---- -> /sbin/makepkg -l y -c n \$OUTPUT/\$PRGNAM-\$VERSION-\$ARCH-\$BUILD\$TAG.\${PKGTYPE:-tgz} | tee -a $tempfn -"; -is (diff ("$slackbuild.orig", $slackbuild, {STYLE => 'OldStyle'}), - $expected_out, 'tar line rewritten correctly'); is (revert_slackbuild $slackbuild, 1, 'revert_slackbuild is good'); $changes{libdirsuffix} = ''; $changes{make} = '-j 5'; @@ -222,28 +215,20 @@ $changes{arch_out} = 'i486'; is (rewrite_slackbuild (SLACKBUILD => $slackbuild, TEMPFN => $tempfn, CHANGES => \%changes), 1, 'rewrite_slackbuild with all %changes good'); ok (-f "$slackbuild.orig", 'rewrite_slackbuild backing up original is good.'); -$expected_out = "55c55 +my $expected_out = "55c55 < LIBDIRSUFFIX=\"64\" --- > LIBDIRSUFFIX=\"\" -67c67 -< tar xvf \$CWD/\$PRGNAM-\$VERSION.tar.bz2 ---- -> tar xvf \$CWD/\$PRGNAM-\$VERSION.tar.bz2 | tee -a $tempfn -87c87 -< make ---- -> make -j 5 103c103 < /sbin/makepkg -l y -c n \$OUTPUT/\$PRGNAM-\$VERSION-\$ARCH-\$BUILD\$TAG.\${PKGTYPE:-tgz} --- -> /sbin/makepkg -l y -c n \$OUTPUT/\$PRGNAM-\$VERSION-i486-\$BUILD\$TAG.\${PKGTYPE:-tgz} | tee -a $tempfn +> /sbin/makepkg -l y -c n \$OUTPUT/\$PRGNAM-\$VERSION-i486-\$BUILD\$TAG.\${PKGTYPE:-tgz} "; is (diff ("$slackbuild.orig", $slackbuild, {STYLE => 'OldStyle'}), $expected_out, 'all changed lines rewritten correctly'); is (revert_slackbuild $slackbuild, 1, 'revert_slackbuild is good again'); -# 59-61, get_from_info tests +# get_from_info tests my $test_loc = "$sbo_home/system/ifuse"; my %params = (LOCATION => $test_loc); my $info = get_from_info (%params, GET => 'VERSION'); @@ -254,7 +239,7 @@ is ($$info[0], 'http://www.libimobiledevice.org', $info = get_from_info (%params, GET => 'DOWNLOAD_x86_64'); is ($$info[0], "", 'get_from_info GET => DOWNLOAD_x86_64 is good'); -# 62-64, get_update_list tests +# get_update_list tests my $listing = get_update_list; s/\s//g for @$listing; for my $item (@$listing) { @@ -266,14 +251,14 @@ for my $item (@$listing) { 'get_update_list output good for atkmm') if $item =~ /^atkmm/; } -# 65, remove_stuff test - can only really test for invalid input +# remove_stuff test - can only really test for invalid input is (remove_stuff '/omg/wtf/bbq', 1, 'remove_stuff good for invalid input'); -# 66, config_write test +# config_write test is (config_write ('OMG', 'WTF'), undef, 'config_write returned undef correctly'); -# 67-74, perform_search tests +# perform_search tests my $findings = perform_search 'desktop'; for my $found (@$findings) { for my $key (keys %$found) { @@ -294,27 +279,27 @@ for my $found (@$findings) { } } -# 75, get_inst_names test +# get_inst_names test $installed = get_installed_sbos; my $inst_names = get_inst_names $installed; ok ('zdoom' ~~ @$inst_names, 'get_inst_names is good'); -# 76-81, get_reqs tests +# get_reqs tests $SBO::Lib::no_reqs = 0; -ok (! (get_requires 'zarafa', "$sbo_home/network/zarafa"), - '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=""'); -my $reqs = get_requires 'matchbox-desktop', - "$sbo_home/audio/gmpc"; +# no longer valid - there are no longer any circular requirements. +#ok (! (get_requires 'zarafa', "$sbo_home/network/zarafa"), +# 'get_requires good for circular requirements'); +my $reqs = get_requires 'gmpc', "$sbo_home/audio/gmpc"; my $say = 'get_requires good for normal req list'; is ($$reqs[0], 'gob2', $say); is ($$reqs[1], 'libmpd', $say); is ($$reqs[2], 'vala', $say); +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=""'); -# 82-85, get_user_group tests +# get_user_group tests $fh = open_read "$sbo_home/network/nagios/README"; my $readme = do {local $/; <$fh>}; close $fh; @@ -330,7 +315,7 @@ 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 +# get_opts test $fh = open_read "$sbo_home/games/vbam/README"; $readme = do {local $/; <$fh>}; close $fh; @@ -340,14 +325,32 @@ $readme = do {local $/; <$fh>}; close $fh; ok (! (get_opts $readme), 'get_opts good where README does not define opts'); -# 88-90, clean_reqs tests -#$reqs = get_requires "wine", "$sbo_home/system/wine"; -#$reqs = clean_reqs $reqs; -#print $_,"\n" for @$reqs; -#ok (! $$reqs[0], 'clean_reqs good for already installed reqs'); +# clean_reqs tests $SBO::Lib::compat32 = 0; +$reqs = get_requires "zdoom", "$sbo_home/games/zdoom"; +$reqs = clean_reqs $reqs; +ok (! $$reqs[0], 'clean_reqs good for already installed reqs'); $reqs = get_requires 'gmpc', "$sbo_home/audio/gmpc"; $reqs = clean_reqs $reqs; -ok ($$reqs[0] eq 'gob2', 'clean_reqs good for un/installed reqs.'); -ok ($$reqs[1] eq 'libmpd', 'clean_reqs good for un/installed reqs.'); - +is ($$reqs[0], 'gob2', 'clean_reqs good for un/installed reqs.'); +is ($$reqs[1], 'libmpd', 'clean_reqs good for un/installed reqs.'); + +my $warnings = {()};; +my $queue = get_build_queue ['zdoom', 'bsnes', 'spring'], $warnings; +my $count = @$queue; +is ($count, 10, 'get_build_queue returns correct amount for multiple sbos'); +is ($$queue[0], 'jdk', 'get_build_queue first entry correct for multiple sbos'); +is ($$queue[2], 'OpenAL', 'get_build_queue third entry correct for multiple sbos'); +is ($$queue[4], 'spring', 'get_build_queue fifth entry correct for multiple sbos'); +is ($$queue[6], 'fmodapi', 'get_build_queue seventh entry correct for multiple sbos'); +is ($$queue[8], 'TiMidity++', 'get_build_queue ninth entry correct for multiple sbos'); +$queue = get_build_queue ['zdoom'], $warnings; +$count = @$queue; +is ($count, 5, 'get_build_queue returns correct amount for single sbo'); +is ($$queue[0], 'p7zip', 'get_build_queue first entry correct for single sbo'); +is ($$queue[2], 'eawpats', 'get_build_queue third entry correct for single sbo'); +is ($$queue[4], 'zdoom', 'get_build_queue fifth entry correct for single sbo'); + + +# end of tests. +done_testing(); |