diff options
| -rw-r--r-- | SBO-Lib/lib/SBO/Lib.pm | 10 | ||||
| -rwxr-xr-x | sboinstall | 12 | ||||
| -rwxr-xr-x | sboremove | 18 | ||||
| -rwxr-xr-x | sboupgrade | 6 | ||||
| -rwxr-xr-x | t/test.t | 11 | 
5 files changed, 36 insertions, 21 deletions
diff --git a/SBO-Lib/lib/SBO/Lib.pm b/SBO-Lib/lib/SBO/Lib.pm index 8e2ea2c..83fbe3c 100644 --- a/SBO-Lib/lib/SBO/Lib.pm +++ b/SBO-Lib/lib/SBO/Lib.pm @@ -342,7 +342,7 @@ sub get_from_info {  	return $$store{$args{GET}} if $$store{PRGNAM}[0] eq $sbo;  	# if we're here, we haven't read in the .info file yet.  	my ($fh, $exit) = open_read "$args{LOCATION}/$sbo.info"; -#TODO: do something with $exit from open_read +	return if $exit;  	# suck it all in, clean it all up, stuff it all in $store.  	my $contents = do {local $/; <$fh>};  	$contents =~ s/("|\\\n)//g; @@ -397,7 +397,7 @@ sub get_download_info {  		@_  	);  	$args{LOCATION} or script_error 'get_download_info requires LOCATION.'; -	my ($get, $downs, $md5s, %return); +	my ($get, $downs, $exit, $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? @@ -458,7 +458,6 @@ sub get_filename_from_link($) {  sub compute_md5sum($) {  	-f $_[0] or script_error 'compute_md5sum requires a file argument.';  	my ($fh, $exit) = open_read shift; -# TODO: do something with $exit  	my $md5 = Digest::MD5->new;  	$md5->addfile($fh);  	my $md5sum = $md5->hexdigest; @@ -964,7 +963,7 @@ sub merge_queues {  sub get_readme_contents($) {  	exists $_[0] or script_error 'get_readme_contents requires an argument.';  	my ($fh, $exit) = open_read(shift .'/README'); -# TODO: do something with $exit +	return undef, $exit if $exit;  	my $readme = do {local $/; <$fh>};  	close $fh;  	return $readme; @@ -1054,7 +1053,8 @@ sub ask_opts {  sub user_prompt {  	exists $_[1] or script_error 'user_prompt requires two arguments.';  	my ($sbo, $location) = @_; -	my $readme = get_readme_contents $location; +	my ($readme, $exit) = get_readme_contents $location; +	return $readme, undef, $exit if $exit;  	# check for user/group add commands, offer to run any found  	my $user_group = get_user_group $readme;  	my $cmds; @@ -130,7 +130,11 @@ FIRST: for my $sbo (@$build_queue) {          if ($compat32) {              unless ($sbo ~~ @$inst_names) {  				say "$name requires $sbo."; -                my ($cmds, $opts) = user_prompt($sbo, $locations{$sbo}); +                my ($cmds, $opts, $exit) = user_prompt($sbo, $locations{$sbo}); +				if ($exit) { +					warn "Unable to open README for $sbo.\n"; +					exit $exit; +				}  				if ($cmds) {  					next FIRST if $cmds eq 'N';  				} @@ -140,7 +144,11 @@ FIRST: for my $sbo (@$build_queue) {  				say "$sbo$added";              }           } -        my ($cmds, $opts) = user_prompt($name, $locations{$name}); +        my ($cmds, $opts, $exit) = user_prompt($name, $locations{$name}); +		if ($exit) { +			warn "Unable to open README for $name.\n"; +			exit $exit; +		}  		if ($cmds) {  			next FIRST if $cmds eq 'N';  		} @@ -61,14 +61,6 @@ for my $sbo (@ARGV) {  }  exit 1 unless exists $sbos[0]; -# # wrapper to pull the list of requirements for a given sbo -# sub get_requires ($) { -# 	my $location = get_sbo_location(shift); -# 	return unless $location; -# 	my $info = get_from_info(LOCATION => $location, GET => 'REQUIRES'); -# 	return $$info[0] ne '' ? $info : undef; -# } -  # Create full queue.   my ($remove_queue, %warnings);  for my $sbo (@sbos) { @@ -156,8 +148,14 @@ FIRST: for my $remove (@$remove_queue) {  	if ( "%README%" ~~ @reqz ) {  		say "It is recommended that you view the README before continuing.";  		print "Display README now? [y]: "; -		my $readme = get_readme_contents get_sbo_location($remove); -		print "\n" . $readme if <STDIN> =~ /^[Yy\n]/; +		if (<STDIN> =~ /^[Yy\n]/) { +			my ($readme, $exit) = get_readme_contents get_sbo_location($remove); +			if ($exit) { +				warn "Unable to open README for $remove.\n"; +			} else { +				print "\n" . $readme; +			} +		}  	}  	# Determine default behavior for prompt @@ -192,7 +192,11 @@ unless ($force) {  my (@temp_queue, %commands, %options);  FIRST: for my $sbo (@$upgrade_queue) {      unless ($non_int) { -		my ($cmds, $opts) = user_prompt($sbo, $locations{$sbo}); +		my ($cmds, $opts, $exit) = user_prompt($sbo, $locations{$sbo}); +		if ($exit) { +			warn "Unable to open README for $sbo.\n"; +			exit $exit; +		}  		if ($cmds) {  			next FIRST if $cmds eq 'N';  		} @@ -244,9 +244,14 @@ ok(! get_sbo_from_loc('omg_wtf_bbq'),  # 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'); +my $out; +#$exit) = get_distfile +#	('http://search.cpan.org/CPAN/authors/id/E/ED/EDAVIS/Sort-Versions-1.5.tar.gz', +#	'5434f948fdea6406851c77bebbd0ed19'); +#is($out, 1, 'get_distfile test 01'); +is(get_distfile( +	'http://search.cpan.org/CPAN/authors/id/E/ED/EDAVIS/Sort-Versions-1.5.tar.gz', +		'5434f948fdea6406851c77bebbd0ed19'), 1, 'get_distfile test 01');  unlink $distfile;  # rewrite_slackbuild/revert_slackbuild tests  | 
