compare ls before and after slackbuild to get a list of source directories, collapse get_pkg_name and grok_temp_file into one sub since only get_pkg_name remains as a consumer of grok_temp_file

2 files changed, 58 insertions, 30 deletions

diff --git a/SBO-Lib/lib/SBO/Lib.pm b/SBO-Lib/lib/SBO/Lib.pm
index e06f124..5f9f011 100644
--- a/SBO-Lib/lib/SBO/Lib.pm
+++ b/SBO-Lib/lib/SBO/Lib.pm
@@ -568,40 +568,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
@@ -645,6 +644,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;
@@ -664,7 +671,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;
 }
 
@@ -742,10 +749,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;
 }
diff --git a/t/test.t b/t/test.t
index daa9d1c..722472a 100755
--- a/t/test.t
+++ b/t/test.t
@@ -174,9 +174,27 @@ 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";
-is(get_src_dir $tempfh, 'laptop-mode-tools_1.60', 'get_src_dir good');
 is(get_pkg_name $tempfh, 'skype-2.2.0.35-i486-1_SBo.tgz', 'get_pkg_name good');
-close $tempfh;
+
+# we can not test get_src_dir() at present - we will need to support $TMP in
+# order to be able to test this. because user can't write to /tmp/SBo
+#close $tempfh;
+#$tempfh = tempfile(DIR => $tempdir);
+#opendir (my $tsbo_dh, '/tmp/SBo');
+#FIRST: while (readdir $tsbo_dh) {
+#	next FIRST if /^\.[\.]{0,1}$/;
+#	say {$tempfh} $_;
+#}
+#close $tsbo_dh;
+#mkdir '/tmp/SBo/test.d.1';
+#mkdir '/tmp/SBo/test.2.d';
+#my $src = get_src_dir $tempfh;
+#say ref $src;
+#say $_ for @$src;
+#is($$src[0], 'test.d.1', 'get_src_dir test 01');
+#is($$src[1], 'test.2.d', 'get_src_dir test 02');
+#rmdir '/tmp/SBo/test.d.1';
+#rmdir '/tmp/SBo/test.2.d';
 
 # check_distfiles test
 %downloads = get_sbo_downloads(LOCATION => "$sbo_home/perl/perl-Sort-Versions");