diff options
Diffstat (limited to 'SBO-Lib/lib')
| -rw-r--r-- | SBO-Lib/lib/SBO/Lib.pm | 110 |
1 files changed, 72 insertions, 38 deletions
diff --git a/SBO-Lib/lib/SBO/Lib.pm b/SBO-Lib/lib/SBO/Lib.pm index 821daa3..67c7e3e 100644 --- a/SBO-Lib/lib/SBO/Lib.pm +++ b/SBO-Lib/lib/SBO/Lib.pm @@ -27,7 +27,7 @@ our @EXPORT = qw( slackbuilds_or_fetch fetch_tree update_tree - get_installed_sbos + get_installed_packages get_inst_names get_available_updates get_requires @@ -201,19 +201,43 @@ sub slackbuilds_or_fetch() { return 1; } -# pull an array of hashes, each hash containing the name and version of an sbo -# currently installed. -sub get_installed_sbos() { +# pull an array of hashes, each hash containing the name and version of a +# package currently installed. Gets filtered using STD, SBO or ALL. +sub get_installed_packages($) { + exists $_[0] or script_error 'get_installed_packages requires an argument.'; + my $filter = shift; my @installed; - # $1 == name, $2 == version - my $regex = qr#/([^/]+)-([^-]+)-[^-]+-[^-]+$#; - for my $path (<$pkg_db/*_SBo>) { - my ($name, $version) = ($path =~ $regex)[0,1]; - push @installed, {name => $name, version => $version}; + + my $regex = qr#/([^/]+)-([^-]+)-[^-]+-([^-]+)$#; + for my $path (<$pkg_db/*>) { + my ($name, $version, $build) = ($path =~ $regex)[0,1,2]; + # valid types: STD, SBO + my $type = 'STD'; + if ($build =~ m/_SBo*/) { + my $sbo = $name; + $sbo =~ s/-compat32//g if $name =~ /-compat32$/; + $type = 'SBO' if get_sbo_location($sbo); + } + if ($filter eq $type or $filter eq 'ALL') { + push @installed, {name => $name, version => $version}; + } } return \@installed; } +# pull an array of hashes, each hash containing the name and version of an sbo +# currently installed. +# sub get_installed_sbos() { +# my @installed; +# # $1 == name, $2 == version +# my $regex = qr#/([^/]+)-([^-]+)-[^-]+-[^-]+$#; +# for my $path (<$pkg_db/*_SBo>) { +# my ($name, $version) = ($path =~ $regex)[0,1]; +# push @installed, {name => $name, version => $version}; +# } +# return \@installed; +# } + # for a ref to an array of hashes of installed packages, return an array ref # consisting of just their names sub get_inst_names($) { @@ -305,7 +329,7 @@ sub get_sbo_version($) { # newer, and compile an array of hashes containing those which are sub get_available_updates() { my @updates; - my $pkg_list = get_installed_sbos; + my $pkg_list = get_installed_packages 'SBO'; 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 @@ -569,40 +593,39 @@ sub create_symlinks { 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}; +# pull the created package name from the temp file we tee'd to +sub get_pkg_name($) { + my $fh = shift; seek $fh, 0, 0; + my $regex = qr/^Slackware\s+package\s+([^\s]+)\s+created\.$/; my $out; FIRST: while (my $line = <$fh>) { - if ($line =~ $args{REGEX}) { - $out = ($line =~ $args{REGEX})[$args{CAPTURE}]; - last FIRST; - } + last FIRST if $out = ($line =~ $regex)[0]; } 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\.$/); + my $fh = shift; + seek $fh, 0, 0; + my @src_dirs; + opendir(my $tsbo_dh, '/tmp/SBo'); + FIRST: while (my $ls = readdir $tsbo_dh) { + next FIRST if $ls =~ /^\.[\.]{0,1}$/; + next FIRST if $ls =~ /^package-/; + my $found = 0; + SECOND: while (my $line = <$fh>) { + if ($line =~ /$ls/) { + $found++; + last SECOND; + } + } + push @src_dirs, $ls unless $found; + } + close $tsbo_dh; + close $fh; + return \@src_dirs; } # return a filename from a temp fh for use externally @@ -646,6 +669,14 @@ sub perform_sbo { } $cmd .= " $args{OPTS}" if $args{OPTS}; $cmd .= " MAKEOPTS=\"-j$args{JOBS}\"" if $args{JOBS}; + # we need to get a listing of /tmp/SBo before we run the SlackBuild so that + # we can compare to a listing taken afterward. + my $src_ls_fh = tempfile(DIR => $tempdir); + opendir(my $tsbo_dh, '/tmp/SBo'); + FIRST: while (readdir $tsbo_dh) { + next FIRST if /^\.[\.]{0,1}$/; + say {$src_ls_fh} $_; + } # get a tempfile to store the exit status of the slackbuild my $exit_temp = tempfile(DIR => $tempdir); my $exit_fn = get_tmp_extfn $exit_temp; @@ -665,7 +696,7 @@ sub perform_sbo { revert_slackbuild "$location/$sbo.SlackBuild"; die "$sbo.SlackBuild returned non-zero exit status\n" unless $out == 0; my $pkg = get_pkg_name $tempfh; - my $src = get_src_dir $tempfh; + my $src = get_src_dir $src_ls_fh; return $pkg, $src; } @@ -743,10 +774,13 @@ sub make_clean { unless ($args{SBO} && $args{SRC} && $args{VERSION}) { script_error 'make_clean requires three arguments.'; } + my $src = $args{SRC}; say "Cleaning for $args{SBO}-$args{VERSION}..."; my $tmpsbo = '/tmp/SBo'; - remove_tree("$tmpsbo/$args{SRC}") if -d "$tmpsbo/$args{SRC}"; - remove_tree("$tmpsbo/package-$args{SBO}") if + for my $dir (@$src) { + remove_tree("$tmpsbo/$dir") if -d "$tmpsbo/$dir"; + } + remove_tree("$tmpsbo/package-$args{SBO}") if -d "$tmpsbo/package-$args{SBO}"; return 1; } |