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 |