From 38488004c207508834543e02e991e6129669bc8c Mon Sep 17 00:00:00 2001 From: Jacob Pipkin Date: Thu, 30 Aug 2012 07:20:32 -0500 Subject: changes for REQUIRES in SBos for 14, and many cleanups, fixes, enhancements --- t/SBO/Lib.pm | 668 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ t/SBO/Lib.pm~ | 643 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ t/do_tests.sh | 4 + t/prep.pl | 46 ++++ t/test.t | 95 +++++++++ t/test.t~ | 95 +++++++++ 6 files changed, 1551 insertions(+) create mode 100644 t/SBO/Lib.pm create mode 100644 t/SBO/Lib.pm~ create mode 100755 t/do_tests.sh create mode 100755 t/prep.pl create mode 100755 t/test.t create mode 100755 t/test.t~ (limited to 't') diff --git a/t/SBO/Lib.pm b/t/SBO/Lib.pm new file mode 100644 index 0000000..398e6a3 --- /dev/null +++ b/t/SBO/Lib.pm @@ -0,0 +1,668 @@ +#!/usr/bin/env perl +# +# vim: set ts=4:noet +# +# Lib.pm +# shared functions for the sbo_ scripts. +# +# author: Jacob Pipkin +# date: Setting Orange, the 37th day of Discord in the YOLD 3178 +# license: WTFPL + +use 5.16.0; +use warnings FATAL => 'all'; +use strict; + +package SBO::Lib 1.0; +my $version = "1.0"; + +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 + script_error + open_fh + open_read + show_version + slackbuilds_or_fetch + fetch_tree + update_tree + get_installed_sbos + get_available_updates + do_slackbuild + make_clean + make_distclean + do_upgradepkg + get_sbo_location + get_from_info + get_tmp_fn +); + +#$< == 0 or die "This script requires root privileges.\n"; + +use Tie::File; +use Sort::Versions; +use Digest::MD5; +use File::Copy; +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"; +} + +# 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'; + my ($file, $op) = @_; + open my $fh, $op, $file or die "Unable to open $file.\n"; + return $fh; +} + +sub open_read ($) { + return open_fh shift, '<'; +} + +# pull in configuration, set sane defaults, etc. +our $conf_dir = '/etc/sbotools'; +our $conf_file = "$conf_dir/sbotools.conf"; +our %config = ( + NOCLEAN => 'FALSE', + DISTCLEAN => 'FALSE', + JOBS => 'FALSE', + PKG_DIR => 'FALSE', + SBO_HOME => 'FALSE', +); + +# 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 $text = do {local $/; <$fh>}; + %conf_values = $text =~ /^(\w+)=(.*)$/mg; + close $fh; +} + +for my $key (keys %config) { + $config{$key} = $conf_values{$key} if exists $conf_values{$key}; +} +$config{JOBS} = 'FALSE' unless $config{JOBS} =~ /^\d+$/; +$config{SBO_HOME} = '/usr/sbo' if $config{SBO_HOME} eq 'FALSE'; + +# some stuff we'll need later. +my $distfiles = "$config{SBO_HOME}/distfiles"; +my $slackbuilds_txt = "$config{SBO_HOME}/SLACKBUILDS.TXT"; +my $name_regex = '\ASLACKBUILD\s+NAME:\s+'; + +sub show_version () { + say "sbotools version $version"; + say 'licensed under the WTFPL'; + say ''; +} + +# %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 $fh = open_read '/etc/slackware-version'; + chomp (my $line = <$fh>); + close $fh; + my $version = ($line =~ /\s+(\d+[^\s]+)$/)[0]; + die "Unsupported Slackware version: $version\n" + unless $version ~~ %supported; + return $supported{$version}; +} + +# does the SLACKBUILDS.TXT file exist in the sbo tree? +sub chk_slackbuilds_txt () { + return -f $slackbuilds_txt ? 1 : 0; +} + +# check for the validity of new $config{SBO_HOME} +sub check_home () { + my $sbo_home = $config{SBO_HOME}; + if (-d $sbo_home) { + opendir (my $home_handle, $sbo_home); + FIRST: while (readdir $home_handle) { + next FIRST if /^\.[\.]{0,1}$/; + die "$sbo_home exists and is not empty. Exiting.\n"; + } + } else { + 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 @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; +} + +# wrappers for differing checks and output +sub fetch_tree () { + check_home; + say 'Pulling SlackBuilds tree...'; + rsync_sbo_tree, return $?; +} + +sub update_tree () { + fetch_tree, return unless chk_slackbuilds_txt; + say 'Updating SlackBuilds tree...'; + rsync_sbo_tree, return $?; +} + +# if the SLACKBUILDS.TXT is not in $config{SBO_HOME}, we assume the tree has +# not been populated there; prompt the user to automagickally pull the 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] '; + =~ /^[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. +sub get_installed_sbos () { + my @installed; + # $1 == name, $2 == version + my $regex = qr#/([^/]+)-([^-]+)-[^-]+-[^-]+$#; + for my $path () { + my ($name, $version) = ($path =~ $regex)[0,1]; + push @installed, {name => $name, version => $version}; + } + return \@installed; +} + +# search the SLACKBUILDS.TXT for a given sbo's directory +sub get_sbo_location ($) { + exists $_[0] or script_error 'get_sbo_location requires an argument.'; + my $sbo = shift; + my $regex = qr#LOCATION:\s+\.(/[^/]+/$sbo)$#; + my $fh = open_read $slackbuilds_txt; + while (my $line = <$fh>) { + if (my $loc = ($line =~ $regex)[0]) { + return "$config{SBO_HOME}$loc"; + } + } + return; +} + +# pull the sbo name from a $location: $config{SBO_HOME}/system/wine, etc. +sub get_sbo_from_loc ($) { + exists $_[0] or script_error 'get_sbo_from_loc requires an argument.'; + return (shift =~ qr#/([^/]+)$#)[0]; +} + +# pull piece(s) of data, GET, from the $sbo.info file under LOCATION. +sub get_from_info (%) { + my %args = ( + LOCATION => '', + GET => '', + @_ + ); + unless ($args{LOCATION} && $args{GET}) { + script_error 'get_from_info requires LOCATION and GET.'; + } + state $vars = {PRGNAM => ['']}; + my $sbo = get_sbo_from_loc $args{LOCATION}; + return $$vars{$args{GET}} if $$vars{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. + my $contents = do {local $/; <$fh>}; + $contents =~ s/("|\\\n)//g; + $vars = {$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; + } else { + $$vars{$key} = [$$vars{$key}]; + } + } + return exists $$vars{$args{GET}} ? $$vars{$args{GET}} : 0; +} + +# 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; +} + +# for each installed sbo, find out whether or not the version in the tree is +# newer, and compile an array of hashes containing those which are +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}; + # if we can't find a location, assume invalid and skip + next FIRST unless defined $location; + my $version = get_sbo_version $location; + if (versioncmp ($version, $$pkg_list[$key]{version}) == 1) { + push @updates, { + name => $$pkg_list[$key]{name}, + installed => $$pkg_list[$key]{version}, + update => $version + }; + } + } + return \@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 (%) { + my %args = ( + LOCATION => 0, + X64 => 1, + @_ + ); + $args{LOCATION} or script_error 'get_download_info requires LOCATION.'; + my ($get, $downs, $md5s, %return); + $get = ($args{X64} ? 'DOWNLOAD_x86_64' : 'DOWNLOAD'); + $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 = 1; + } elsif ($$downs[0] =~ qr/^UN(SUPPOR|TES)TED$/) { + $nothing = 1; + } + if ($nothing) { + $args{X64} = 0; + $downs = get_from_info (LOCATION => $args{LOCATION}, + GET => 'DOWNLOAD'); + } + } + # if we still don't have any links, something is really wrong. + return unless $$downs[0]; + # grab the md5s and build a hash + $get = $args{X64} ? 'MD5SUM_x86_64' : 'MD5SUM'; + $md5s = get_from_info (LOCATION => $args{LOCATION}, GET => $get); + return unless $$md5s[0]; + $return{$$downs[$_]} = $$md5s[$_] for (keys @$downs); + return %return; +} + +sub get_arch () { + chomp (my $arch = `uname -m`); + return $arch; +} + +# TODO: should probably combine this with get_download_info +sub get_sbo_downloads (%) { + my %args = ( + LOCATION => '', + 32 => 0, + @_ + ); + $args{LOCATION} or script_error 'get_sbo_downloads requires LOCATION.'; + my $location = $args{LOCATION}; + -d $location or script_error 'get_sbo_downloads given a non-directory.'; + my $arch = get_arch; + my %dl_info; + if ($arch eq 'x86_64') { + %dl_info = get_download_info (LOCATION => $location) unless $args{32}; + } + unless (keys %dl_info > 0) { + %dl_info = get_download_info (LOCATION => $location, X64 => 0); + } + return %dl_info; +} + +# given a link, grab the filename from the end of it +sub get_filename_from_link ($) { + exists $_[0] or script_error 'get_filename_from_link requires an argument'; + return "$distfiles/". (shift =~ qr#/([^/]+)$#)[0]; +} + +# for a given file, computer its md5sum +sub compute_md5sum ($) { + -f $_[0] or script_error 'compute_md5sum requires a file argument.'; + my $fh = open_read shift; + my $md5 = Digest::MD5->new; + $md5->addfile ($fh); + my $md5sum = $md5->hexdigest; + close $fh; + return $md5sum; +} + +sub compare_md5s ($$) { + exists $_[1] or script_error 'compare_md5s requires two arguments.'; + my ($first, $second) = @_; + return $first eq $second ? 1 : 0; +} + +# 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 ($$) { + exists $_[1] or script_error 'check_distfile requires two arguments.'; + my ($link, $info_md5sum) = @_; + 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; +} + +# 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 ($$) { + exists $_[1] or script_error 'get_distfile requires an argument'; + my ($link, $exp_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"; + return 1; +} + +# for a given distfile, figure out what the full path to its symlink will be +sub get_symlink_from_filename ($$) { + exists $_[1] or script_error + 'get_symlink_from_filename requires two arguments'; + -f $_[0] or script_error + 'get_symlink_from_filename first argument is not a file'; + my ($filename, $location) = @_; + return "$location/". ($filename =~ qr#/([^/]+)$#)[0]; +} + +# determine whether or not a given sbo is 32-bit only +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; +} + +# 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 () { + return 1 if -f '/etc/profile.d/32dev.sh'; + return; +} + +# make a backup of the existent SlackBuild, and rewrite the original as needed +sub rewrite_slackbuild ($$%) { + exists $_[1] or script_error 'rewrite_slackbuild requires two arguments.'; + my ($slackbuild, $tempfn, %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 $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; + } + } + untie @sb_file; + return 1; +} + +# move a backed-up .SlackBuild file back into place +sub revert_slackbuild ($) { + exists $_[0] or script_error 'revert_slackbuild requires an argument'; + my $slackbuild = shift; + if (-f "$slackbuild.orig") { + unlink $slackbuild if -f $slackbuild; + rename ("$slackbuild.orig", $slackbuild); + } + return 1; +} + +# for each $download, see if we have it, and if the copy we have is good, +# otherwise download a new copy +sub check_distfiles (%) { + exists $_[0] or script_error 'check_distfiles requires an argument.'; + my %dists = @_; + for my $link (keys %dists) { + my $md5sum = $dists{$link}; + unless (verify_distfile $link, $md5sum) { + die unless get_distfile $link, $md5sum; + } + } + return 1; +} + +# 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 @symlinks; + 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; +} + +# pull the untarred source directory or created package name from the temp +# file (the one we tee'd to) +sub grok_temp_file (%) { + my %args = ( + FH => '', + REGEX => '', + CAPTURE => 0, + @_ + ); + unless ($args{FH} && $args{REGEX}) { + script_error 'grok_temp_file requires two arguments'; + } + my $fh = $args{FH}; + seek $fh, 0, 0; + my $out; + FIRST: while (my $line = <$fh>) { + if ($line =~ $args{REGEX}) { + $out = ($line =~ $args{REGEX})[$args{CAPTURE}]; + last FIRST; + } + } +# close $fh; + return $out; +} + +# wrappers around grok_temp_file +sub get_src_dir ($) { + exists $_[0] or script_error 'get_src_dir requires an argument'; + return grok_temp_file (FH => shift, REGEX => qr#^([^/]+)/#); +} + +sub get_pkg_name ($) { + exists $_[0] or script_error 'get_pkg_name requires an argument'; + return grok_temp_file (FH => shift, + REGEX => qr/^Slackware\s+package\s+([^\s]+)\s+created\.$/); +} + +sub get_tmp_fn ($) { + exists $_[0] or script_error 'get_tmp_fn requires an argument.'; + my $fh = shift; + fcntl ($fh, F_SETFD, 0) or die "no unset exec-close thingy\n"; + return "/dev/fd/". fileno $fh; +} + +# prep and run .SlackBuild +sub perform_sbo (%) { + my %args = ( + OPTS => 0, + JOBS => 0, + LOCATION => '', + ARCH => '', + C32 => 0, + X32 => 0, + @_ + ); + unless ($args{LOCATION} && $args{ARCH}) { + script_error 'perform_sbo requires LOCATION and ARCH.'; + } + my $location = $args{LOCATION}; + my $sbo = get_sbo_from_loc $location; + my ($cmd, %changes); + # figure out any changes we need to make to the .SlackBuild + $changes{make} = "-j $args{JOBS}" if $args{JOBS}; + if ($args{ARCH} eq 'x86_64' and ($args{C32} || $args{X32})) { + if ($args{C32}) { + $changes{libdirsuffix} = ''; + } elsif ($args{X32}) { + $changes{arch_out} = 'i486'; + } + $cmd = ". /etc/profile.d/32dev.sh &&"; + } + $cmd .= "/bin/sh $location/$sbo.SlackBuild"; + $cmd = "$args{OPTS} $cmd" if $args{OPTS}; + my $tempfh = tempfile (DIR => $tempdir); + my $fn = get_tmp_fn $tempfh; + rewrite_slackbuild "$location/$sbo.SlackBuild", $fn, %changes; + chdir $location, my $out = system $cmd; + revert_slackbuild "$location/$sbo.SlackBuild"; + die unless $out == 0; + my $pkg = get_pkg_name $tempfh; + my $src = get_src_dir $tempfh; + return $pkg, $src; +} + +# run convertpkg on a package to turn it into a -compat32 thing +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 $cmd = "/usr/sbin/convertpkg-compat32 -i $pkg -d /tmp | tee $fn"; + system ($cmd) == 0 or die; + unlink $pkg; + return get_pkg_name $tempfh; +} + +# "public interface", sort of thing. +sub do_slackbuild (%) { + my %args = ( + OPTS => 0, + JOBS => 0, + LOCATION => '', + COMPAT32 => 0, + @_ + ); + $args{LOCATION} or script_error 'do_slackbuild requires LOCATION.'; + my $location = $args{LOCATION}; + my $sbo = get_sbo_from_loc $location; + my $arch = get_arch; + my $multi = 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 only works on x86_64.\n" unless $arch eq 'x86_64'; + die "compat32 requires multilib.\n" unless $multi; + 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) { + die "$sbo is 32-bit which requires multilib on x86_64.\n"; + } + } + } + # get a hash of downloads and md5sums, ensure we have 'em, symlink 'em + my %downloads = get_sbo_downloads ( + LOCATION => $location, + 32 => $args{COMPAT32} + ); + check_distfiles %downloads; + my @symlinks = create_symlinks $args{LOCATION}, %downloads; + # setup and run the .SlackBuild itself + my ($pkg, $src) = perform_sbo ( + OPTS => $args{OPTS}, + JOBS => $args{JOBS}, + LOCATION => $location, + ARCH => $arch, + C32 => $args{COMPAT32}, + X32 => $x32, + ); + do_convertpkg $pkg if $args{COMPAT32}; + unlink $_ for @symlinks; + return $version, $pkg, $src; +} + +# remove work directories (source and packaging dirs under /tmp/SBo) +sub make_clean ($$$) { + exists $_[2] or script_error 'make_clean requires three arguments.'; + my ($sbo, $src, $version) = @_; + say "Cleaning for $sbo-$version..."; + my $tmpsbo = "/tmp/SBo"; + remove_tree ("$tmpsbo/$src") if -d "$tmpsbo/$src"; + remove_tree ("$tmpsbo/package-$sbo") if -d "$tmpsbo/package-$sbo"; + return 1; +} + +# remove distfiles +sub make_distclean (%) { + my %args = ( + SRC => '', + VERSION => '', + LOCATION => '', + @_ + ); + unless ($args{SRC} && $args{VERSION} && $args{LOCATION}) { + script_error 'make_distclean requires four arguments.'; + } + 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. + my %downloads = get_sbo_downloads (LOCATION => $args{LOCATION}); + for my $key (keys %downloads) { + my $filename = get_filename_from_link $key; + unlink $filename if -f $filename; + } + return 1; +} + +# run upgradepkg for a created package +sub do_upgradepkg ($) { + exists $_[0] or script_error 'do_upgradepkg requires an argument.'; + system ('/sbin/upgradepkg', '--reinstall', '--install-new', shift); + return 1; +} diff --git a/t/SBO/Lib.pm~ b/t/SBO/Lib.pm~ new file mode 100644 index 0000000..be29986 --- /dev/null +++ b/t/SBO/Lib.pm~ @@ -0,0 +1,643 @@ +#!/usr/bin/env perl +# +# vim: set ts=4:noet +# +# Lib.pm +# shared functions for the sbo_ scripts. +# +# author: Jacob Pipkin +# date: Setting Orange, the 37th day of Discord in the YOLD 3178 +# license: WTFPL + +use 5.16.0; +use warnings FATAL => 'all'; +use strict; + +package SBO::Lib 1.0; +my $version = "1.0"; + +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 check_distfile get_distfile get_symlink_from_filename check_x32 check_multilib rewrite_slackbuild revert_slackbuild create_symlinks grok_temp_file get_src_dir get_pkg_name perform_sbo + script_error + open_fh + open_read + show_version + slackbuilds_or_fetch + fetch_tree + update_tree + get_installed_sbos + get_available_updates + do_slackbuild + make_clean + make_distclean + do_upgradepkg + get_sbo_location + get_from_info +); + +#$< == 0 or die "This script requires root privileges.\n"; + +use Tie::File; +use Sort::Versions; +use Digest::MD5; +use File::Copy; +use File::Path qw(make_path remove_tree); +use Fcntl; +use File::Find; +use File::Temp qw(tempdir tempfile); +use Data::Dumper; + +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"; +} + +# 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'; + my ($file, $op) = @_; + open my $fh, $op, $file or die "Unable to open $file.\n"; + return $fh; +} + +sub open_read ($) { + return open_fh shift, '<'; +} + +# pull in configuration, set sane defaults, etc. +our $conf_dir = '/etc/sbotools'; +our $conf_file = "$conf_dir/sbotools.conf"; +our %config = ( + NOCLEAN => 'FALSE', + DISTCLEAN => 'FALSE', + JOBS => 'FALSE', + PKG_DIR => 'FALSE', + SBO_HOME => 'FALSE', +); + +# 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 $text = do {local $/; <$fh>}; + %conf_values = $text =~ /^(\w+)=(.*)$/mg; + close $fh; +} + +for my $key (keys %config) { + $config{$key} = $conf_values{$key} if exists $conf_values{$key}; +} +$config{JOBS} = 'FALSE' unless $config{JOBS} =~ /^\d+$/; +$config{SBO_HOME} = '/usr/sbo' if $config{SBO_HOME} eq 'FALSE'; + +# some stuff we'll need later. +my $distfiles = "$config{SBO_HOME}/distfiles"; +my $slackbuilds_txt = "$config{SBO_HOME}/SLACKBUILDS.TXT"; +my $name_regex = '\ASLACKBUILD\s+NAME:\s+'; + +sub show_version () { + print "sbotools version $version\n"; + print "licensed under the WTFPL\n"; + print "\n"; +} + +# %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 $fh = open_read '/etc/slackware-version'; + chomp (my $line = <$fh>); + close $fh; + my $version = ($line =~ /\s+(\d+[^\s]+)$/)[0]; + die "Unsupported Slackware version: $version\n" + unless $version ~~ %supported; + return $supported{$version}; +} + +# does the SLACKBUILDS.TXT file exist in the sbo tree? +sub chk_slackbuilds_txt () { + return -f $slackbuilds_txt ? 1 : 0; +} + +# check for the validity of new $config{SBO_HOME} +sub check_home () { + my $sbo_home = $config{SBO_HOME}; + if (-d $sbo_home) { + opendir (my $home_handle, $sbo_home); + FIRST: while (readdir $home_handle) { + next FIRST if /^\.[\.]{0,1}$/; + die "$sbo_home exists and is not empty. Exiting.\n"; + } + } else { + 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 @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}; + print "Finished.\n" and return $out; +} + +# wrappers for differing checks and output +sub fetch_tree () { + check_home; + print "Pulling SlackBuilds tree...\n"; + rsync_sbo_tree, return $?; +} + +sub update_tree () { + fetch_tree, return unless chk_slackbuilds_txt; + print "Updating SlackBuilds tree...\n"; + rsync_sbo_tree, return $?; +} + +# if the SLACKBUILDS.TXT is not in $config{SBO_HOME}, we assume the tree has +# not been populated there; prompt the user to automagickally pull the tree. +sub slackbuilds_or_fetch () { + unless (chk_slackbuilds_txt) { + print "It looks like you haven't run \"sbosnap fetch\" yet.\n"; + print "Would you like me to do this now? [y] "; + =~ /^[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. +sub get_installed_sbos () { + my @installed; + # $1 == name, $2 == version + my $regex = qr#/([^/]+)-([^-]+)-[^-]+-[^-]+$#; + for my $path () { + my ($name, $version) = ($path =~ $regex)[0,1]; + push @installed, {name => $name, version => $version}; + } + return \@installed; +} + +# search the SLACKBUILDS.TXT for a given sbo's directory +sub get_sbo_location ($) { + exists $_[0] or script_error 'get_sbo_location requires an argument.'; + my $sbo = shift; + my $regex = qr#LOCATION:\s+\.(/[^/]+/$sbo)$#; + my $fh = open_read $slackbuilds_txt; + while (my $line = <$fh>) { + if (my $loc = ($line =~ $regex)[0]) { + return "$config{SBO_HOME}$loc"; + } + } + return; +} + +# pull the sbo name from a $location: $config{SBO_HOME}/system/wine, etc. +sub get_sbo_from_loc ($) { + exists $_[0] or script_error 'get_sbo_from_loc requires an argument.'; + return (shift =~ qr#/([^/]+)$#)[0]; +} + +# pull piece(s) of data, GET, from the $sbo.info file under LOCATION. +sub get_from_info { + warn " * * * * * * * * * * in get_from_info sub * * * * * * * * * *\n"; + my %args = ( + LOCATION => '', + GET => '', + @_ + ); + unless ($args{LOCATION} && $args{GET}) { + script_error 'get_from_info requires LOCATION and GET.'; + } + state $vars = {PKGNAM => ['']}; + my $sbo = get_sbo_from_loc $args{LOCATION}; + print Dumper ($vars); + return $$vars{$args{GET}} if $$vars{PKGNAM}[0] eq $sbo; + # if we haven't read in the .info file yet, do so now. + warn " * * * * * * * * * * parsing $sbo.info file * * * * * * * * * *\n"; + my $fh = open_read "$args{LOCATION}/$sbo.info"; + # suck it all in and join up the \ lines... + my $contents = do {local $/; <$fh>}; + $contents =~ s/("|\\\n)//g; + my %tmp = $contents =~ /^(\w+)=(.*)$/mg; + $vars = \%tmp; + # 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; + } else { + $$vars{$key} = [$$vars{$key}]; + } + } + return $$vars{$args{GET}}; +} + +# 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; +} + +# for each installed sbo, find out whether or not the version in the tree is +# newer, and compile an array of hashes containing those which are +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}; + # if we can't find a location, assume invalid and skip + next FIRST unless defined $location; + my $version = get_sbo_version $location; + if (versioncmp ($version, $$pkg_list[$key]{version}) == 1) { + push @updates, { + name => $$pkg_list[$key]{name}, + installed => $$pkg_list[$key]{version}, + update => $version + }; + } + } + return \@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 { + my %args = ( + LOCATION => 0, + X64 => 1, + @_ + ); + $args{LOCATION} or script_error 'get_download_info requires LOCATION.'; + my ($get, $downs, $md5s, %return); + $get = ($args{X64} ? 'DOWNLOAD_x86_64' : 'DOWNLOAD'); + $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 = 1; + } elsif ($$downs[0] =~ qr/^UN(SUPPOR|TES)TED$/) { + $nothing = 1; + } + if ($nothing) { + $args{X64} = 0; + $downs = get_from_info (LOCATION => $args{LOCATION}, + GET => 'DOWNLOAD'); + } + } + # if we still don't have any links, something is really wrong. + return unless $$downs[0]; + # grab the md5s and build a hash + $get = $args{X64} ? 'MD5SUM_x86_64' : 'MD5SUM'; + $md5s = get_from_info (LOCATION => $args{LOCATION}, GET => $get); + return unless $$md5s[0]; + $return{$$downs[$_]} = $$md5s[$_] for (keys @$downs); + return %return; +} + +sub get_arch () { + chomp (my $arch = `uname -m`); + return $arch; +} + +# TODO: should probably combine this with get_download_info +sub get_sbo_downloads { + my %args = ( + LOCATION => '', + 32 => 0, + @_ + ); + $args{LOCATION} or script_error 'get_sbo_downloads requires LOCATION.'; + my $location = $args{LOCATION}; + -d $location or script_error 'get_sbo_downloads given a non-directory.'; + my $arch = get_arch; + my %dl_info; + if ($arch eq 'x86_64') { + %dl_info = get_download_info (LOCATION => $location) unless $args{32}; + } + unless (keys %dl_info > 0) { + %dl_info = get_download_info (LOCATION => $location, X64 => 0); + } + return %dl_info; +} + +# given a link, grab the filename from the end of it +sub get_filename_from_link ($) { + exists $_[0] or script_error 'get_filename_from_link requires an argument'; + return "$distfiles/". (shift =~ qr#/([^/]+)$#)[0]; +} + +# for a given file, computer its md5sum +sub compute_md5sum ($) { + -f $_[0] or script_error 'compute_md5sum requires a file argument.'; + my $fh = open_read shift; + my $md5 = Digest::MD5->new; + $md5->addfile ($fh); + my $md5sum = $md5->hexdigest; + close $fh; + return $md5sum; +} + +sub compare_md5s ($$) { + exists $_[1] or script_error 'compare_md5s requires two arguments.'; + my ($first, $second) = @_; + return $first eq $second ? 1 : 0; +} + +# for a given distfile, see whether or not it exists, and if so, if its md5sum +# matches the sbo's .info file +sub check_distfile ($$) { + exists $_[1] or script_error 'check_distfile requires two arguments.'; + my ($link, $info_md5sum) = @_; + 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; +} + +# 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 ($$) { + exists $_[1] or script_error 'get_distfile requires an argument'; + my ($link, $exp_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"; + return 1; +} + +# for a given distfile, figure out what the full path to its symlink will be +sub get_symlink_from_filename ($$) { + exists $_[1] or script_error + 'get_symlink_from_filename requires two arguments'; + -f $_[0] or script_error + 'get_symlink_from_filename first argument is not a file'; + my ($filename, $location) = @_; + return "$location/". ($filename =~ qr#/([^/]+)$#)[0]; +} + +# determine whether or not a given sbo is 32-bit only +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; +} + +# 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 () { + return 1 if -f '/etc/profile.d/32dev.sh'; + return; +} + +# make a backup of the existent SlackBuild, and rewrite the original as needed +sub rewrite_slackbuild ($$%) { + exists $_[1] or script_error 'rewrite_slackbuild requires two arguments.'; + my ($slackbuild, $tempfn, %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 $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; + } + } + untie @sb_file; + return 1; +} + +# move a backed-up .SlackBuild file back into place +sub revert_slackbuild ($) { + exists $_[0] or script_error 'revert_slackbuild requires an argument'; + my $slackbuild = shift; + if (-f "$slackbuild.orig") { + unlink $slackbuild if -f $slackbuild; + rename ("$slackbuild.orig", $slackbuild); + } + return 1; +} + +# 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 @symlinks; + for my $link (keys %downloads) { + my $md5sum = $downloads{$link}; + unless (check_distfile $link, $md5sum) { + die unless get_distfile $link, $md5sum; + } + my $filename = get_filename_from_link $link; + my $symlink = get_symlink_from_filename $filename, $location; + push @symlinks, $symlink; + symlink $filename, $symlink; + } + return @symlinks; +} + +# pull the untarred source directory or created package name from the temp +# file (the one we tee'd to) +sub grok_temp_file { + my %args = ( + TEMPFN => '', + REGEX => '', + CAPTURE => 0, + @_ + ); + unless ($args{TEMPFN} && $args{REGEX}) { + script_error 'grok_temp_file requires two arguments'; + } + my $out; + my $fh = open_read $args{TEMPFN}; + FIRST: while (my $line = <$fh>) { + if ($line =~ $args{REGEX}) { + $out = ($line =~ $args{REGEX})[$args{CAPTURE}]; + last FIRST; + } + } + close $fh; + return $out; +} + +# wrappers around grok_temp_file +sub get_src_dir ($) { + exists $_[0] or script_error 'get_src_dir requires an argument'; + return grok_temp_file (TEMPFN => shift, REGEX => qr#^([^/]+)/#); +} + +sub get_pkg_name ($) { + exists $_[0] or script_error 'get_pkg_name requires an argument'; + return grok_temp_file (TEMPFN => shift, + REGEX => qr/^Slackware\s+package\s+([^\s]+)\s+created\.$/); +} + +# prep and run .SlackBuild +sub perform_sbo { + my %args = ( + OPTS => 0, + JOBS => 0, + LOCATION => '', + ARCH => '', + C32 => 0, + X32 => 0, + @_ + ); + unless ($args{LOCATION} && $args{ARCH}) { + script_error 'perform_sbo requires LOCATION and ARCH.'; + } + my $location = $args{LOCATION}; + my $sbo = get_sbo_from_loc $location; + my ($cmd, %changes); + $changes{make} = "-j $args{JOBS}" if $args{JOBS}; + if ($args{ARCH} eq 'x86_64' and ($args{C32} || $args{X32}) ) { + if ($args{C32}) { + $changes{libdirsuffix} = ''; + } elsif ($args{X32}) { + $changes{arch_out} = 'i486'; + } + $cmd = ". /etc/profile.d/32dev.sh &&"; + } + $cmd .= "/bin/sh $location/$sbo.SlackBuild"; + $cmd = "$args{OPTS} $cmd" if $args{OPTS}; + my ($tempfh, $tempfn) = tempfile (DIR => $tempdir); + close $tempfh; + rewrite_slackbuild "$location/$sbo.SlackBuild", $tempfn, %changes; + chdir $location, my $out = system $cmd; + revert_slackbuild "$location/$sbo.SlackBuild"; + die unless $out == 0; + my $src = get_src_dir $tempfn; + my $pkg = get_pkg_name $tempfn; + unlink $tempfn; + return $pkg, $src; +} + +# "public interface", sort of thing. +sub do_slackbuild { + my %args = ( + OPTS => 0, + JOBS => 0, + LOCATION => '', + COMPAT32 => 0, + @_ + ); + $args{LOCATION} or script_error 'do_slackbuild requires LOCATION.'; + my $location = $args{LOCATION}; + my $sbo = get_sbo_from_loc $location; + my $arch = get_arch; + my $multi = check_multilib; + my $version = get_sbo_version $location; + my $x32; + if ($args{COMPAT32}) { + die "compat32 only works on x86_64.\n" unless $arch eq 'x86_64'; + die "compat32 requires multilib.\n" unless $multi; + 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) { + die "$sbo is 32-bit which requires multilib on x86_64.\n"; + } + } + } + my %downloads = get_sbo_downloads ( + LOCATION => $location, + 32 => $args{COMPAT32} + ); + my @symlinks = create_symlinks $args{LOCATION}, %downloads; + my ($pkg, $src) = perform_sbo ( + OPTS => $args{OPTS}, + JOBS => $args{JOBS}, + LOCATION => $location, + ARCH => $arch, + C32 => $args{COMPAT32}, + X32 => $x32, + ); + if ($args{COMPAT32}) { + my ($tempfh, $tempfn) = tempfile (DIR => $tempdir); + close $tempfh; + my $cmd = "/usr/sbin/convertpkg-compat32 -i $pkg -d /tmp | tee $tempfn"; + system ($cmd) == 0 or die; + unlink $pkg; + $pkg = get_pkg_name $tempfn; + } + unlink $_ for @symlinks; + return $version, $pkg, $src; +} + +# remove work directories (source and packaging dirs under /tmp/SBo) +sub make_clean ($$$) { + exists $_[2] or script_error 'make_clean requires three arguments.'; + my ($sbo, $src, $version) = @_; + print "Cleaning for $sbo-$version...\n"; + my $tmpsbo = "/tmp/SBo"; + remove_tree ("$tmpsbo/$src") if -d "$tmpsbo/$src"; + remove_tree ("$tmpsbo/package-$sbo") if -d "$tmpsbo/package-$sbo"; + return 1; +} + +# remove distfiles +sub make_distclean { + my %args = ( + SRC => '', + VERSION => '', + LOCATION => '', + @_ + ); + unless ($args{SRC} && $args{VERSION} && $args{LOCATION}) { + script_error 'make_distclean requires four arguments.'; + } + my $sbo = get_sbo_from_loc $args{LOCATION}; + make_clean $sbo, $args{SRC}, $args{VERSION}; + print "Distcleaning for $sbo-$args{VERSION}...\n"; + # 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; + unlink $filename if -f $filename; + } + return 1; +} + +# run upgradepkg for a created package +sub do_upgradepkg ($) { + exists $_[0] or script_error 'do_upgradepkg requires an argument.'; + system ('/sbin/upgradepkg', '--reinstall', '--install-new', shift); + return 1; +} diff --git a/t/do_tests.sh b/t/do_tests.sh new file mode 100755 index 0000000..54222db --- /dev/null +++ b/t/do_tests.sh @@ -0,0 +1,4 @@ +#!/usr/bin/env bash + +./prep.pl +./test.t diff --git a/t/prep.pl b/t/prep.pl new file mode 100755 index 0000000..e2fe9bf --- /dev/null +++ b/t/prep.pl @@ -0,0 +1,46 @@ +#!/usr/bin/perl + +use strict; +use warnings FATAL => 'all'; +use File::Copy; +use Tie::File; + +chomp (my $pwd = `pwd`); +mkdir "$pwd/SBO" unless -d "$pwd/SBO"; +copy ('/home/d4wnr4z0r/projects/sbotools/SBO-Lib/lib/SBO/Lib.pm', "$pwd/SBO"); +my @subs; +open my $file_h, '<', "$pwd/SBO/Lib.pm"; +my $regex = qr/^sub\s+([^\s]+)\s+/; +while (my $line = <$file_h>) { + if (my $sub = ($line =~ $regex)[0]) { + push @subs, $sub; + } +} + +seek $file_h, 0, 0; +my @not_exported; +FIRST: for my $sub (@subs) { + my $found = 'FALSE'; + my $has = 'FALSE'; + SECOND: while (my $line = <$file_h>) { + if ($found eq 'FALSE') { + $found = 'TRUE', next SECOND if $line =~ /\@EXPORT/; + } else { + last SECOND if $line =~ /^\);$/; + $has = 'TRUE', last SECOND if $line =~ /$sub/; + } + } + push @not_exported, $sub unless $has eq 'TRUE'; + seek $file_h, 0, 0; +} + +close $file_h; +tie my @file, 'Tie::File', "$pwd/SBO/Lib.pm"; +FIRST: for my $line (@file) { + if ($line =~ /\@EXPORT/) { + $line = "our \@EXPORT = qw(". join ' ', @not_exported; + } + $line = "#$line" if $line =~ /root privileges/; +} + + diff --git a/t/test.t b/t/test.t new file mode 100755 index 0000000..71eca1d --- /dev/null +++ b/t/test.t @@ -0,0 +1,95 @@ +#!/usr/bin/perl -I/home/d4wnr4z0r/projects/sbotools/t + +use 5.16.0; +use strict; +use warnings FATAL => 'all'; +use File::Temp qw(tempdir tempfile); +use Test::More tests => 39; +use SBO::Lib; + +ok (defined $SBO::Lib::tempdir, '$tempdir is defined'); + +my $fh = open_read ('/home/d4wnr4z0r/projects/sbotools/t/test.t'); +ok (ref ($fh) eq 'GLOB', 'open_read works'); +close $fh; + +ok ($SBO::Lib::config{DISTCLEAN} eq 'FALSE', 'config{DISTCLEAN} is good'); +ok ($SBO::Lib::config{JOBS} == 2, 'config{JOBS} is good'); +ok ($SBO::Lib::config{NOCLEAN} eq 'TRUE', 'config{NOCLEAN} is good'); +ok ($SBO::Lib::config{PKG_DIR} eq 'FALSE', 'config{PKG_DIR} is good'); +ok ($SBO::Lib::config{SBO_HOME} eq '/usr/sbo', 'config{SBO_HOME} is good'); + +ok (show_version == 1, 'show_version is good'); +ok (get_slack_version eq '14.0', 'get_slack_version is good'); +ok (chk_slackbuilds_txt == 1, 'check_slackbuilds_txt is good'); +#ok (rsync_sbo_tree == 1, 'rsync_sbo_tree is good'); +#ok (update_tree == 1, 'update_tree is good'); +ok (slackbuilds_or_fetch == 1, 'slackbuilds_or_fetch is good'); + +print "pseudo-random sampling of get_installed_sbos output...\n"; +my $installed = get_installed_sbos; +for my $key (keys @$installed) { + is ($$installed[$key]{version}, '1.13') if $$installed[$key]{name} eq 'OpenAL'; + is ($$installed[$key]{version}, '9.5.1_enu') if $$installed[$key]{name} eq 'adobe-reader'; + is ($$installed[$key]{version}, '4.1.3') if $$installed[$key]{name} eq 'libdvdnav'; + is ($$installed[$key]{version}, '0.8.8.4') if $$installed[$key]{name} eq '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 'zdoom'; +} +print "completed pseudo-random testing of get_installed_sbos \n"; + +is (get_sbo_location 'nginx', '/usr/sbo/network/nginx', 'get_sbo_location is good'); + +my $updates = get_available_updates; +for my $key (keys @$updates) { + is ($$updates[$key]{installed}, '1.15', '$$updates[$key]{installed} good for mutagen') if $$updates[$key]{name} eq 'mutagen'; + is ($$updates[$key]{update}, '1.20', '$$updates[$key]{update} good for mutagen') if $$updates[$key]{name} eq 'mutagen'; +} + +ok (get_arch eq 'x86_64', 'get_arch is good'); + +my %dl_info = get_download_info (LOCATION => '/usr/sbo/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', 'get_download_info test 01 good.'); +$link = 'http://www.unrealize.co.uk/source/dibeng-max-2010-11-12.zip'; +is ($dl_info{$link}, '97159d77631da13952fe87e846cf1f3b', 'get_download_info test 02 good.'); + +%dl_info = get_sbo_downloads (LOCATION => '/usr/sbo/system/wine'); +$link = 'http://downloads.sf.net/wine/source/1.4/wine-1.4.1.tar.bz2'; +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', 'get_sbo_downloads test 02 good.'); + +my %downloads = get_sbo_downloads (LOCATION => '/usr/sbo/system/ifuse'); +$link = 'http://www.libimobiledevice.org/downloads/ifuse-1.1.1.tar.bz2'; +is ($downloads{$link}, '8d528a79de024b91f12f8ac67965c37c', 'get_sbo_downloads test 03 good.'); + +is (get_filename_from_link 'http://www.libimobiledevice.org/downloads/ifuse-1.1.1.tar.bz2', '/usr/sbo/distfiles/ifuse-1.1.1.tar.bz2', 'get_file_from_link good'); +is (compute_md5sum '/usr/sbo/distfiles//laptop-mode-tools_1.61.tar.gz', '6685af5dbb34c3d51ca27933b58f484e', 'compute_md5sum good'); +is ((verify_distfile '/usr/sbo/distfiles/laptop-mode-tools_1.61.tar.gz', '6685af5dbb34c3d51ca27933b58f484e'), 1, 'verify_distfile good'); +is (get_sbo_version '/usr/sbo/system/wine', '1.4.1', 'get_sbo_version good'); +is ((get_symlink_from_filename '/usr/sbo/distfiles/laptop-mode-tools_1.61.tar.gz', '/usr/sbo/system/laptop-mode-tools'), '/usr/sbo/system/laptop-mode-tools/laptop-mode-tools_1.61.tar.gz', 'get_symlink_from_filename good'); +ok (check_x32 '/usr/sbo/system/wine', 'check_x32 true for 32-bit only wine'); +ok (!(check_x32 '/usr/sbo/system/ifuse'), 'check_x32 false for not-32-bit-only ifuse'); +ok (check_multilib, 'check_multilib good'); + +# TODO: find a way to write a test for rewrite_slackbuild, revert_slackbuild. + +%downloads = get_sbo_downloads (LOCATION => '/usr/sbo/system/wine', 32 => 1); +my @symlinks = create_symlinks '/usr/sbo/system/wine', %downloads; +is ($symlinks[0], '/usr/sbo/system/wine/wine-1.4.1.tar.bz2', '$symlinks[0] good for create_symlinks'); +is ($symlinks[1], '/usr/sbo/system/wine/dibeng-max-2010-11-12.zip', '$symlinks[1] good for create_symlinks'); + +my $tempdir = tempdir (CLEANUP => 1); +my $tempfh = tempfile (DIR => $tempdir); +my $lmt = 'laptop-mode-tools_1.60'; +print {$tempfh} "$lmt/COPYING\n"; +print {$tempfh} "$lmt/Documentation/\n"; +print {$tempfh} "$lmt/README\n"; +print {$tempfh} "Slackware package skype-2.2.0.35-i486-1_SBo.tgz created.\n"; +#close $tempfh; +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'); +%downloads = get_sbo_downloads (LOCATION => '/usr/sbo/system/wine', 32 => 1); +is ((check_distfiles %downloads), 1, 'check_distfiles good'); +#is (do_convertpkg ($package), "$package-compat32", 'do_convertpkg good'); diff --git a/t/test.t~ b/t/test.t~ new file mode 100755 index 0000000..9b0a256 --- /dev/null +++ b/t/test.t~ @@ -0,0 +1,95 @@ +#!/usr/bin/perl -I/home/d4wnr4z0r/projects/sbotools/t + +use 5.16.0; +use strict; +use warnings FATAL => 'all'; +use File::Temp qw(tempdir tempfile); +use Test::More tests => 39; +use SBO::Lib; + +ok (defined $SBO::Lib::tempdir, '$tempdir is defined'); + +my $fh = open_read ('/home/d4wnr4z0r/projects/sbotools/t/test.t'); +ok (ref ($fh) eq 'GLOB', 'open_read works'); +close $fh; + +ok ($SBO::Lib::config{DISTCLEAN} eq 'FALSE', 'config{DISTCLEAN} is good'); +ok ($SBO::Lib::config{JOBS} == 2, 'config{JOBS} is good'); +ok ($SBO::Lib::config{NOCLEAN} eq 'TRUE', 'config{NOCLEAN} is good'); +ok ($SBO::Lib::config{PKG_DIR} eq 'FALSE', 'config{PKG_DIR} is good'); +ok ($SBO::Lib::config{SBO_HOME} eq '/usr/sbo', 'config{SBO_HOME} is good'); + +ok (show_version == 1, 'show_version is good'); +ok (get_slack_version eq '14.0', 'get_slack_version is good'); +ok (chk_slackbuilds_txt == 1, 'check_slackbuilds_txt is good'); +#ok (rsync_sbo_tree == 1, 'rsync_sbo_tree is good'); +#ok (update_tree == 1, 'update_tree is good'); +ok (slackbuilds_or_fetch == 1, 'slackbuilds_or_fetch is good'); + +print "pseudo-random sampling of get_installed_sbos output...\n"; +my $installed = get_installed_sbos; +for my $key (keys @$installed) { + is ($$installed[$key]{version}, '1.13') if $$installed[$key]{name} eq 'OpenAL'; + is ($$installed[$key]{version}, '9.5.1_enu') if $$installed[$key]{name} eq 'adobe-reader'; + is ($$installed[$key]{version}, '4.1.3') if $$installed[$key]{name} eq 'libdvdnav'; + is ($$installed[$key]{version}, '0.8.8.4') if $$installed[$key]{name} eq '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 'zdoom'; +} +print "completed pseudo-random testing of get_installed_sbos \n"; + +is (get_sbo_location 'nginx', '/usr/sbo/network/nginx', 'get_sbo_location is good'); + +my $updates = get_available_updates; +for my $key (keys @$updates) { + is ($$updates[$key]{installed}, '1.15', '$$updates[$key]{installed} good for mutagen') if $$updates[$key]{name} eq 'mutagen'; + is ($$updates[$key]{update}, '1.20', '$$updates[$key]{update} good for mutagen') if $$updates[$key]{name} eq 'mutagen'; +} + +ok (get_arch eq 'x86_64', 'get_arch is good'); + +my %dl_info = get_download_info (LOCATION => '/usr/sbo/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', 'get_download_info test 01 good.'); +$link = 'http://www.unrealize.co.uk/source/dibeng-max-2010-11-12.zip'; +is ($dl_info{$link}, '97159d77631da13952fe87e846cf1f3b', 'get_download_info test 02 good.'); + +%dl_info = get_sbo_downloads (LOCATION => '/usr/sbo/system/wine'); +$link = 'http://downloads.sf.net/wine/source/1.4/wine-1.4.1.tar.bz2'; +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', 'get_sbo_downloads test 02 good.'); + +my %downloads = get_sbo_downloads (LOCATION => '/usr/sbo/system/ifuse'); +$link = 'http://www.libimobiledevice.org/downloads/ifuse-1.1.1.tar.bz2'; +is ($downloads{$link}, '8d528a79de024b91f12f8ac67965c37c', 'get_sbo_downloads test 03 good.'); + +is (get_filename_from_link 'http://www.libimobiledevice.org/downloads/ifuse-1.1.1.tar.bz2', '/usr/sbo/distfiles/ifuse-1.1.1.tar.bz2', 'get_file_from_link good'); +is (compute_md5sum '/usr/sbo/distfiles//laptop-mode-tools_1.61.tar.gz', '6685af5dbb34c3d51ca27933b58f484e', 'compute_md5sum good'); +is ((verify_distfile '/usr/sbo/distfiles/laptop-mode-tools_1.61.tar.gz', '6685af5dbb34c3d51ca27933b58f484e'), 1, 'verify_distfile good'); +is (get_sbo_version '/usr/sbo/system/wine', '1.4.1', 'get_sbo_version good'); +is ((get_symlink_from_filename '/usr/sbo/distfiles/laptop-mode-tools_1.61.tar.gz', '/usr/sbo/system/laptop-mode-tools'), '/usr/sbo/system/laptop-mode-tools/laptop-mode-tools_1.61.tar.gz', 'get_symlink_from_filename good'); +ok (check_x32 '/usr/sbo/system/wine', 'check_x32 true for 32-bit only wine'); +ok (!(check_x32 '/usr/sbo/system/ifuse'), 'check_x32 false for not-32-bit-only ifuse'); +ok (check_multilib, 'check_multilib good'); + +# TODO: find a way to write a test for rewrite_slackbuild, revert_slackbuild. + +%downloads = get_sbo_downloads (LOCATION => '/usr/sbo/system/wine', 32 => 1); +my @symlinks = create_symlinks '/usr/sbo/system/wine', %downloads; +is ($symlinks[0], '/usr/sbo/system/wine/wine-1.4.1.tar.bz2', '$symlinks[0] good for create_symlinks'); +is ($symlinks[1], '/usr/sbo/system/wine/dibeng-max-2010-11-12.zip', '$symlinks[1] good for create_symlinks'); + +my $tempdir = tempdir (CLEANUP => 1); +my $tempfh = tempfile (DIR => $tempdir); +my $lmt = 'laptop-mode-tools_1.60'; +print {$tempfh} "$lmt/COPYING\n"; +print {$tempfh} "$lmt/Documentation/\n"; +print {$tempfh} "$lmt/README\n"; +print {$tempfh} "Slackware package skype-2.2.0.35-i486-1_SBo.tgz created.\n"; +#close $tempfh; +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'); +%downloads = get_sbo_downloads (LOCATION => '/usr/sbo/system/wine', 32 => 1); +is (check_distfiles %downloads, 1, 'check_distfiles good'); +#is (do_convertpkg ($package), "$package-compat32", 'do_convertpkg good'); -- cgit v1.2.3 From f8c22cc9dd4828416555f0081c154a6adff9e80b Mon Sep 17 00:00:00 2001 From: Jacob Pipkin Date: Thu, 30 Aug 2012 14:13:18 -0500 Subject: um? --- t/SBO/Lib.pm | 43 ++++++++++++++++++--------- t/prep.pl | 2 +- t/test.t | 24 +++++++-------- t/test.t~ | 95 ------------------------------------------------------------ 4 files changed, 43 insertions(+), 121 deletions(-) delete mode 100755 t/test.t~ (limited to 't') diff --git a/t/SBO/Lib.pm b/t/SBO/Lib.pm index 398e6a3..c2b9ef5 100644 --- a/t/SBO/Lib.pm +++ b/t/SBO/Lib.pm @@ -18,7 +18,7 @@ my $version = "1.0"; 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,7 +48,6 @@ 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); @@ -61,7 +61,9 @@ sub script_error (;$) { # 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'; + 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; @@ -154,13 +156,13 @@ sub rsync_sbo_tree () { sub fetch_tree () { check_home; say 'Pulling SlackBuilds tree...'; - rsync_sbo_tree, return $?; + rsync_sbo_tree, return 1; } sub update_tree () { fetch_tree, return unless chk_slackbuilds_txt; say 'Updating SlackBuilds tree...'; - rsync_sbo_tree, return $?; + rsync_sbo_tree, return 1; } # if the SLACKBUILDS.TXT is not in $config{SBO_HOME}, we assume the tree has @@ -445,7 +447,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 +502,6 @@ sub grok_temp_file (%) { last FIRST; } } -# close $fh; return $out; } @@ -516,11 +517,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 +569,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 +584,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; @@ -666,3 +682,4 @@ sub do_upgradepkg ($) { system ('/sbin/upgradepkg', '--reinstall', '--install-new', shift); return 1; } + diff --git a/t/prep.pl b/t/prep.pl index e2fe9bf..08efc61 100755 --- a/t/prep.pl +++ b/t/prep.pl @@ -7,7 +7,7 @@ use Tie::File; chomp (my $pwd = `pwd`); mkdir "$pwd/SBO" unless -d "$pwd/SBO"; -copy ('/home/d4wnr4z0r/projects/sbotools/SBO-Lib/lib/SBO/Lib.pm', "$pwd/SBO"); +copy ('/home/d4wnr4z0r/projects/slack14/sbotools/SBO-Lib/lib/SBO/Lib.pm', "$pwd/SBO"); my @subs; open my $file_h, '<', "$pwd/SBO/Lib.pm"; my $regex = qr/^sub\s+([^\s]+)\s+/; diff --git a/t/test.t b/t/test.t index 71eca1d..9ebd5fc 100755 --- a/t/test.t +++ b/t/test.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl -I/home/d4wnr4z0r/projects/sbotools/t +#!/usr/bin/perl -I/home/d4wnr4z0r/projects/slack14/sbotools/t use 5.16.0; use strict; @@ -10,21 +10,21 @@ use SBO::Lib; ok (defined $SBO::Lib::tempdir, '$tempdir is defined'); my $fh = open_read ('/home/d4wnr4z0r/projects/sbotools/t/test.t'); -ok (ref ($fh) eq 'GLOB', 'open_read works'); +is (ref $fh, 'GLOB', 'open_read works'); close $fh; -ok ($SBO::Lib::config{DISTCLEAN} eq 'FALSE', 'config{DISTCLEAN} is good'); -ok ($SBO::Lib::config{JOBS} == 2, 'config{JOBS} is good'); -ok ($SBO::Lib::config{NOCLEAN} eq 'TRUE', 'config{NOCLEAN} is good'); -ok ($SBO::Lib::config{PKG_DIR} eq 'FALSE', 'config{PKG_DIR} is good'); -ok ($SBO::Lib::config{SBO_HOME} eq '/usr/sbo', 'config{SBO_HOME} is good'); +is ($SBO::Lib::config{DISTCLEAN}, 'FALSE', 'config{DISTCLEAN} is good'); +is ($SBO::Lib::config{JOBS}, 2, 'config{JOBS} is good'); +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}, '/usr/sbo', 'config{SBO_HOME} is good'); -ok (show_version == 1, 'show_version is good'); -ok (get_slack_version eq '14.0', 'get_slack_version is good'); -ok (chk_slackbuilds_txt == 1, 'check_slackbuilds_txt is good'); +is (show_version, 1, 'show_version is good'); +is (get_slack_version, '14.0', 'get_slack_version is good'); +is (chk_slackbuilds_txt, 1, 'check_slackbuilds_txt is good'); #ok (rsync_sbo_tree == 1, 'rsync_sbo_tree is good'); #ok (update_tree == 1, 'update_tree is good'); -ok (slackbuilds_or_fetch == 1, 'slackbuilds_or_fetch is good'); +is (slackbuilds_or_fetch, 1, 'slackbuilds_or_fetch is good'); print "pseudo-random sampling of get_installed_sbos output...\n"; my $installed = get_installed_sbos; @@ -46,7 +46,7 @@ for my $key (keys @$updates) { is ($$updates[$key]{update}, '1.20', '$$updates[$key]{update} good for mutagen') if $$updates[$key]{name} eq 'mutagen'; } -ok (get_arch eq 'x86_64', 'get_arch is good'); +is (get_arch, 'x86_64', 'get_arch is good'); my %dl_info = get_download_info (LOCATION => '/usr/sbo/system/wine', X64 => 0); my $link = 'http://downloads.sf.net/wine/source/1.4/wine-1.4.1.tar.bz2'; diff --git a/t/test.t~ b/t/test.t~ deleted file mode 100755 index 9b0a256..0000000 --- a/t/test.t~ +++ /dev/null @@ -1,95 +0,0 @@ -#!/usr/bin/perl -I/home/d4wnr4z0r/projects/sbotools/t - -use 5.16.0; -use strict; -use warnings FATAL => 'all'; -use File::Temp qw(tempdir tempfile); -use Test::More tests => 39; -use SBO::Lib; - -ok (defined $SBO::Lib::tempdir, '$tempdir is defined'); - -my $fh = open_read ('/home/d4wnr4z0r/projects/sbotools/t/test.t'); -ok (ref ($fh) eq 'GLOB', 'open_read works'); -close $fh; - -ok ($SBO::Lib::config{DISTCLEAN} eq 'FALSE', 'config{DISTCLEAN} is good'); -ok ($SBO::Lib::config{JOBS} == 2, 'config{JOBS} is good'); -ok ($SBO::Lib::config{NOCLEAN} eq 'TRUE', 'config{NOCLEAN} is good'); -ok ($SBO::Lib::config{PKG_DIR} eq 'FALSE', 'config{PKG_DIR} is good'); -ok ($SBO::Lib::config{SBO_HOME} eq '/usr/sbo', 'config{SBO_HOME} is good'); - -ok (show_version == 1, 'show_version is good'); -ok (get_slack_version eq '14.0', 'get_slack_version is good'); -ok (chk_slackbuilds_txt == 1, 'check_slackbuilds_txt is good'); -#ok (rsync_sbo_tree == 1, 'rsync_sbo_tree is good'); -#ok (update_tree == 1, 'update_tree is good'); -ok (slackbuilds_or_fetch == 1, 'slackbuilds_or_fetch is good'); - -print "pseudo-random sampling of get_installed_sbos output...\n"; -my $installed = get_installed_sbos; -for my $key (keys @$installed) { - is ($$installed[$key]{version}, '1.13') if $$installed[$key]{name} eq 'OpenAL'; - is ($$installed[$key]{version}, '9.5.1_enu') if $$installed[$key]{name} eq 'adobe-reader'; - is ($$installed[$key]{version}, '4.1.3') if $$installed[$key]{name} eq 'libdvdnav'; - is ($$installed[$key]{version}, '0.8.8.4') if $$installed[$key]{name} eq '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 'zdoom'; -} -print "completed pseudo-random testing of get_installed_sbos \n"; - -is (get_sbo_location 'nginx', '/usr/sbo/network/nginx', 'get_sbo_location is good'); - -my $updates = get_available_updates; -for my $key (keys @$updates) { - is ($$updates[$key]{installed}, '1.15', '$$updates[$key]{installed} good for mutagen') if $$updates[$key]{name} eq 'mutagen'; - is ($$updates[$key]{update}, '1.20', '$$updates[$key]{update} good for mutagen') if $$updates[$key]{name} eq 'mutagen'; -} - -ok (get_arch eq 'x86_64', 'get_arch is good'); - -my %dl_info = get_download_info (LOCATION => '/usr/sbo/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', 'get_download_info test 01 good.'); -$link = 'http://www.unrealize.co.uk/source/dibeng-max-2010-11-12.zip'; -is ($dl_info{$link}, '97159d77631da13952fe87e846cf1f3b', 'get_download_info test 02 good.'); - -%dl_info = get_sbo_downloads (LOCATION => '/usr/sbo/system/wine'); -$link = 'http://downloads.sf.net/wine/source/1.4/wine-1.4.1.tar.bz2'; -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', 'get_sbo_downloads test 02 good.'); - -my %downloads = get_sbo_downloads (LOCATION => '/usr/sbo/system/ifuse'); -$link = 'http://www.libimobiledevice.org/downloads/ifuse-1.1.1.tar.bz2'; -is ($downloads{$link}, '8d528a79de024b91f12f8ac67965c37c', 'get_sbo_downloads test 03 good.'); - -is (get_filename_from_link 'http://www.libimobiledevice.org/downloads/ifuse-1.1.1.tar.bz2', '/usr/sbo/distfiles/ifuse-1.1.1.tar.bz2', 'get_file_from_link good'); -is (compute_md5sum '/usr/sbo/distfiles//laptop-mode-tools_1.61.tar.gz', '6685af5dbb34c3d51ca27933b58f484e', 'compute_md5sum good'); -is ((verify_distfile '/usr/sbo/distfiles/laptop-mode-tools_1.61.tar.gz', '6685af5dbb34c3d51ca27933b58f484e'), 1, 'verify_distfile good'); -is (get_sbo_version '/usr/sbo/system/wine', '1.4.1', 'get_sbo_version good'); -is ((get_symlink_from_filename '/usr/sbo/distfiles/laptop-mode-tools_1.61.tar.gz', '/usr/sbo/system/laptop-mode-tools'), '/usr/sbo/system/laptop-mode-tools/laptop-mode-tools_1.61.tar.gz', 'get_symlink_from_filename good'); -ok (check_x32 '/usr/sbo/system/wine', 'check_x32 true for 32-bit only wine'); -ok (!(check_x32 '/usr/sbo/system/ifuse'), 'check_x32 false for not-32-bit-only ifuse'); -ok (check_multilib, 'check_multilib good'); - -# TODO: find a way to write a test for rewrite_slackbuild, revert_slackbuild. - -%downloads = get_sbo_downloads (LOCATION => '/usr/sbo/system/wine', 32 => 1); -my @symlinks = create_symlinks '/usr/sbo/system/wine', %downloads; -is ($symlinks[0], '/usr/sbo/system/wine/wine-1.4.1.tar.bz2', '$symlinks[0] good for create_symlinks'); -is ($symlinks[1], '/usr/sbo/system/wine/dibeng-max-2010-11-12.zip', '$symlinks[1] good for create_symlinks'); - -my $tempdir = tempdir (CLEANUP => 1); -my $tempfh = tempfile (DIR => $tempdir); -my $lmt = 'laptop-mode-tools_1.60'; -print {$tempfh} "$lmt/COPYING\n"; -print {$tempfh} "$lmt/Documentation/\n"; -print {$tempfh} "$lmt/README\n"; -print {$tempfh} "Slackware package skype-2.2.0.35-i486-1_SBo.tgz created.\n"; -#close $tempfh; -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'); -%downloads = get_sbo_downloads (LOCATION => '/usr/sbo/system/wine', 32 => 1); -is (check_distfiles %downloads, 1, 'check_distfiles good'); -#is (do_convertpkg ($package), "$package-compat32", 'do_convertpkg good'); -- cgit v1.2.3 From 12a1c8c4530ddb9ab83fec1f9b5bf61a25764e6b Mon Sep 17 00:00:00 2001 From: Jacob Pipkin Date: Fri, 31 Aug 2012 08:00:07 -0500 Subject: better testing, more still to come --- t/SBO/Lib.pm | 685 ----------------------------------------------------------- t/test.t | 169 ++++++++++++--- 2 files changed, 144 insertions(+), 710 deletions(-) delete mode 100644 t/SBO/Lib.pm (limited to 't') diff --git a/t/SBO/Lib.pm b/t/SBO/Lib.pm deleted file mode 100644 index c2b9ef5..0000000 --- a/t/SBO/Lib.pm +++ /dev/null @@ -1,685 +0,0 @@ -#!/usr/bin/env perl -# -# vim: set ts=4:noet -# -# Lib.pm -# shared functions for the sbo_ scripts. -# -# author: Jacob Pipkin -# date: Setting Orange, the 37th day of Discord in the YOLD 3178 -# license: WTFPL - -use 5.16.0; -use warnings FATAL => 'all'; -use strict; - -package SBO::Lib 1.0; -my $version = "1.0"; - -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 clear_coe_bit perform_sbo do_convertpkg - script_error - open_fh - open_read - show_version - slackbuilds_or_fetch - fetch_tree - update_tree - get_installed_sbos - get_available_updates - do_slackbuild - make_clean - make_distclean - do_upgradepkg - get_sbo_location - get_from_info - get_tmp_extfn - get_tmp_perlfn -); - -#$< == 0 or die "This script requires root privileges.\n"; - -use Tie::File; -use Sort::Versions; -use Digest::MD5; -use File::Copy; -use File::Path qw(make_path remove_tree); -use Fcntl; -use File::Find; -use File::Temp qw(tempdir tempfile); -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"; -} - -# sub for opening files, second arg is like '<','>', etc -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; -} - -sub open_read ($) { - return open_fh shift, '<'; -} - -# pull in configuration, set sane defaults, etc. -our $conf_dir = '/etc/sbotools'; -our $conf_file = "$conf_dir/sbotools.conf"; -our %config = ( - NOCLEAN => 'FALSE', - DISTCLEAN => 'FALSE', - JOBS => 'FALSE', - PKG_DIR => 'FALSE', - SBO_HOME => 'FALSE', -); - -# 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 $text = do {local $/; <$fh>}; - %conf_values = $text =~ /^(\w+)=(.*)$/mg; - close $fh; -} - -for my $key (keys %config) { - $config{$key} = $conf_values{$key} if exists $conf_values{$key}; -} -$config{JOBS} = 'FALSE' unless $config{JOBS} =~ /^\d+$/; -$config{SBO_HOME} = '/usr/sbo' if $config{SBO_HOME} eq 'FALSE'; - -# some stuff we'll need later. -my $distfiles = "$config{SBO_HOME}/distfiles"; -my $slackbuilds_txt = "$config{SBO_HOME}/SLACKBUILDS.TXT"; -my $name_regex = '\ASLACKBUILD\s+NAME:\s+'; - -sub show_version () { - say "sbotools version $version"; - say 'licensed under the WTFPL'; - say ''; -} - -# %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 $fh = open_read '/etc/slackware-version'; - chomp (my $line = <$fh>); - close $fh; - my $version = ($line =~ /\s+(\d+[^\s]+)$/)[0]; - die "Unsupported Slackware version: $version\n" - unless $version ~~ %supported; - return $supported{$version}; -} - -# does the SLACKBUILDS.TXT file exist in the sbo tree? -sub chk_slackbuilds_txt () { - return -f $slackbuilds_txt ? 1 : 0; -} - -# check for the validity of new $config{SBO_HOME} -sub check_home () { - my $sbo_home = $config{SBO_HOME}; - if (-d $sbo_home) { - opendir (my $home_handle, $sbo_home); - FIRST: while (readdir $home_handle) { - next FIRST if /^\.[\.]{0,1}$/; - die "$sbo_home exists and is not empty. Exiting.\n"; - } - } else { - 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 @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; -} - -# wrappers for differing checks and output -sub fetch_tree () { - 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 1; -} - -# if the SLACKBUILDS.TXT is not in $config{SBO_HOME}, we assume the tree has -# not been populated there; prompt the user to automagickally pull the 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] '; - =~ /^[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. -sub get_installed_sbos () { - my @installed; - # $1 == name, $2 == version - my $regex = qr#/([^/]+)-([^-]+)-[^-]+-[^-]+$#; - for my $path () { - my ($name, $version) = ($path =~ $regex)[0,1]; - push @installed, {name => $name, version => $version}; - } - return \@installed; -} - -# search the SLACKBUILDS.TXT for a given sbo's directory -sub get_sbo_location ($) { - exists $_[0] or script_error 'get_sbo_location requires an argument.'; - my $sbo = shift; - my $regex = qr#LOCATION:\s+\.(/[^/]+/$sbo)$#; - my $fh = open_read $slackbuilds_txt; - while (my $line = <$fh>) { - if (my $loc = ($line =~ $regex)[0]) { - return "$config{SBO_HOME}$loc"; - } - } - return; -} - -# pull the sbo name from a $location: $config{SBO_HOME}/system/wine, etc. -sub get_sbo_from_loc ($) { - exists $_[0] or script_error 'get_sbo_from_loc requires an argument.'; - return (shift =~ qr#/([^/]+)$#)[0]; -} - -# pull piece(s) of data, GET, from the $sbo.info file under LOCATION. -sub get_from_info (%) { - my %args = ( - LOCATION => '', - GET => '', - @_ - ); - unless ($args{LOCATION} && $args{GET}) { - script_error 'get_from_info requires LOCATION and GET.'; - } - state $vars = {PRGNAM => ['']}; - my $sbo = get_sbo_from_loc $args{LOCATION}; - return $$vars{$args{GET}} if $$vars{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. - my $contents = do {local $/; <$fh>}; - $contents =~ s/("|\\\n)//g; - $vars = {$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; - } else { - $$vars{$key} = [$$vars{$key}]; - } - } - return exists $$vars{$args{GET}} ? $$vars{$args{GET}} : 0; -} - -# 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; -} - -# for each installed sbo, find out whether or not the version in the tree is -# newer, and compile an array of hashes containing those which are -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}; - # if we can't find a location, assume invalid and skip - next FIRST unless defined $location; - my $version = get_sbo_version $location; - if (versioncmp ($version, $$pkg_list[$key]{version}) == 1) { - push @updates, { - name => $$pkg_list[$key]{name}, - installed => $$pkg_list[$key]{version}, - update => $version - }; - } - } - return \@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 (%) { - my %args = ( - LOCATION => 0, - X64 => 1, - @_ - ); - $args{LOCATION} or script_error 'get_download_info requires LOCATION.'; - my ($get, $downs, $md5s, %return); - $get = ($args{X64} ? 'DOWNLOAD_x86_64' : 'DOWNLOAD'); - $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 = 1; - } elsif ($$downs[0] =~ qr/^UN(SUPPOR|TES)TED$/) { - $nothing = 1; - } - if ($nothing) { - $args{X64} = 0; - $downs = get_from_info (LOCATION => $args{LOCATION}, - GET => 'DOWNLOAD'); - } - } - # if we still don't have any links, something is really wrong. - return unless $$downs[0]; - # grab the md5s and build a hash - $get = $args{X64} ? 'MD5SUM_x86_64' : 'MD5SUM'; - $md5s = get_from_info (LOCATION => $args{LOCATION}, GET => $get); - return unless $$md5s[0]; - $return{$$downs[$_]} = $$md5s[$_] for (keys @$downs); - return %return; -} - -sub get_arch () { - chomp (my $arch = `uname -m`); - return $arch; -} - -# TODO: should probably combine this with get_download_info -sub get_sbo_downloads (%) { - my %args = ( - LOCATION => '', - 32 => 0, - @_ - ); - $args{LOCATION} or script_error 'get_sbo_downloads requires LOCATION.'; - my $location = $args{LOCATION}; - -d $location or script_error 'get_sbo_downloads given a non-directory.'; - my $arch = get_arch; - my %dl_info; - if ($arch eq 'x86_64') { - %dl_info = get_download_info (LOCATION => $location) unless $args{32}; - } - unless (keys %dl_info > 0) { - %dl_info = get_download_info (LOCATION => $location, X64 => 0); - } - return %dl_info; -} - -# given a link, grab the filename from the end of it -sub get_filename_from_link ($) { - exists $_[0] or script_error 'get_filename_from_link requires an argument'; - return "$distfiles/". (shift =~ qr#/([^/]+)$#)[0]; -} - -# for a given file, computer its md5sum -sub compute_md5sum ($) { - -f $_[0] or script_error 'compute_md5sum requires a file argument.'; - my $fh = open_read shift; - my $md5 = Digest::MD5->new; - $md5->addfile ($fh); - my $md5sum = $md5->hexdigest; - close $fh; - return $md5sum; -} - -sub compare_md5s ($$) { - exists $_[1] or script_error 'compare_md5s requires two arguments.'; - my ($first, $second) = @_; - return $first eq $second ? 1 : 0; -} - -# 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 ($$) { - exists $_[1] or script_error 'check_distfile requires two arguments.'; - my ($link, $info_md5sum) = @_; - 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; -} - -# 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 ($$) { - exists $_[1] or script_error 'get_distfile requires an argument'; - my ($link, $exp_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"; - return 1; -} - -# for a given distfile, figure out what the full path to its symlink will be -sub get_symlink_from_filename ($$) { - exists $_[1] or script_error - 'get_symlink_from_filename requires two arguments'; - -f $_[0] or script_error - 'get_symlink_from_filename first argument is not a file'; - my ($filename, $location) = @_; - return "$location/". ($filename =~ qr#/([^/]+)$#)[0]; -} - -# determine whether or not a given sbo is 32-bit only -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; -} - -# 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 () { - return 1 if -f '/etc/profile.d/32dev.sh'; - return; -} - -# make a backup of the existent SlackBuild, and rewrite the original as needed -sub rewrite_slackbuild ($$%) { - exists $_[1] or script_error 'rewrite_slackbuild requires two arguments.'; - my ($slackbuild, $tempfn, %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 $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; - } - } - untie @sb_file; - return 1; -} - -# move a backed-up .SlackBuild file back into place -sub revert_slackbuild ($) { - exists $_[0] or script_error 'revert_slackbuild requires an argument'; - my $slackbuild = shift; - if (-f "$slackbuild.orig") { - unlink $slackbuild if -f $slackbuild; - rename "$slackbuild.orig", $slackbuild; - } - return 1; -} - -# for each $download, see if we have it, and if the copy we have is good, -# otherwise download a new copy -sub check_distfiles (%) { - exists $_[0] or script_error 'check_distfiles requires an argument.'; - my %dists = @_; - for my $link (keys %dists) { - my $md5sum = $dists{$link}; - unless (verify_distfile $link, $md5sum) { - die unless get_distfile $link, $md5sum; - } - } - return 1; -} - -# 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 @symlinks; - 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; -} - -# pull the untarred source directory or created package name from the temp -# file (the one we tee'd to) -sub grok_temp_file (%) { - my %args = ( - FH => '', - REGEX => '', - CAPTURE => 0, - @_ - ); - unless ($args{FH} && $args{REGEX}) { - script_error 'grok_temp_file requires two arguments'; - } - my $fh = $args{FH}; - seek $fh, 0, 0; - my $out; - FIRST: while (my $line = <$fh>) { - if ($line =~ $args{REGEX}) { - $out = ($line =~ $args{REGEX})[$args{CAPTURE}]; - last FIRST; - } - } - return $out; -} - -# wrappers around grok_temp_file -sub get_src_dir ($) { - exists $_[0] or script_error 'get_src_dir requires an argument'; - return grok_temp_file (FH => shift, REGEX => qr#^([^/]+)/#); -} - -sub get_pkg_name ($) { - exists $_[0] or script_error 'get_pkg_name requires an argument'; - return grok_temp_file (FH => shift, - REGEX => qr/^Slackware\s+package\s+([^\s]+)\s+created\.$/); -} - -# 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 $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 -sub perform_sbo (%) { - my %args = ( - OPTS => 0, - JOBS => 0, - LOCATION => '', - ARCH => '', - C32 => 0, - X32 => 0, - @_ - ); - unless ($args{LOCATION} && $args{ARCH}) { - script_error 'perform_sbo requires LOCATION and ARCH.'; - } - my $location = $args{LOCATION}; - my $sbo = get_sbo_from_loc $location; - my ($cmd, %changes); - # figure out any changes we need to make to the .SlackBuild - $changes{make} = "-j $args{JOBS}" if $args{JOBS}; - if ($args{ARCH} eq 'x86_64' and ($args{C32} || $args{X32})) { - if ($args{C32}) { - $changes{libdirsuffix} = ''; - } elsif ($args{X32}) { - $changes{arch_out} = 'i486'; - } - $cmd = ". /etc/profile.d/32dev.sh &&"; - } - $cmd .= "/bin/sh $location/$sbo.SlackBuild"; - $cmd = "$args{OPTS} $cmd" if $args{OPTS}; - my $tempfh = tempfile (DIR => $tempdir); - my $fn = get_tmp_extfn $tempfh; - rewrite_slackbuild "$location/$sbo.SlackBuild", $fn, %changes; - chdir $location, my $out = system $cmd; - revert_slackbuild "$location/$sbo.SlackBuild"; - die unless $out == 0; - my $pkg = get_pkg_name $tempfh; - my $src = get_src_dir $tempfh; - return $pkg, $src; -} - -# run convertpkg on a package to turn it into a -compat32 thing -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_extfn $tempfh; - my $cmd = "/usr/sbin/convertpkg-compat32 -i $pkg -d /tmp | tee $fn"; - system ($cmd) == 0 or die; - unlink $pkg; - return get_pkg_name $tempfh; -} - -# "public interface", sort of thing. -sub do_slackbuild (%) { - my %args = ( - OPTS => 0, - JOBS => 0, - LOCATION => '', - COMPAT32 => 0, - @_ - ); - $args{LOCATION} or script_error 'do_slackbuild requires LOCATION.'; - my $location = $args{LOCATION}; - my $sbo = get_sbo_from_loc $location; - my $arch = get_arch; - my $multi = 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 only works on x86_64.\n" unless $arch eq 'x86_64'; - die "compat32 requires multilib.\n" unless $multi; - 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) { - die "$sbo is 32-bit which requires multilib on x86_64.\n"; - } - } - } - # get a hash of downloads and md5sums, ensure we have 'em, symlink 'em - my %downloads = get_sbo_downloads ( - LOCATION => $location, - 32 => $args{COMPAT32} - ); - check_distfiles %downloads; - my @symlinks = create_symlinks $args{LOCATION}, %downloads; - # setup and run the .SlackBuild itself - my ($pkg, $src) = perform_sbo ( - OPTS => $args{OPTS}, - JOBS => $args{JOBS}, - LOCATION => $location, - ARCH => $arch, - C32 => $args{COMPAT32}, - X32 => $x32, - ); - do_convertpkg $pkg if $args{COMPAT32}; - unlink $_ for @symlinks; - return $version, $pkg, $src; -} - -# remove work directories (source and packaging dirs under /tmp/SBo) -sub make_clean ($$$) { - exists $_[2] or script_error 'make_clean requires three arguments.'; - my ($sbo, $src, $version) = @_; - say "Cleaning for $sbo-$version..."; - my $tmpsbo = "/tmp/SBo"; - remove_tree ("$tmpsbo/$src") if -d "$tmpsbo/$src"; - remove_tree ("$tmpsbo/package-$sbo") if -d "$tmpsbo/package-$sbo"; - return 1; -} - -# remove distfiles -sub make_distclean (%) { - my %args = ( - SRC => '', - VERSION => '', - LOCATION => '', - @_ - ); - unless ($args{SRC} && $args{VERSION} && $args{LOCATION}) { - script_error 'make_distclean requires four arguments.'; - } - 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. - my %downloads = get_sbo_downloads (LOCATION => $args{LOCATION}); - for my $key (keys %downloads) { - my $filename = get_filename_from_link $key; - unlink $filename if -f $filename; - } - return 1; -} - -# run upgradepkg for a created package -sub do_upgradepkg ($) { - exists $_[0] or script_error 'do_upgradepkg requires an argument.'; - system ('/sbin/upgradepkg', '--reinstall', '--install-new', shift); - return 1; -} - diff --git a/t/test.t b/t/test.t index 9ebd5fc..aabb5fa 100755 --- a/t/test.t +++ b/t/test.t @@ -4,28 +4,45 @@ use 5.16.0; use strict; use warnings FATAL => 'all'; use File::Temp qw(tempdir tempfile); -use Test::More tests => 39; +use Test::More tests => 61; +use File::Copy; +use Text::Diff; use SBO::Lib; -ok (defined $SBO::Lib::tempdir, '$tempdir is defined'); +my $sbo_home = '/home/d4wnr4z0r/sbo.git/slackbuilds'; -my $fh = open_read ('/home/d4wnr4z0r/projects/sbotools/t/test.t'); +# 1, 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; +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'); 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}, '/usr/sbo', 'config{SBO_HOME} is good'); +is ($SBO::Lib::config{SBO_HOME}, "$sbo_home", 'config{SBO_HOME} is good'); +# 8, show_version test is (show_version, 1, 'show_version is good'); + +# 9, get_slack_version test is (get_slack_version, '14.0', 'get_slack_version is good'); -is (chk_slackbuilds_txt, 1, 'check_slackbuilds_txt 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'); +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 is (slackbuilds_or_fetch, 1, 'slackbuilds_or_fetch is good'); +# 13-18, get_installed_sbos test print "pseudo-random sampling of get_installed_sbos output...\n"; my $installed = get_installed_sbos; for my $key (keys @$installed) { @@ -38,48 +55,67 @@ for my $key (keys @$installed) { } print "completed pseudo-random testing of get_installed_sbos \n"; -is (get_sbo_location 'nginx', '/usr/sbo/network/nginx', 'get_sbo_location is good'); +# 19-20, get_sbo_location tests +is (get_sbo_location 'nginx', "$sbo_home/network/nginx", 'get_sbo_location is good'); +is (get_sbo_location 'omgwtfbbq', undef, 'get_sbo_location returns false with not-an-sbo input'); +# 21-22, get_available_updates tests my $updates = get_available_updates; for my $key (keys @$updates) { is ($$updates[$key]{installed}, '1.15', '$$updates[$key]{installed} good for mutagen') if $$updates[$key]{name} eq 'mutagen'; is ($$updates[$key]{update}, '1.20', '$$updates[$key]{update} good for mutagen') if $$updates[$key]{name} eq 'mutagen'; } +# 23, get_arch test is (get_arch, 'x86_64', 'get_arch is good'); -my %dl_info = get_download_info (LOCATION => '/usr/sbo/system/wine', X64 => 0); +# 24-25, 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', 'get_download_info test 01 good.'); $link = 'http://www.unrealize.co.uk/source/dibeng-max-2010-11-12.zip'; is ($dl_info{$link}, '97159d77631da13952fe87e846cf1f3b', 'get_download_info test 02 good.'); -%dl_info = get_sbo_downloads (LOCATION => '/usr/sbo/system/wine'); +# 26-28, 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', 'get_sbo_downloads test 01 good.'); $link = 'http://www.unrealize.co.uk/source/dibeng-max-2010-11-12.zip'; is ($dl_info{$link}, '97159d77631da13952fe87e846cf1f3b', 'get_sbo_downloads test 02 good.'); - -my %downloads = get_sbo_downloads (LOCATION => '/usr/sbo/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', 'get_sbo_downloads test 03 good.'); -is (get_filename_from_link 'http://www.libimobiledevice.org/downloads/ifuse-1.1.1.tar.bz2', '/usr/sbo/distfiles/ifuse-1.1.1.tar.bz2', 'get_file_from_link good'); -is (compute_md5sum '/usr/sbo/distfiles//laptop-mode-tools_1.61.tar.gz', '6685af5dbb34c3d51ca27933b58f484e', 'compute_md5sum good'); -is ((verify_distfile '/usr/sbo/distfiles/laptop-mode-tools_1.61.tar.gz', '6685af5dbb34c3d51ca27933b58f484e'), 1, 'verify_distfile good'); -is (get_sbo_version '/usr/sbo/system/wine', '1.4.1', 'get_sbo_version good'); -is ((get_symlink_from_filename '/usr/sbo/distfiles/laptop-mode-tools_1.61.tar.gz', '/usr/sbo/system/laptop-mode-tools'), '/usr/sbo/system/laptop-mode-tools/laptop-mode-tools_1.61.tar.gz', 'get_symlink_from_filename good'); -ok (check_x32 '/usr/sbo/system/wine', 'check_x32 true for 32-bit only wine'); -ok (!(check_x32 '/usr/sbo/system/ifuse'), 'check_x32 false for not-32-bit-only ifuse'); -ok (check_multilib, 'check_multilib good'); +# 29, 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 +is (compute_md5sum "$sbo_home/distfiles/laptop-mode-tools_1.61.tar.gz", '6685af5dbb34c3d51ca27933b58f484e', 'compute_md5sum good'); -# TODO: find a way to write a test for rewrite_slackbuild, revert_slackbuild. +# 32, verify_distfile test +is ((verify_distfile "$sbo_home/distfiles/laptop-mode-tools_1.61.tar.gz", '6685af5dbb34c3d51ca27933b58f484e'), 1, 'verify_distfile good'); -%downloads = get_sbo_downloads (LOCATION => '/usr/sbo/system/wine', 32 => 1); -my @symlinks = create_symlinks '/usr/sbo/system/wine', %downloads; -is ($symlinks[0], '/usr/sbo/system/wine/wine-1.4.1.tar.bz2', '$symlinks[0] good for create_symlinks'); -is ($symlinks[1], '/usr/sbo/system/wine/dibeng-max-2010-11-12.zip', '$symlinks[1] good for create_symlinks'); +# 33, 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 +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 +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 +ok (check_multilib, 'check_multilib good'); + +# 38-39, 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", '$symlinks[0] good for create_symlinks'); +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 my $tempdir = tempdir (CLEANUP => 1); my $tempfh = tempfile (DIR => $tempdir); my $lmt = 'laptop-mode-tools_1.60'; @@ -87,9 +123,92 @@ print {$tempfh} "$lmt/COPYING\n"; print {$tempfh} "$lmt/Documentation/\n"; print {$tempfh} "$lmt/README\n"; print {$tempfh} "Slackware package skype-2.2.0.35-i486-1_SBo.tgz created.\n"; -#close $tempfh; 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'); -%downloads = get_sbo_downloads (LOCATION => '/usr/sbo/system/wine', 32 => 1); +close $tempfh; + +# 42, 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 +system ('sudo /usr/sbin/sboconfig -s /home/d4wnr4z0r/opt_sbo') == 0 or die "unable to set sboconfig -s\n"; +read_config; +ok (check_home, 'check_home returns true with new non-existent directory'); +ok (-d '/home/d4wnr4z0r/opt_sbo', 'check_home creates $config{SBO_HOME}'); +ok (check_home, 'check_home returns true with new existent empty directory'); +system ("sudo /usr/sbin/sboconfig -s $sbo_home") == 0 or die "unable to reset sboconfig -s\n"; +read_config; +rmdir "/home/d4wnr4z0r/opt_sbo"; + +# 46-47 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'), 0, 'compare_md5s returns false for not-matching parameters'); + +# 50, get_distfile tests +my $distfile = "$sbo_home/distfiles/Sort-Versions-1.5.tar.gz"; +unlink $distfile if -f $distfile; +is (get_distfile ('http://search.cpan.org/CPAN/authors/id/E/ED/EDAVIS/Sort-Versions-1.5.tar.gz', '5434f948fdea6406851c77bebbd0ed19'), 1, 'get_distfile is good'); +unlink $distfile; + +# 51-58, 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"; +$tempfh = tempfile (DIR => $rewrite_dir); +my $tempfn = get_tmp_extfn $tempfh; +my %changes; +is (rewrite_slackbuild ($slackbuild, $tempfn, %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'; +$changes{arch_out} = 'i486'; +is (rewrite_slackbuild ($slackbuild, $tempfn, %changes), 1, 'rewrite_slackbuild with all %changes good'); +ok (-f "$slackbuild.orig", 'rewrite_slackbuild backing up original is good.'); +$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 +"; +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 +my $test_loc = "$sbo_home/system/ifuse"; +my %params = (LOCATION => $test_loc); +my $info = get_from_info (%params, GET => 'VERSION'); +is ($$info[0], '1.1.1', 'get_from_info GET => VERSION is good'); +$info = get_from_info (%params, GET => 'HOMEPAGE'); +is ($$info[0], 'http://www.libimobiledevice.org', 'get_from_info GET => HOMEPAGE is good'); +$info = get_from_info (%params, GET => 'DOWNLOAD_x86_64'); +is ($$info[0], "", 'get_from_info GET => DOWNLOAD_x86_64 is good'); + + #is (do_convertpkg ($package), "$package-compat32", 'do_convertpkg good'); -- cgit v1.2.3 From d55dbdf17977ed9b1dfd91c98a4a569960b851cd Mon Sep 17 00:00:00 2001 From: Jacob Pipkin Date: Fri, 31 Aug 2012 15:53:21 -0500 Subject: epic changes and fixes and much further testing --- t/SBO/Lib.pm~ | 643 ---------------------------------------------------------- t/prep.pl | 44 ++++ t/test.t | 73 ++++++- 3 files changed, 115 insertions(+), 645 deletions(-) delete mode 100644 t/SBO/Lib.pm~ (limited to 't') diff --git a/t/SBO/Lib.pm~ b/t/SBO/Lib.pm~ deleted file mode 100644 index be29986..0000000 --- a/t/SBO/Lib.pm~ +++ /dev/null @@ -1,643 +0,0 @@ -#!/usr/bin/env perl -# -# vim: set ts=4:noet -# -# Lib.pm -# shared functions for the sbo_ scripts. -# -# author: Jacob Pipkin -# date: Setting Orange, the 37th day of Discord in the YOLD 3178 -# license: WTFPL - -use 5.16.0; -use warnings FATAL => 'all'; -use strict; - -package SBO::Lib 1.0; -my $version = "1.0"; - -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 check_distfile get_distfile get_symlink_from_filename check_x32 check_multilib rewrite_slackbuild revert_slackbuild create_symlinks grok_temp_file get_src_dir get_pkg_name perform_sbo - script_error - open_fh - open_read - show_version - slackbuilds_or_fetch - fetch_tree - update_tree - get_installed_sbos - get_available_updates - do_slackbuild - make_clean - make_distclean - do_upgradepkg - get_sbo_location - get_from_info -); - -#$< == 0 or die "This script requires root privileges.\n"; - -use Tie::File; -use Sort::Versions; -use Digest::MD5; -use File::Copy; -use File::Path qw(make_path remove_tree); -use Fcntl; -use File::Find; -use File::Temp qw(tempdir tempfile); -use Data::Dumper; - -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"; -} - -# 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'; - my ($file, $op) = @_; - open my $fh, $op, $file or die "Unable to open $file.\n"; - return $fh; -} - -sub open_read ($) { - return open_fh shift, '<'; -} - -# pull in configuration, set sane defaults, etc. -our $conf_dir = '/etc/sbotools'; -our $conf_file = "$conf_dir/sbotools.conf"; -our %config = ( - NOCLEAN => 'FALSE', - DISTCLEAN => 'FALSE', - JOBS => 'FALSE', - PKG_DIR => 'FALSE', - SBO_HOME => 'FALSE', -); - -# 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 $text = do {local $/; <$fh>}; - %conf_values = $text =~ /^(\w+)=(.*)$/mg; - close $fh; -} - -for my $key (keys %config) { - $config{$key} = $conf_values{$key} if exists $conf_values{$key}; -} -$config{JOBS} = 'FALSE' unless $config{JOBS} =~ /^\d+$/; -$config{SBO_HOME} = '/usr/sbo' if $config{SBO_HOME} eq 'FALSE'; - -# some stuff we'll need later. -my $distfiles = "$config{SBO_HOME}/distfiles"; -my $slackbuilds_txt = "$config{SBO_HOME}/SLACKBUILDS.TXT"; -my $name_regex = '\ASLACKBUILD\s+NAME:\s+'; - -sub show_version () { - print "sbotools version $version\n"; - print "licensed under the WTFPL\n"; - print "\n"; -} - -# %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 $fh = open_read '/etc/slackware-version'; - chomp (my $line = <$fh>); - close $fh; - my $version = ($line =~ /\s+(\d+[^\s]+)$/)[0]; - die "Unsupported Slackware version: $version\n" - unless $version ~~ %supported; - return $supported{$version}; -} - -# does the SLACKBUILDS.TXT file exist in the sbo tree? -sub chk_slackbuilds_txt () { - return -f $slackbuilds_txt ? 1 : 0; -} - -# check for the validity of new $config{SBO_HOME} -sub check_home () { - my $sbo_home = $config{SBO_HOME}; - if (-d $sbo_home) { - opendir (my $home_handle, $sbo_home); - FIRST: while (readdir $home_handle) { - next FIRST if /^\.[\.]{0,1}$/; - die "$sbo_home exists and is not empty. Exiting.\n"; - } - } else { - 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 @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}; - print "Finished.\n" and return $out; -} - -# wrappers for differing checks and output -sub fetch_tree () { - check_home; - print "Pulling SlackBuilds tree...\n"; - rsync_sbo_tree, return $?; -} - -sub update_tree () { - fetch_tree, return unless chk_slackbuilds_txt; - print "Updating SlackBuilds tree...\n"; - rsync_sbo_tree, return $?; -} - -# if the SLACKBUILDS.TXT is not in $config{SBO_HOME}, we assume the tree has -# not been populated there; prompt the user to automagickally pull the tree. -sub slackbuilds_or_fetch () { - unless (chk_slackbuilds_txt) { - print "It looks like you haven't run \"sbosnap fetch\" yet.\n"; - print "Would you like me to do this now? [y] "; - =~ /^[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. -sub get_installed_sbos () { - my @installed; - # $1 == name, $2 == version - my $regex = qr#/([^/]+)-([^-]+)-[^-]+-[^-]+$#; - for my $path () { - my ($name, $version) = ($path =~ $regex)[0,1]; - push @installed, {name => $name, version => $version}; - } - return \@installed; -} - -# search the SLACKBUILDS.TXT for a given sbo's directory -sub get_sbo_location ($) { - exists $_[0] or script_error 'get_sbo_location requires an argument.'; - my $sbo = shift; - my $regex = qr#LOCATION:\s+\.(/[^/]+/$sbo)$#; - my $fh = open_read $slackbuilds_txt; - while (my $line = <$fh>) { - if (my $loc = ($line =~ $regex)[0]) { - return "$config{SBO_HOME}$loc"; - } - } - return; -} - -# pull the sbo name from a $location: $config{SBO_HOME}/system/wine, etc. -sub get_sbo_from_loc ($) { - exists $_[0] or script_error 'get_sbo_from_loc requires an argument.'; - return (shift =~ qr#/([^/]+)$#)[0]; -} - -# pull piece(s) of data, GET, from the $sbo.info file under LOCATION. -sub get_from_info { - warn " * * * * * * * * * * in get_from_info sub * * * * * * * * * *\n"; - my %args = ( - LOCATION => '', - GET => '', - @_ - ); - unless ($args{LOCATION} && $args{GET}) { - script_error 'get_from_info requires LOCATION and GET.'; - } - state $vars = {PKGNAM => ['']}; - my $sbo = get_sbo_from_loc $args{LOCATION}; - print Dumper ($vars); - return $$vars{$args{GET}} if $$vars{PKGNAM}[0] eq $sbo; - # if we haven't read in the .info file yet, do so now. - warn " * * * * * * * * * * parsing $sbo.info file * * * * * * * * * *\n"; - my $fh = open_read "$args{LOCATION}/$sbo.info"; - # suck it all in and join up the \ lines... - my $contents = do {local $/; <$fh>}; - $contents =~ s/("|\\\n)//g; - my %tmp = $contents =~ /^(\w+)=(.*)$/mg; - $vars = \%tmp; - # 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; - } else { - $$vars{$key} = [$$vars{$key}]; - } - } - return $$vars{$args{GET}}; -} - -# 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; -} - -# for each installed sbo, find out whether or not the version in the tree is -# newer, and compile an array of hashes containing those which are -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}; - # if we can't find a location, assume invalid and skip - next FIRST unless defined $location; - my $version = get_sbo_version $location; - if (versioncmp ($version, $$pkg_list[$key]{version}) == 1) { - push @updates, { - name => $$pkg_list[$key]{name}, - installed => $$pkg_list[$key]{version}, - update => $version - }; - } - } - return \@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 { - my %args = ( - LOCATION => 0, - X64 => 1, - @_ - ); - $args{LOCATION} or script_error 'get_download_info requires LOCATION.'; - my ($get, $downs, $md5s, %return); - $get = ($args{X64} ? 'DOWNLOAD_x86_64' : 'DOWNLOAD'); - $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 = 1; - } elsif ($$downs[0] =~ qr/^UN(SUPPOR|TES)TED$/) { - $nothing = 1; - } - if ($nothing) { - $args{X64} = 0; - $downs = get_from_info (LOCATION => $args{LOCATION}, - GET => 'DOWNLOAD'); - } - } - # if we still don't have any links, something is really wrong. - return unless $$downs[0]; - # grab the md5s and build a hash - $get = $args{X64} ? 'MD5SUM_x86_64' : 'MD5SUM'; - $md5s = get_from_info (LOCATION => $args{LOCATION}, GET => $get); - return unless $$md5s[0]; - $return{$$downs[$_]} = $$md5s[$_] for (keys @$downs); - return %return; -} - -sub get_arch () { - chomp (my $arch = `uname -m`); - return $arch; -} - -# TODO: should probably combine this with get_download_info -sub get_sbo_downloads { - my %args = ( - LOCATION => '', - 32 => 0, - @_ - ); - $args{LOCATION} or script_error 'get_sbo_downloads requires LOCATION.'; - my $location = $args{LOCATION}; - -d $location or script_error 'get_sbo_downloads given a non-directory.'; - my $arch = get_arch; - my %dl_info; - if ($arch eq 'x86_64') { - %dl_info = get_download_info (LOCATION => $location) unless $args{32}; - } - unless (keys %dl_info > 0) { - %dl_info = get_download_info (LOCATION => $location, X64 => 0); - } - return %dl_info; -} - -# given a link, grab the filename from the end of it -sub get_filename_from_link ($) { - exists $_[0] or script_error 'get_filename_from_link requires an argument'; - return "$distfiles/". (shift =~ qr#/([^/]+)$#)[0]; -} - -# for a given file, computer its md5sum -sub compute_md5sum ($) { - -f $_[0] or script_error 'compute_md5sum requires a file argument.'; - my $fh = open_read shift; - my $md5 = Digest::MD5->new; - $md5->addfile ($fh); - my $md5sum = $md5->hexdigest; - close $fh; - return $md5sum; -} - -sub compare_md5s ($$) { - exists $_[1] or script_error 'compare_md5s requires two arguments.'; - my ($first, $second) = @_; - return $first eq $second ? 1 : 0; -} - -# for a given distfile, see whether or not it exists, and if so, if its md5sum -# matches the sbo's .info file -sub check_distfile ($$) { - exists $_[1] or script_error 'check_distfile requires two arguments.'; - my ($link, $info_md5sum) = @_; - 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; -} - -# 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 ($$) { - exists $_[1] or script_error 'get_distfile requires an argument'; - my ($link, $exp_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"; - return 1; -} - -# for a given distfile, figure out what the full path to its symlink will be -sub get_symlink_from_filename ($$) { - exists $_[1] or script_error - 'get_symlink_from_filename requires two arguments'; - -f $_[0] or script_error - 'get_symlink_from_filename first argument is not a file'; - my ($filename, $location) = @_; - return "$location/". ($filename =~ qr#/([^/]+)$#)[0]; -} - -# determine whether or not a given sbo is 32-bit only -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; -} - -# 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 () { - return 1 if -f '/etc/profile.d/32dev.sh'; - return; -} - -# make a backup of the existent SlackBuild, and rewrite the original as needed -sub rewrite_slackbuild ($$%) { - exists $_[1] or script_error 'rewrite_slackbuild requires two arguments.'; - my ($slackbuild, $tempfn, %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 $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; - } - } - untie @sb_file; - return 1; -} - -# move a backed-up .SlackBuild file back into place -sub revert_slackbuild ($) { - exists $_[0] or script_error 'revert_slackbuild requires an argument'; - my $slackbuild = shift; - if (-f "$slackbuild.orig") { - unlink $slackbuild if -f $slackbuild; - rename ("$slackbuild.orig", $slackbuild); - } - return 1; -} - -# 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 @symlinks; - for my $link (keys %downloads) { - my $md5sum = $downloads{$link}; - unless (check_distfile $link, $md5sum) { - die unless get_distfile $link, $md5sum; - } - my $filename = get_filename_from_link $link; - my $symlink = get_symlink_from_filename $filename, $location; - push @symlinks, $symlink; - symlink $filename, $symlink; - } - return @symlinks; -} - -# pull the untarred source directory or created package name from the temp -# file (the one we tee'd to) -sub grok_temp_file { - my %args = ( - TEMPFN => '', - REGEX => '', - CAPTURE => 0, - @_ - ); - unless ($args{TEMPFN} && $args{REGEX}) { - script_error 'grok_temp_file requires two arguments'; - } - my $out; - my $fh = open_read $args{TEMPFN}; - FIRST: while (my $line = <$fh>) { - if ($line =~ $args{REGEX}) { - $out = ($line =~ $args{REGEX})[$args{CAPTURE}]; - last FIRST; - } - } - close $fh; - return $out; -} - -# wrappers around grok_temp_file -sub get_src_dir ($) { - exists $_[0] or script_error 'get_src_dir requires an argument'; - return grok_temp_file (TEMPFN => shift, REGEX => qr#^([^/]+)/#); -} - -sub get_pkg_name ($) { - exists $_[0] or script_error 'get_pkg_name requires an argument'; - return grok_temp_file (TEMPFN => shift, - REGEX => qr/^Slackware\s+package\s+([^\s]+)\s+created\.$/); -} - -# prep and run .SlackBuild -sub perform_sbo { - my %args = ( - OPTS => 0, - JOBS => 0, - LOCATION => '', - ARCH => '', - C32 => 0, - X32 => 0, - @_ - ); - unless ($args{LOCATION} && $args{ARCH}) { - script_error 'perform_sbo requires LOCATION and ARCH.'; - } - my $location = $args{LOCATION}; - my $sbo = get_sbo_from_loc $location; - my ($cmd, %changes); - $changes{make} = "-j $args{JOBS}" if $args{JOBS}; - if ($args{ARCH} eq 'x86_64' and ($args{C32} || $args{X32}) ) { - if ($args{C32}) { - $changes{libdirsuffix} = ''; - } elsif ($args{X32}) { - $changes{arch_out} = 'i486'; - } - $cmd = ". /etc/profile.d/32dev.sh &&"; - } - $cmd .= "/bin/sh $location/$sbo.SlackBuild"; - $cmd = "$args{OPTS} $cmd" if $args{OPTS}; - my ($tempfh, $tempfn) = tempfile (DIR => $tempdir); - close $tempfh; - rewrite_slackbuild "$location/$sbo.SlackBuild", $tempfn, %changes; - chdir $location, my $out = system $cmd; - revert_slackbuild "$location/$sbo.SlackBuild"; - die unless $out == 0; - my $src = get_src_dir $tempfn; - my $pkg = get_pkg_name $tempfn; - unlink $tempfn; - return $pkg, $src; -} - -# "public interface", sort of thing. -sub do_slackbuild { - my %args = ( - OPTS => 0, - JOBS => 0, - LOCATION => '', - COMPAT32 => 0, - @_ - ); - $args{LOCATION} or script_error 'do_slackbuild requires LOCATION.'; - my $location = $args{LOCATION}; - my $sbo = get_sbo_from_loc $location; - my $arch = get_arch; - my $multi = check_multilib; - my $version = get_sbo_version $location; - my $x32; - if ($args{COMPAT32}) { - die "compat32 only works on x86_64.\n" unless $arch eq 'x86_64'; - die "compat32 requires multilib.\n" unless $multi; - 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) { - die "$sbo is 32-bit which requires multilib on x86_64.\n"; - } - } - } - my %downloads = get_sbo_downloads ( - LOCATION => $location, - 32 => $args{COMPAT32} - ); - my @symlinks = create_symlinks $args{LOCATION}, %downloads; - my ($pkg, $src) = perform_sbo ( - OPTS => $args{OPTS}, - JOBS => $args{JOBS}, - LOCATION => $location, - ARCH => $arch, - C32 => $args{COMPAT32}, - X32 => $x32, - ); - if ($args{COMPAT32}) { - my ($tempfh, $tempfn) = tempfile (DIR => $tempdir); - close $tempfh; - my $cmd = "/usr/sbin/convertpkg-compat32 -i $pkg -d /tmp | tee $tempfn"; - system ($cmd) == 0 or die; - unlink $pkg; - $pkg = get_pkg_name $tempfn; - } - unlink $_ for @symlinks; - return $version, $pkg, $src; -} - -# remove work directories (source and packaging dirs under /tmp/SBo) -sub make_clean ($$$) { - exists $_[2] or script_error 'make_clean requires three arguments.'; - my ($sbo, $src, $version) = @_; - print "Cleaning for $sbo-$version...\n"; - my $tmpsbo = "/tmp/SBo"; - remove_tree ("$tmpsbo/$src") if -d "$tmpsbo/$src"; - remove_tree ("$tmpsbo/package-$sbo") if -d "$tmpsbo/package-$sbo"; - return 1; -} - -# remove distfiles -sub make_distclean { - my %args = ( - SRC => '', - VERSION => '', - LOCATION => '', - @_ - ); - unless ($args{SRC} && $args{VERSION} && $args{LOCATION}) { - script_error 'make_distclean requires four arguments.'; - } - my $sbo = get_sbo_from_loc $args{LOCATION}; - make_clean $sbo, $args{SRC}, $args{VERSION}; - print "Distcleaning for $sbo-$args{VERSION}...\n"; - # 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; - unlink $filename if -f $filename; - } - return 1; -} - -# run upgradepkg for a created package -sub do_upgradepkg ($) { - exists $_[0] or script_error 'do_upgradepkg requires an argument.'; - system ('/sbin/upgradepkg', '--reinstall', '--install-new', shift); - return 1; -} diff --git a/t/prep.pl b/t/prep.pl index 08efc61..c5591dc 100755 --- a/t/prep.pl +++ b/t/prep.pl @@ -1,5 +1,6 @@ #!/usr/bin/perl +use 5.16.0; use strict; use warnings FATAL => 'all'; use File::Copy; @@ -8,6 +9,49 @@ 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"); + +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 get_subs ($) { + my $read = shift; + my $begin_regex = qr/^sub\s+[a-z0-9_]+/; + my $usage_regex = qr/^sub\s+show_usage/; + my $end_regex = qr/^}$/; + my $begin = 0; + my $end = 0; + while (my $line = <$read>) { + if (! $begin) { + if ($line =~ $begin_regex) { + if ($line !~ $usage_regex) { + $end = 0, $begin++, print {$write} $line; + } + } + } elsif (! $end) { + if ($line =~ $end_regex) { + $begin = 0, $end++, print {$write} $line; + } else { + print {$write} $line; + } + } + } +} + +for my $file (qw(sbocheck sboclean sboconfig sbofind sboupgrade)) { + open my $read, '<', "../$file"; + get_subs $read; + close $read; +} +close $write; + my @subs; open my $file_h, '<', "$pwd/SBO/Lib.pm"; my $regex = qr/^sub\s+([^\s]+)\s+/; diff --git a/t/test.t b/t/test.t index aabb5fa..36306c4 100755 --- a/t/test.t +++ b/t/test.t @@ -4,7 +4,7 @@ use 5.16.0; use strict; use warnings FATAL => 'all'; use File::Temp qw(tempdir tempfile); -use Test::More tests => 61; +use Test::More tests => 87; use File::Copy; use Text::Diff; use SBO::Lib; @@ -210,5 +210,74 @@ is ($$info[0], 'http://www.libimobiledevice.org', 'get_from_info GET => HOMEPAGE $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 +my $listing = get_update_list; +s/\s//g for @$listing; +for my $item (@$listing) { + is ($item, 'zdoom-2.5.0}; +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'); +$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'); -#is (do_convertpkg ($package), "$package-compat32", 'do_convertpkg good'); +# 86-87, get_opts test +$fh = open_read "$sbo_home/games/vbam/README"; +$readme = do {local $/; <$fh>}; +close $fh; +ok (get_opts $readme, 'get_opts good where README defines opts'); +$fh = open_read "$sbo_home/libraries/libmatchbox/README"; +$readme = do {local $/; <$fh>}; +close $fh; +ok (! (get_opts $readme), 'get_opts good where README does not define opts'); -- cgit v1.2.3 From e0bfabea2f76f45f8bb1450221d0d10cbcc9a516 Mon Sep 17 00:00:00 2001 From: Jacob Pipkin Date: Sat, 1 Sep 2012 00:09:16 -0500 Subject: make test.t use lib . instead of perl -I --- t/test.t | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 't') diff --git a/t/test.t b/t/test.t index 36306c4..0230830 100755 --- a/t/test.t +++ b/t/test.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl -I/home/d4wnr4z0r/projects/slack14/sbotools/t +#!/usr/bin/env perl use 5.16.0; use strict; @@ -7,6 +7,7 @@ use File::Temp qw(tempdir tempfile); use Test::More tests => 87; use File::Copy; use Text::Diff; +use lib "."; use SBO::Lib; my $sbo_home = '/home/d4wnr4z0r/sbo.git/slackbuilds'; -- cgit v1.2.3 From 8b08c603ae79c145bc3b344f6dca4f0a95ed6201 Mon Sep 17 00:00:00 2001 From: Jacob Pipkin Date: Sat, 1 Sep 2012 04:52:02 -0500 Subject: more and more cleanups and fixes --- t/prep.pl | 19 +++++++++++-------- t/test.t | 17 +++++++++-------- 2 files changed, 20 insertions(+), 16 deletions(-) (limited to 't') diff --git a/t/prep.pl b/t/prep.pl index c5591dc..6b38a33 100755 --- a/t/prep.pl +++ b/t/prep.pl @@ -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; diff --git a/t/test.t b/t/test.t index 0230830..cdc5701 100755 --- a/t/test.t +++ b/t/test.t @@ -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"; -- cgit v1.2.3 From b182d3c89554828478d8d24fd31a87ba629e75fc Mon Sep 17 00:00:00 2001 From: Jacob Pipkin Date: Sat, 1 Sep 2012 07:56:24 -0500 Subject: more of the same... --- t/test.t | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 't') diff --git a/t/test.t b/t/test.t index cdc5701..3a6e144 100755 --- a/t/test.t +++ b/t/test.t @@ -162,8 +162,8 @@ copy ("$sbo_home/system/ifuse/ifuse.SlackBuild", $rewrite_dir); my $slackbuild = "$rewrite_dir/ifuse.SlackBuild"; $tempfh = tempfile (DIR => $rewrite_dir); my $tempfn = get_tmp_extfn $tempfh; -my %changes; -is (rewrite_slackbuild ($slackbuild, $tempfn, %changes), 1, 'rewrite_slackbuild with no %changes good'); +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 @@ -179,7 +179,7 @@ is (revert_slackbuild $slackbuild, 1, 'revert_slackbuild is good'); $changes{libdirsuffix} = ''; $changes{make} = '-j 5'; $changes{arch_out} = 'i486'; -is (rewrite_slackbuild ($slackbuild, $tempfn, %changes), 1, 'rewrite_slackbuild with all %changes good'); +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 < LIBDIRSUFFIX=\"64\" -- cgit v1.2.3 From a4cf58095097080537001f9ff25518584b7286ca Mon Sep 17 00:00:00 2001 From: Jacob Pipkin Date: Fri, 21 Sep 2012 07:02:25 -0500 Subject: prep.pl and test.t updated to test correctly --- t/prep.pl | 3 +- t/test.t | 172 +++++++++++++++++++++++++++++++++++++++++++------------------- 2 files changed, 122 insertions(+), 53 deletions(-) (limited to 't') diff --git a/t/prep.pl b/t/prep.pl index 6b38a33..ebffd40 100755 --- a/t/prep.pl +++ b/t/prep.pl @@ -17,7 +17,8 @@ sub pr ($) { print {$write} "our \$$thing = 1;\n"; } -for my $thing (qw(interactive compat32 no_readme jobs distclean noclean no_install no_reqs)) { +for my $thing (qw(interactive compat32 no_readme jobs distclean noclean + no_install no_reqs force force_reqs clean non_int)) { pr $thing; } diff --git a/t/test.t b/t/test.t index 3a6e144..97b15cc 100755 --- a/t/test.t +++ b/t/test.t @@ -4,7 +4,7 @@ use 5.16.0; use strict; use warnings FATAL => 'all'; use File::Temp qw(tempdir tempfile); -use Test::More tests => 87; +use Test::More tests => 90; use File::Copy; use Text::Diff; use lib "."; @@ -34,7 +34,8 @@ 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, undef, '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'); @@ -47,24 +48,36 @@ is (slackbuilds_or_fetch, 1, 'slackbuilds_or_fetch is good'); print "pseudo-random sampling of get_installed_sbos output...\n"; my $installed = get_installed_sbos; for my $key (keys @$installed) { - is ($$installed[$key]{version}, '1.13') if $$installed[$key]{name} eq 'OpenAL'; - is ($$installed[$key]{version}, '9.5.1_enu') if $$installed[$key]{name} eq 'adobe-reader'; - is ($$installed[$key]{version}, '4.1.3') if $$installed[$key]{name} eq 'libdvdnav'; - is ($$installed[$key]{version}, '0.8.8.4') if $$installed[$key]{name} eq '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 'zdoom'; + is ($$installed[$key]{version}, '1.13') if $$installed[$key]{name} eq + 'OpenAL'; + is ($$installed[$key]{version}, '9.5.1_enu') if $$installed[$key]{name} eq + 'adobe-reader'; + is ($$installed[$key]{version}, '4.1.3') if $$installed[$key]{name} eq + 'libdvdnav'; + is ($$installed[$key]{version}, '0.8.8.4') if $$installed[$key]{name} eq + '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 + '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 is good'); -is (get_sbo_location 'omgwtfbbq', undef, 'get_sbo_location returns false with not-an-sbo input'); +is (get_sbo_location 'nginx', "$sbo_home/network/nginx", + 'get_sbo_location is good'); +is (get_sbo_location 'omgwtfbbq', undef, + 'get_sbo_location returns false with not-an-sbo input'); # 21-22, get_available_updates tests my $updates = get_available_updates; for my $key (keys @$updates) { - is ($$updates[$key]{installed}, '1.15', '$$updates[$key]{installed} good for mutagen') if $$updates[$key]{name} eq 'mutagen'; - is ($$updates[$key]{update}, '1.20', '$$updates[$key]{update} good for mutagen') if $$updates[$key]{name} eq 'mutagen'; + is ($$updates[$key]{installed}, '1.15', + '$$updates[$key]{installed} good for mutagen') if $$updates[$key]{name} + eq 'mutagen'; + is ($$updates[$key]{update}, '1.20', + '$$updates[$key]{update} good for mutagen') if $$updates[$key]{name} eq + 'mutagen'; } # 23, get_arch test @@ -73,39 +86,54 @@ is (get_arch, 'x86_64', 'get_arch is good'); # 24-25, 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', 'get_download_info test 01 good.'); +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', 'get_download_info test 02 good.'); +is ($dl_info{$link}, '97159d77631da13952fe87e846cf1f3b', + 'get_download_info test 02 good.'); # 26-28, 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', 'get_sbo_downloads test 01 good.'); +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', 'get_sbo_downloads test 02 good.'); +is ($dl_info{$link}, '97159d77631da13952fe87e846cf1f3b', + 'get_sbo_downloads test 02 good.'); 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', 'get_sbo_downloads test 03 good.'); +is ($downloads{$link}, '8d528a79de024b91f12f8ac67965c37c', + 'get_sbo_downloads test 03 good.'); # 29, 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'); +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 -is (compute_md5sum "$sbo_home/distfiles/laptop-mode-tools_1.61.tar.gz", '6685af5dbb34c3d51ca27933b58f484e', 'compute_md5sum good'); +is (compute_md5sum "$sbo_home/distfiles/laptop-mode-tools_1.61.tar.gz", + '6685af5dbb34c3d51ca27933b58f484e', 'compute_md5sum good'); # 32, verify_distfile test -is ((verify_distfile "$sbo_home/distfiles/laptop-mode-tools_1.61.tar.gz", '6685af5dbb34c3d51ca27933b58f484e'), 1, 'verify_distfile good'); +is ((verify_distfile "$sbo_home/distfiles/laptop-mode-tools_1.61.tar.gz", + '6685af5dbb34c3d51ca27933b58f484e'), 1, 'verify_distfile good'); # 33, 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 -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'); +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 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'); +ok (!(check_x32 "$sbo_home/system/ifuse"), + 'check_x32 false for not-32-bit-only ifuse'); # 37, check_multilib tests ok (check_multilib, 'check_multilib good'); @@ -113,8 +141,10 @@ ok (check_multilib, 'check_multilib good'); # 38-39, 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", '$symlinks[0] good for create_symlinks'); -is ($symlinks[1], "$sbo_home/system/wine/dibeng-max-2010-11-12.zip", '$symlinks[1] good for create_symlinks'); +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", + '$symlinks[1] good for create_symlinks'); # 40-41, grok_temp_file, get_src_dir/get_pkg_name tests my $tempdir = tempdir (CLEANUP => 1); @@ -133,27 +163,35 @@ close $tempfh; is ((check_distfiles %downloads), 1, 'check_distfiles good'); # 43-45, check_home tests -system ('sudo /usr/sbin/sboconfig -s /home/d4wnr4z0r/opt_sbo') == 0 or die "unable to set sboconfig -s\n"; +system ('sudo /usr/sbin/sboconfig -s /home/d4wnr4z0r/opt_sbo') == 0 or die + "unable to set sboconfig -s\n"; read_config; ok (check_home, 'check_home returns true with new non-existent directory'); ok (-d '/home/d4wnr4z0r/opt_sbo', 'check_home creates $config{SBO_HOME}'); ok (check_home, 'check_home returns true with new existent empty directory'); -system ("sudo /usr/sbin/sboconfig -s $sbo_home") == 0 or die "unable to reset sboconfig -s\n"; +system ("sudo /usr/sbin/sboconfig -s $sbo_home") == 0 or die + "unable to reset sboconfig -s\n"; read_config; rmdir "/home/d4wnr4z0r/opt_sbo"; # 46-47 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'); +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'); +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 my $distfile = "$sbo_home/distfiles/Sort-Versions-1.5.tar.gz"; unlink $distfile if -f $distfile; -is (get_distfile ('http://search.cpan.org/CPAN/authors/id/E/ED/EDAVIS/Sort-Versions-1.5.tar.gz', '5434f948fdea6406851c77bebbd0ed19'), 1, 'get_distfile is good'); +is (get_distfile + ('http://search.cpan.org/CPAN/authors/id/E/ED/EDAVIS/Sort-Versions-1.5.tar.gz', + '5434f948fdea6406851c77bebbd0ed19'), 1, 'get_distfile is good'); unlink $distfile; # 51-58, rewrite_slackbuilds/revert_slackbuild tests @@ -163,7 +201,8 @@ my $slackbuild = "$rewrite_dir/ifuse.SlackBuild"; $tempfh = tempfile (DIR => $rewrite_dir); my $tempfn = get_tmp_extfn $tempfh; my %changes = (); -is (rewrite_slackbuild (SLACKBUILD => $slackbuild, TEMPFN => $tempfn, CHANGES => \%changes), 1, 'rewrite_slackbuild with no %changes good'); +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 @@ -174,12 +213,14 @@ my $expected_out = "67c67 --- > /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 (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'; $changes{arch_out} = 'i486'; -is (rewrite_slackbuild (SLACKBUILD => $slackbuild, TEMPFN => $tempfn, CHANGES => \%changes), 1, 'rewrite_slackbuild with all %changes good'); +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 < LIBDIRSUFFIX=\"64\" @@ -198,7 +239,8 @@ $expected_out = "55c55 --- > /sbin/makepkg -l y -c n \$OUTPUT/\$PRGNAM-\$VERSION-i486-\$BUILD\$TAG.\${PKGTYPE:-tgz} | tee -a $tempfn "; -is (diff ("$slackbuild.orig", $slackbuild, {STYLE => 'OldStyle'}), $expected_out, 'all changed lines rewritten correctly'); +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 @@ -207,7 +249,8 @@ my %params = (LOCATION => $test_loc); my $info = get_from_info (%params, GET => 'VERSION'); is ($$info[0], '1.1.1', 'get_from_info GET => VERSION is good'); $info = get_from_info (%params, GET => 'HOMEPAGE'); -is ($$info[0], 'http://www.libimobiledevice.org', 'get_from_info GET => HOMEPAGE is good'); +is ($$info[0], 'http://www.libimobiledevice.org', + 'get_from_info GET => HOMEPAGE is good'); $info = get_from_info (%params, GET => 'DOWNLOAD_x86_64'); is ($$info[0], "", 'get_from_info GET => DOWNLOAD_x86_64 is good'); @@ -215,16 +258,20 @@ is ($$info[0], "", 'get_from_info GET => DOWNLOAD_x86_64 is good'); my $listing = get_update_list; s/\s//g for @$listing; for my $item (@$listing) { - is ($item, 'zdoom-2.5.0}; 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'); +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'); +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"; $readme = do {local $/; <$fh>}; close $fh; ok (get_opts $readme, 'get_opts good where README defines opts'); -$fh = open_read "$sbo_home/libraries/libmatchbox/README"; +$fh = open_read "$sbo_home/audio/gmpc/README"; $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'); +$SBO::Lib::compat32 = 0; +$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.'); + -- cgit v1.2.3