From 5238826dc668df2dafc47f3b26e5862ff1db7591 Mon Sep 17 00:00:00 2001 From: Jacob Pipkin Date: Thu, 30 Aug 2012 07:54:37 -0500 Subject: first stage applying changes from slack14 rewrite back into slack13.37 version --- sbocheck | 18 +++++++++--------- sboclean | 26 +++++++++++++------------- sboconfig | 52 +++++++++++++++++++++++++-------------------------- sbofind | 30 +++++++++++++++--------------- sboinstall | 12 ++++++------ sbosnap | 14 +++++++------- sboupgrade | 63 +++++++++++++++++++++++++++++++------------------------------- 7 files changed, 106 insertions(+), 109 deletions(-) diff --git a/sbocheck b/sbocheck index 6e748a2..d20d377 100755 --- a/sbocheck +++ b/sbocheck @@ -22,18 +22,18 @@ my $self = basename ($0); my %options; getopts ('v',\%options); -show_version () && exit (0) if (exists $options{v}); +show_version && exit 0 if exists $options{v}; -update_tree (); +update_tree; -print "Checking for updated SlackBuilds...\n"; -my @updates = get_available_updates (); +say "Checking for updated SlackBuilds..."; +my $updates = get_available_updates; # pretty formatting. my @listing; -for my $key (keys @updates) { - my $string = "$updates[$key]{name}-$updates[$key]{installed}"; - $string .= " < needs updating (SBo has $updates[$key]{update})\n"; +for my $up (@$updates) { + my $string = "$$up{name}-$$up{installed}"; + $string .= " < needs updating (SBo has $$up{update})\n"; push @listing, $string; } @@ -41,9 +41,9 @@ if (exists $listing[0]) { my $tab = new Text::Tabulate (); $tab->configure (tab => '\s'); my $output = $tab->format (@listing); - print "\n". $output ."\n"; + say "\n". $output; } else { - print "\nNo updates available.\n"; + say "\nNo updates available."; } exit 0; diff --git a/sboclean b/sboclean index 3e4da48..550658d 100755 --- a/sboclean +++ b/sboclean @@ -19,7 +19,7 @@ use warnings FATAL => 'all'; my %config = %SBO::Lib::config; my $self = basename ($0); -sub show_usage { +sub show_usage () { print < =~ /^[Yy]/; } @@ -64,7 +64,7 @@ sub remove_stuff { } } -remove_stuff ($config{SBO_HOME} . '/distfiles') if $clean_dist eq 'TRUE'; -remove_stuff ('/tmp/SBo') if $clean_work eq 'TRUE'; +remove_stuff ($config{SBO_HOME} . '/distfiles') if $clean_dist; +remove_stuff ('/tmp/SBo') if $clean_work; exit 0; diff --git a/sboconfig b/sboconfig index 829d7a3..fb32110 100755 --- a/sboconfig +++ b/sboconfig @@ -21,7 +21,7 @@ use File::Temp qw(tempfile);; my %config = %SBO::Lib::config; my $self = basename ($0); -sub show_usage { +sub show_usage () { print < 'NOCLEAN', @@ -66,6 +58,16 @@ my %valid_confs = ( p => 'PKG_DIR', s => 'SBO_HOME', ); + +my %params = reverse %valid_confs; + +if (exists $options{l}) { + my @keys = sort {$a cmp $b} keys %config; + print "$_=$config{$_}\n" for @keys; + exit 0; +} + +show_usage and exit 0 unless %options; # setup what's being changed. my %changes; @@ -82,36 +84,32 @@ my $conf_file = $SBO::Lib::conf_file; # safely modify our conf file; copy to a temp location, edit the temp file, # move the edited file into place -sub config_write { +sub config_write ($$) { exists $_[1] or script_error ('config_write requires two arguments.'); my ($key, $val) = @_; if (! -d $conf_dir) { mkdir ($conf_dir) or die "Unable to create $conf_dir. Exiting.\n"; } if (-f $conf_file) { - my ($fh, $filename) = tempfile (DIR => $SBO::Lib::tempdir); - close $fh; - copy ($conf_file, $filename); + my $tempfh = tempfile (DIR => $SBO::Lib::tempdir); + my $tempfn = get_tmp_perlfn $tempfh; + copy ($conf_file, $tempfn); # tie the file so that if $key is already there, we just change that # line and untie it - tie my @temp, 'Tie::File', $filename; - my $has = 'FALSE'; + tie my @temp, 'Tie::File', $tempfn; + my $has = 0; my $regex = qr/\A\Q$key\E=/; FIRST: for my $tmpline (@temp) { - if ($tmpline =~ $regex) { - $has = 'TRUE'; - $tmpline = "$key=$val"; - last FIRST; - } + $has++, $tmpline = "$key=$val", last FIRST if $templine =~ $regex; } untie @temp; # otherwise, append our new $key=$value pair - if ($has eq 'FALSE') { - my $fh = open_fh ($filename, '>>'); + unless ($has) { + my $fh = open_fh ($tempfn, '>>'); print {$fh} "$key=$val\n"; close $fh; } - move ($filename, $conf_file); + move ($tempfn, $conf_file); } else { # no config file, easiest case of all. my $fh = open_fh ($conf_file, '>'); @@ -121,8 +119,8 @@ sub config_write { } while (my ($key, $value) = each %changes) { - print "Setting $key to $value...\n"; - config_write ($key, $value); + say "Setting $key to $value..."; + config_write $key, $value; } exit 0; diff --git a/sbofind b/sbofind index 5e8931d..c530217 100755 --- a/sbofind +++ b/sbofind @@ -18,7 +18,7 @@ use warnings FATAL => 'all'; my %config = %SBO::Lib::config; my $self = basename ($0); -sub show_usage { +sub show_usage () { print <) { - if ($found eq 'FALSE') { - $found = 'TRUE', next FIRST if $name = ($line =~ $name_regex)[0]; + unless ($found) { + $found++, next FIRST if $name = ($line =~ $name_regex)[0]; } else { if (my ($location) = ($line =~ $loc_regex)[0]) { - $found = 'FALSE'; + $found = 0; $location =~ s#^\.##; push @findings, {$name => $config{SBO_HOME} . $location}; } @@ -68,9 +68,9 @@ FIRST: while (my $line = <$fh>) { } sub get_file_contents { - exists $_[0] or script_error ('get_file_contents requires an argument'); - -f $_[0] or script_error ('get_file_contents argument is not a file'); - my $fh = open_read (shift); + exists $_[0] or script_error 'get_file_contents requires an argument'; + -f $_[0] or script_error 'get_file_contents argument is not a file'; + my $fh = open_read shift; my $contents = do {local $/; <$fh>}; $contents =~ s/\n/\n /g; $contents =~ s/ $//g; diff --git a/sboinstall b/sboinstall index 76cfa9f..b477276 100755 --- a/sboinstall +++ b/sboinstall @@ -17,7 +17,7 @@ use warnings FATAL => 'all'; my $self = basename ($0); -sub show_usage { +sub show_usage () { print < 'all'; my %config = %SBO::Lib::config; my $self = basename ($0); -sub show_usage { +sub show_usage () { print < =~ /^[Yy\n]/) { for my $cmd (@cmds) { @@ -170,8 +169,8 @@ sub grok_user_group { } # see if the README mentions any options -sub grok_options { - exists $_[0] or script_error ('grok_options requires an argument'); +sub grok_options ($) { + exists $_[0] or script_error 'grok_options requires an argument'; my $readme = shift; return 7 unless $readme =~ /[A-Z]+=[^\s]/; my @readme_array = split /\n/, $readme; -- cgit v1.2.3