diff options
| -rwxr-xr-x | sbocheck | 18 | ||||
| -rwxr-xr-x | sboclean | 26 | ||||
| -rwxr-xr-x | sboconfig | 52 | ||||
| -rwxr-xr-x | sbofind | 30 | ||||
| -rwxr-xr-x | sboinstall | 12 | ||||
| -rwxr-xr-x | sbosnap | 14 | ||||
| -rwxr-xr-x | sboupgrade | 63 |
7 files changed, 106 insertions, 109 deletions
@@ -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; @@ -19,7 +19,7 @@ use warnings FATAL => 'all'; my %config = %SBO::Lib::config; my $self = basename ($0); -sub show_usage { +sub show_usage () { print <<EOF Usage: $self (options) [package] @@ -36,26 +36,26 @@ EOF my %options; getopts ('hvdwi', \%options); -show_usage () && exit (0) if exists $options{h}; -show_version () && exit (0) if exists $options{v}; -my $clean_dist = exists $options{d} ? 'TRUE' : 'FALSE'; -my $clean_work = exists $options{w} ? 'TRUE' : 'FALSE'; -my $interactive = exists $options{i} ? 'TRUE' : 'FALSE'; +show_usage && exit 0 if exists $options{h}; +show_version && exit 0 if exists $options{v}; +my $clean_dist = exists $options{d} ? 1 : 0; +my $clean_work = exists $options{w} ? 1 : 0; +my $interactive = exists $options{i} ? 1 : 0; -if ($clean_dist eq 'FALSE' && $clean_work eq 'FALSE') { - show_usage (); +unless ($clean_dist || $clean_work) { + show_usage; die "You must specify at least one of -d or -w.\n"; } -sub remove_stuff { +sub remove_stuff ($) { exists $_[0] or script_error ('remove_stuff requires an argument'); - print "Nothing to do.\n" and return 1 unless -d $_[0]; + -d $_[0] or say "Nothing to do." and return 1; my $dir = shift; opendir (my $dh, $dir); FIRST: while (my $ls = readdir $dh) { next FIRST if $ls =~ /^(\.){1,2}$/; my $full = "$dir/$ls"; - if ($interactive eq 'TRUE') { + if ($interactive) { print "Remove $full? [n] "; next FIRST unless <STDIN> =~ /^[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; @@ -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 <<EOF Usage: $self [options] [arguments] @@ -48,16 +48,8 @@ EOF my %options; getopts ('hvlc:d:p:s:j:', \%options); -show_usage () and exit (0) if exists $options{h}; -show_version () and exit (0) if exists $options{v}; - -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; +show_usage and exit 0 if exists $options{h}; +show_version and exit 0 if exists $options{v}; my %valid_confs = ( c => '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; @@ -18,7 +18,7 @@ use warnings FATAL => 'all'; my %config = %SBO::Lib::config; my $self = basename ($0); -sub show_usage { +sub show_usage () { print <<EOF Usage: $self (search_term) @@ -37,30 +37,30 @@ EOF my %options; getopts ('hvir', \%options); -show_usage () and exit (0) if (exists $options{h}); -show_version () and exit (0) if (exists $options{v}); +show_usage and exit 0 if exists $options{h}; +show_version and exit 0 if exists $options{v}; -my $show_readme = exists $options{r} ? 'TRUE' : 'FALSE'; -my $show_info = exists $options{i} ? 'TRUE' : 'FALSE'; +my $show_readme = exists $options{r} ? 1 : 0; +my $show_info = exists $options{i} ? 1 : 0; -show_usage () and exit (1) unless exists $ARGV[0]; +show_usage and exit 1 unless exists $ARGV[0]; my $search = $ARGV[0]; # if we can't find SLACKBUILDS.TXT in $config{HOME}, prompt to fetch the tree -slackbuilds_or_fetch (); +slackbuilds_or_fetch; # find anything with $search in its name my (@findings, $name); -my $found = 'FALSE'; +my $found = 0; my $name_regex = qr/NAME:\s+(.*\Q$search\E.*)$/i; my $loc_regex = qr/LOCATION:\s+(.*)$/; -my $fh = open_read ("$config{SBO_HOME}/SLACKBUILDS.TXT"); +my $fh = open_read "$config{SBO_HOME}/SLACKBUILDS.TXT"; FIRST: while (my $line = <$fh>) { - 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; @@ -17,7 +17,7 @@ use warnings FATAL => 'all'; my $self = basename ($0); -sub show_usage { +sub show_usage () { print <<EOF Usage: $self [options] sbo @@ -38,10 +38,10 @@ EOF my %options; getopts ('hvcdripj:R', \%options); -show_usage () and exit (0) if exists $options{h}; -show_version () and exit (0) if exists $options{v}; +show_usage and exit 0 if exists $options{h}; +show_version and exit 0 if exists $options{v}; -show_usage () and exit (0) unless exists $ARGV[0]; +show_usage and exit 0 unless exists $ARGV[0]; # setup any options which do not require arguments my @opts1 = ('c', 'd', 'r', 'i', 'p', 'R'); @@ -55,6 +55,6 @@ for my $opt (@opts2) { unshift @ARGV, "-$opt $options{$opt}" if exists $options{$opt}; } -unshift @ARGV, '/usr/sbin/sboupgrade', '-oN'; -system @ARGV; +system '/usr/sbin/sboupgrade', '-oN', @ARGV; + exit 0; @@ -23,7 +23,7 @@ my %config = %SBO::Lib::config; my $sbo_home = $config{SBO_HOME}; my $self = basename ($0); -sub show_usage { +sub show_usage () { print <<EOF Usage: $self [options|command] @@ -39,25 +39,25 @@ Commands: EOF } -show_usage () and exit (1) unless exists $ARGV[0]; +show_usage and exit 1 unless exists $ARGV[0]; my %options; getopts ('hv', \%options); -show_usage () and exit (0) if exists $options{h}; -show_version () and exit (0) if exists $options{v}; +show_usage and exit 0 if exists $options{h}; +show_version and exit 0 if exists $options{v}; # check for a command and, if found, execute it my $command; if ($ARGV[0] =~ /fetch|update/) { $command = $ARGV[0]; } else { - show_usage () and exit 1; + show_usage and exit 1; } given ($command) { - when ('fetch') { fetch_tree () } - when ('update') { update_tree () } + when ('fetch') {fetch_tree} + when ('update') {update_tree} } exit 0; @@ -19,7 +19,7 @@ use warnings FATAL => 'all'; my %config = %SBO::Lib::config; my $self = basename ($0); -sub show_usage { +sub show_usage () { print <<EOF Usage: $self (options) [package] @@ -45,17 +45,17 @@ EOF my %options; getopts ('hvacdfj:NriopR', \%options); -show_usage () && exit (0) if exists $options{h}; -show_version () && exit (0) if exists $options{v}; +show_usage && exit 0 if exists $options{h}; +show_version && exit 0 if exists $options{v}; my $noclean = exists $options{c} ? 'TRUE' : $config{NOCLEAN}; my $distclean = exists $options{d} ? 'TRUE' : $config{DISTCLEAN}; -my $force = exists $options{f} ? 'TRUE' : 'FALSE'; -my $install_new = exists $options{N} ? 'TRUE' : 'FALSE'; -my $no_readme = exists $options{r} ? 'TRUE' : 'FALSE'; -my $no_install = exists $options{i} ? 'TRUE' : 'FALSE'; -my $only_new = exists $options{o} ? 'TRUE' : 'FALSE'; -my $compat32 = exists $options{p} ? 'TRUE' : 'FALSE'; -my $no_reqs = exists $options{R} ? 'TRUE' : 'FALSE'; +my $force = exists $options{f} ? 1 : 0; +my $install_new = exists $options{N} ? 1 : 0; +my $no_readme = exists $options{r} ? 1 : 0; +my $no_install = exists $options{i} ? 1 : 0; +my $only_new = exists $options{o} ? 1 : 0; +my $compat32 = exists $options{p} ? 1 : 0; +my $no_reqs = exists $options{R} ? 1 : 0; if (exists $options{j}) { die "You have provided an invalid parameter for -j\n" unless @@ -63,30 +63,30 @@ if (exists $options{j}) { } my $jobs = exists $options{j} ? $options{j} : $config{JOBS}; -show_usage () and exit (1) unless exists $ARGV[0]; +show_usage and exit 1 unless exists $ARGV[0]; # if we can't find SLACKBUILDS.TXT in $config{HOME}, prompt to fetch the tree -slackbuilds_or_fetch (); +slackbuilds_or_fetch; # build a hash of locations for each item provided on command line, at the same # time verifying each item is a valid slackbuild my %locations; for my $sbo_name (@ARGV) { - $locations{$sbo_name} = get_sbo_location ($sbo_name); + $locations{$sbo_name} = get_sbo_location $sbo_name; die "Unable to locate $sbo_name in the SlackBuilds.org tree.\n" unless defined $locations{$sbo_name}; } -sub get_readme_path { - exists $_[0] or script_error ('get_readme_path requires an argument.'); +sub get_readme_path ($) { + exists $_[0] or script_error 'get_readme_path requires an argument.'; my $sbo = shift; return $locations{$sbo} .'/README'; } # this subroutine may be getting a little out of hand. -sub grok_requirements { - exists $_[1] or script_error ('grok_requirements requires two arguments'); - return if $no_reqs eq 'TRUE'; +sub grok_requirements ($$) { + exists $_[1] or script_error 'grok_requirements requires two arguments'; + return if $no_reqs; my ($sbo, $readme) = @_; my $readme_orig = $readme; for ($readme) { @@ -125,10 +125,9 @@ sub grok_requirements { FIRST: for my $need (@deps) { # compare against installed slackbuilds my $tempname = $compat32 eq 'TRUE' ? "$need-compat32" : $need; - my @inst = get_installed_sbos (); - SECOND: for my $key (keys @inst) { - next FIRST if $tempname eq $inst[$key]{name}; - } + my $inst = get_installed_sbos; + my $inst_names = get_inst_names $inst; + next FIRST if $tempname ~~ @$inst_names; print "\n". $readme_orig; print "\nIt looks like this slackbuild requires $tempname; shall I"; print " attempt to install it first? [y] "; @@ -138,7 +137,7 @@ sub grok_requirements { push @args, "-c" if exists $options{c}; push @args, "-d" if exists $options{d}; push @args, "-j $options{j}" if exists $options{j}; - push @args, "-p" if $compat32 eq 'TRUE'; + push @args, "-p" if $compat32; push @args, $need; system (@args) == 0 or die "Requirement failure, unable to proceed.\n"; @@ -148,18 +147,18 @@ sub grok_requirements { } # look for any (user|group)add commands in the README -sub grok_user_group { - exists $_[0] or script_error ('grok_user_group requires an argument'); +sub grok_user_group ($) { + exists $_[0] or script_error 'grok_user_group requires an argument'; my $readme = shift; - my @readme_array = split /\n/, $readme; + my $readme_array = [split /\n/, $readme]; my @cmds; my $cmd_regex = qr/^\s*#\s+((user|group)add.*)/; - push @cmds, ($_ =~ $cmd_regex)[0] for @readme_array; + push @cmds, ($_ =~ $cmd_regex)[0] for @$readme_array; return unless exists $cmds[0]; - print "\n". $readme ."\n";; + say "\n". $readme; print "\nIt looks like this slackbuild requires the following command(s)"; - print " to be run first:\n"; - print " # $_\n" for @cmds; + say ' to be run first:'; + say " # $_" for @cmds; print "Shall I run it/them now? [y] "; if (<STDIN> =~ /^[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; |