diff options
| -rw-r--r-- | SBO-Lib/lib/SBO/Lib.pm | 138 | ||||
| -rwxr-xr-x | sbocheck | 16 | ||||
| -rwxr-xr-x | sboclean | 12 | ||||
| -rwxr-xr-x | sboconfig | 14 | ||||
| -rwxr-xr-x | sbofind | 12 | ||||
| -rwxr-xr-x | sboinstall | 6 | ||||
| -rwxr-xr-x | sboremove | 10 | ||||
| -rwxr-xr-x | sbosnap | 6 | ||||
| -rwxr-xr-x | sboupgrade | 52 |
9 files changed, 133 insertions, 133 deletions
diff --git a/SBO-Lib/lib/SBO/Lib.pm b/SBO-Lib/lib/SBO/Lib.pm index 47a379d..dae56e7 100644 --- a/SBO-Lib/lib/SBO/Lib.pm +++ b/SBO-Lib/lib/SBO/Lib.pm @@ -59,14 +59,14 @@ use File::Find; use File::Basename; use Fcntl qw(F_SETFD F_GETFD); -our $tempdir = tempdir (CLEANUP => 1); +our $tempdir = tempdir(CLEANUP => 1); # define this to facilitate unit testing - should only ever be modified from # t/test.t our $pkg_db = '/var/log/packages'; # subroutine for throwing internal script errors -sub script_error (;$) { +sub script_error(;$) { exists $_[0] ? die "A fatal script error has occurred:\n$_[0]\nExiting.\n" : die "A fatal script error has occurred. Exiting.\n"; } @@ -82,8 +82,8 @@ sub open_fh { return $fh; } -sub open_read ($) { - return open_fh (shift, '<'); +sub open_read($) { + return open_fh(shift, '<'); } # global config variables @@ -98,7 +98,7 @@ our %config = ( ); # subroutine to suck in config in order to facilitate unit testing -sub read_config () { +sub read_config() { my %conf_values; if (-f $conf_file) { my $fh = open_read $conf_file; @@ -120,7 +120,7 @@ our $distfiles = "$config{SBO_HOME}/distfiles"; our $slackbuilds_txt = "$config{SBO_HOME}/SLACKBUILDS.TXT"; my $name_regex = '\ASLACKBUILD\s+NAME:\s+'; -sub show_version () { +sub show_version() { say "sbotools version $VERSION"; say 'licensed under the WTFPL'; say '<http://sam.zoy.org/wtfpl/COPYING>'; @@ -129,10 +129,10 @@ sub show_version () { # %supported maps what's in /etc/slackware-version to what's at SBo # which is now not needed since this version drops support < 14.0 # but it's already future-proofed, so leave it. -sub get_slack_version () { +sub get_slack_version() { my %supported = ('14.0' => '14.0'); my $fh = open_read '/etc/slackware-version'; - chomp (my $line = <$fh>); + chomp(my $line = <$fh>); close $fh; my $version = ($line =~ /\s+(\d+[^\s]+)$/)[0]; die "Unsupported Slackware version: $version\n" @@ -141,27 +141,27 @@ sub get_slack_version () { } # does the SLACKBUILDS.TXT file exist in the sbo tree? -sub chk_slackbuilds_txt () { +sub chk_slackbuilds_txt() { return -f $slackbuilds_txt ? 1 : undef; } # check for the validity of new $config{SBO_HOME} -sub check_home () { +sub check_home() { my $sbo_home = $config{SBO_HOME}; if (-d $sbo_home) { - opendir (my $home_handle, $sbo_home); + opendir(my $home_handle, $sbo_home); FIRST: while (readdir $home_handle) { next FIRST if /^\.[\.]{0,1}$/; die "$sbo_home exists and is not empty. Exiting.\n"; } } else { - make_path ($sbo_home) or die "Unable to create $sbo_home.\n"; + make_path($sbo_home) or die "Unable to create $sbo_home.\n"; } return 1; } # rsync the sbo tree from slackbuilds.org to $config{SBO_HOME} -sub rsync_sbo_tree () { +sub rsync_sbo_tree() { my $slk_version = get_slack_version; my @arg = ('rsync', '-a', '--exclude=*.tar.gz', '--exclude=*.tar.gz.asc'); push @arg, '--delete', "rsync://slackbuilds.org/slackbuilds/$slk_version/*"; @@ -170,18 +170,18 @@ sub rsync_sbo_tree () { $File::Find::name ? chown 0, 0, $File::Find::name : chown 0, 0, $File::Find::dir; }; - find ($wanted, $config{SBO_HOME}); + find($wanted, $config{SBO_HOME}); say 'Finished.' and return $out; } # wrappers for differing checks and output -sub fetch_tree () { +sub fetch_tree() { check_home; say 'Pulling SlackBuilds tree...'; rsync_sbo_tree, return 1; } -sub update_tree () { +sub update_tree() { fetch_tree, return unless chk_slackbuilds_txt; say 'Updating SlackBuilds tree...'; rsync_sbo_tree, return 1; @@ -189,7 +189,7 @@ sub update_tree () { # if the SLACKBUILDS.TXT is not in $config{SBO_HOME}, we assume the tree has # not been populated there; prompt the user to automagickally pull the tree. -sub slackbuilds_or_fetch () { +sub slackbuilds_or_fetch() { unless (chk_slackbuilds_txt) { say 'It looks like you haven\'t run "sbosnap fetch" yet.'; print 'Would you like me to do this now? [y] '; @@ -201,7 +201,7 @@ sub slackbuilds_or_fetch () { # pull an array of hashes, each hash containing the name and version of an sbo # currently installed. -sub get_installed_sbos () { +sub get_installed_sbos() { my @installed; # $1 == name, $2 == version my $regex = qr#/([^/]+)-([^-]+)-[^-]+-[^-]+$#; @@ -214,7 +214,7 @@ sub get_installed_sbos () { # for a ref to an array of hashes of installed packages, return an array ref # consisting of just their names -sub get_inst_names ($) { +sub get_inst_names($) { exists $_[0] or script_error 'get_inst_names requires an argument.'; my $inst = shift; my @installed; @@ -255,7 +255,7 @@ sub get_sbo_location { } # pull the sbo name from a $location: $config{SBO_HOME}/system/wine, etc. -sub get_sbo_from_loc ($) { +sub get_sbo_from_loc($) { exists $_[0] or script_error 'get_sbo_from_loc requires an argument.'; return (shift =~ qr#/([^/]+)$#)[0]; } @@ -293,23 +293,23 @@ sub get_from_info { } # find the version in the tree for a given sbo (provided a location) -sub get_sbo_version ($) { +sub get_sbo_version($) { exists $_[0] or script_error 'get_sbo_version requires an argument.'; - my $version = get_from_info (LOCATION => shift, GET => 'VERSION'); + my $version = get_from_info(LOCATION => shift, GET => 'VERSION'); return $$version[0] ? $$version[0] : undef; } # for each installed sbo, find out whether or not the version in the tree is # newer, and compile an array of hashes containing those which are -sub get_available_updates () { +sub get_available_updates() { my @updates; my $pkg_list = get_installed_sbos; FIRST: for my $key (keys @$pkg_list) { - my $location = get_sbo_location ($$pkg_list[$key]{name}); + my $location = get_sbo_location($$pkg_list[$key]{name}); # if we can't find a location, assume invalid and skip next FIRST unless defined $location; my $version = get_sbo_version $location; - if (versioncmp ($version, $$pkg_list[$key]{version}) == 1) { + if (versioncmp($version, $$pkg_list[$key]{version}) == 1) { push @updates, { name => $$pkg_list[$key]{name}, installed => $$pkg_list[$key]{version}, @@ -331,12 +331,12 @@ sub get_download_info { $args{LOCATION} or script_error 'get_download_info requires LOCATION.'; my ($get, $downs, $md5s, %return); $get = ($args{X64} ? 'DOWNLOAD_x86_64' : 'DOWNLOAD'); - $downs = get_from_info (LOCATION => $args{LOCATION}, GET => $get); + $downs = get_from_info(LOCATION => $args{LOCATION}, GET => $get); # did we get nothing back, or UNSUPPORTED/UNTESTED? if ($args{X64}) { if (! $$downs[0] || $$downs[0] =~ qr/^UN(SUPPOR|TES)TED$/) { $args{X64} = 0; - $downs = get_from_info (LOCATION => $args{LOCATION}, + $downs = get_from_info(LOCATION => $args{LOCATION}, GET => 'DOWNLOAD'); } } @@ -344,14 +344,14 @@ sub get_download_info { return unless $$downs[0]; # grab the md5s and build a hash $get = $args{X64} ? 'MD5SUM_x86_64' : 'MD5SUM'; - $md5s = get_from_info (LOCATION => $args{LOCATION}, GET => $get); + $md5s = get_from_info(LOCATION => $args{LOCATION}, GET => $get); return unless $$md5s[0]; $return{$$downs[$_]} = $$md5s[$_] for (keys @$downs); return %return; } -sub get_arch () { - chomp (my $arch = `uname -m`); +sub get_arch() { + chomp(my $arch = `uname -m`); return $arch; } @@ -368,16 +368,16 @@ sub get_sbo_downloads { my $arch = get_arch; my %dl_info; if ($arch eq 'x86_64') { - %dl_info = get_download_info (LOCATION => $location) unless $args{32}; + %dl_info = get_download_info(LOCATION => $location) unless $args{32}; } unless (keys %dl_info > 0) { - %dl_info = get_download_info (LOCATION => $location, X64 => 0); + %dl_info = get_download_info(LOCATION => $location, X64 => 0); } return %dl_info; } # given a link, grab the filename from it and prepend $distfiles -sub get_filename_from_link ($) { +sub get_filename_from_link($) { exists $_[0] or script_error 'get_filename_from_link requires an argument'; my $fn = shift; my $regex = qr#/([^/]+)$#; @@ -387,11 +387,11 @@ sub get_filename_from_link ($) { } # for a given file, compute its md5sum -sub compute_md5sum ($) { +sub compute_md5sum($) { -f $_[0] or script_error 'compute_md5sum requires a file argument.'; my $fh = open_read shift; my $md5 = Digest::MD5->new; - $md5->addfile ($fh); + $md5->addfile($fh); my $md5sum = $md5->hexdigest; close $fh; return $md5sum; @@ -416,10 +416,10 @@ sub get_distfile { my $filename = get_filename_from_link $link; mkdir $distfiles unless -d $distfiles; chdir $distfiles; - system ("wget --no-check-certificate $link") == 0 or + system("wget --no-check-certificate $link") == 0 or die "Unable to wget $link\n"; # can't do anything if the link in the .info doesn't lead to a good d/l - verify_distfile (@_) ? return 1 : die "md5sum failure for $filename.\n"; + verify_distfile(@_) ? return 1 : die "md5sum failure for $filename.\n"; return 1; } @@ -434,15 +434,15 @@ sub get_symlink_from_filename { } # determine whether or not a given sbo is 32-bit only -sub check_x32 ($) { +sub check_x32($) { exists $_[0] or script_error 'check_x32 requires an argument.'; - my $dl = get_from_info (LOCATION => shift, GET => 'DOWNLOAD_x86_64'); + my $dl = get_from_info(LOCATION => shift, GET => 'DOWNLOAD_x86_64'); return $$dl[0] =~ /UN(SUPPOR|TES)TED/ ? 1 : undef; } # can't do 32-bit on x86_64 without this file, so we'll use it as the test to # to determine whether or not an x86_64 system is setup for multilib -sub check_multilib () { +sub check_multilib() { return 1 if -f '/etc/profile.d/32dev.sh'; return; } @@ -457,7 +457,7 @@ sub rewrite_slackbuild { $args{SLACKBUILD} or script_error 'rewrite_slackbuild requires SLACKBUILD.'; my $slackbuild = $args{SLACKBUILD}; my $changes = $args{CHANGES}; - copy ($slackbuild, "$slackbuild.orig") or + copy($slackbuild, "$slackbuild.orig") or die "Unable to backup $slackbuild to $slackbuild.orig\n"; my $libdir_regex = qr/^\s*LIBDIRSUFFIX="64"\s*$/; my $arch_regex = qr/\$VERSION-\$ARCH-\$BUILD/; @@ -477,7 +477,7 @@ sub rewrite_slackbuild { } # move a backed-up .SlackBuild file back into place -sub revert_slackbuild ($) { +sub revert_slackbuild($) { exists $_[0] or script_error 'revert_slackbuild requires an argument'; my $slackbuild = shift; if (-f "$slackbuild.orig") { @@ -493,7 +493,7 @@ sub check_distfiles { exists $_[0] or script_error 'check_distfiles requires an argument.'; my %dists = @_; while (my ($link, $md5) = each %dists) { - get_distfile ($link, $md5) unless verify_distfile ($link, $md5); + get_distfile($link, $md5) unless verify_distfile($link, $md5); } return 1; } @@ -506,7 +506,7 @@ sub create_symlinks { my @symlinks; for my $link (keys %downloads) { my $filename = get_filename_from_link $link; - my $symlink = get_symlink_from_filename ($filename, $location); + my $symlink = get_symlink_from_filename($filename, $location); push @symlinks, $symlink; symlink $filename, $symlink; } @@ -538,22 +538,22 @@ sub grok_temp_file { } # wrappers around grok_temp_file -sub get_src_dir ($) { +sub get_src_dir($) { exists $_[0] or script_error 'get_src_dir requires an argument'; - return grok_temp_file (FH => shift, REGEX => qr#^([^/]+)/#); + return grok_temp_file(FH => shift, REGEX => qr#^([^/]+)/#); } -sub get_pkg_name ($) { +sub get_pkg_name($) { exists $_[0] or script_error 'get_pkg_name requires an argument'; - return grok_temp_file (FH => shift, + return grok_temp_file(FH => shift, REGEX => qr/^Slackware\s+package\s+([^\s]+)\s+created\.$/); } # return a filename from a temp fh for use externally -sub get_tmp_extfn ($) { +sub get_tmp_extfn($) { exists $_[0] or script_error 'get_tmp_extfn requires an argument.'; my $fh = shift; - fcntl ($fh, F_SETFD, 0) or die "Can't unset exec-on-close bit\n"; + fcntl($fh, F_SETFD, 0) or die "Can't unset exec-on-close bit\n"; return '/dev/fd/'. fileno $fh; } @@ -591,13 +591,13 @@ sub perform_sbo { $cmd .= " $args{OPTS}" if $args{OPTS}; $cmd .= " MAKEOPTS=\"-j$args{JOBS}\"" if $args{JOBS}; # get a tempfile to store the exit status of the slackbuild - my $exit_temp = tempfile (DIR => $tempdir); + my $exit_temp = tempfile(DIR => $tempdir); my $exit_fn = get_tmp_extfn $exit_temp; $cmd .= " /bin/sh $location/$sbo.SlackBuild; echo \$? > $exit_fn )"; - my $tempfh = tempfile (DIR => $tempdir); + my $tempfh = tempfile(DIR => $tempdir); my $fn = get_tmp_extfn $tempfh; $cmd .= " | tee -a $fn"; - rewrite_slackbuild ( + rewrite_slackbuild( SLACKBUILD => "$location/$sbo.SlackBuild", CHANGES => \%changes, ); @@ -612,13 +612,13 @@ sub perform_sbo { } # run convertpkg on a package to turn it into a -compat32 thing -sub do_convertpkg ($) { +sub do_convertpkg($) { exists $_[0] or script_error 'do_convertpkg requires an argument.'; my $pkg = shift; - my $tempfh = tempfile (DIR => $tempdir); + my $tempfh = tempfile(DIR => $tempdir); my $fn = get_tmp_extfn $tempfh; my $cmd = "/usr/sbin/convertpkg-compat32 -i $pkg -d /tmp | tee $fn"; - system ($cmd) == 0 or + system($cmd) == 0 or die "convertpkg-compt32 returned non-zero exit status\n"; unlink $pkg; return get_pkg_name $tempfh; @@ -654,14 +654,14 @@ sub do_slackbuild { } } # get a hash of downloads and md5sums, ensure we have 'em, symlink 'em - my %downloads = get_sbo_downloads ( + my %downloads = get_sbo_downloads( LOCATION => $location, 32 => $args{COMPAT32} ); check_distfiles %downloads; - my @symlinks = create_symlinks ($args{LOCATION}, %downloads); + my @symlinks = create_symlinks($args{LOCATION}, %downloads); # setup and run the .SlackBuild itself - my ($pkg, $src) = perform_sbo ( + my ($pkg, $src) = perform_sbo( OPTS => $args{OPTS}, JOBS => $args{JOBS}, LOCATION => $location, @@ -687,8 +687,8 @@ sub make_clean { } 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 + remove_tree("$tmpsbo/$args{SRC}") if -d "$tmpsbo/$args{SRC}"; + remove_tree("$tmpsbo/package-$args{SBO}") if -d "$tmpsbo/package-$args{SBO}"; return 1; } @@ -705,10 +705,10 @@ sub make_distclean { script_error 'make_distclean requires four arguments.'; } my $sbo = get_sbo_from_loc $args{LOCATION}; - make_clean (SBO => $sbo, SRC => $args{SRC}, VERSION => $args{VERSION}); + make_clean(SBO => $sbo, SRC => $args{SRC}, VERSION => $args{VERSION}); say "Distcleaning for $sbo-$args{VERSION}..."; # remove any distfiles for this particular SBo. - my %downloads = get_sbo_downloads (LOCATION => $args{LOCATION}); + my %downloads = get_sbo_downloads(LOCATION => $args{LOCATION}); for my $key (keys %downloads) { my $filename = get_filename_from_link $key; unlink $filename if -f $filename; @@ -717,14 +717,14 @@ sub make_distclean { } # run upgradepkg for a created package -sub do_upgradepkg ($) { +sub do_upgradepkg($) { exists $_[0] or script_error 'do_upgradepkg requires an argument.'; - system ('/sbin/upgradepkg', '--reinstall', '--install-new', shift); + system('/sbin/upgradepkg', '--reinstall', '--install-new', shift); return 1; } # wrapper to pull the list of requirements for a given sbo -sub get_requires ($) { +sub get_requires($) { my $location = get_sbo_location(shift); return unless $location; my $info = get_from_info(LOCATION => $location, GET => 'REQUIRES'); @@ -732,9 +732,9 @@ sub get_requires ($) { } # avoid being called to early to check prototype when add_to_queue calls itself -sub add_to_queue ($); +sub add_to_queue($); # used by get_build_queue. -sub add_to_queue ($) { +sub add_to_queue($) { my $args = shift; my $sbo = \${$args}{NAME}; return unless $$sbo; @@ -784,4 +784,4 @@ sub merge_queues { push @$queue_a, $item unless $item ~~ @$queue_a; } return $queue_a; -}
\ No newline at end of file +} @@ -17,9 +17,9 @@ use Getopt::Long; use Text::Tabulate; use File::Basename; -my $self = basename ($0); +my $self = basename($0); -sub show_usage () { +sub show_usage() { print <<EOF Usage: $self @@ -34,7 +34,7 @@ EOF my ($help, $vers); -GetOptions ('help|h' => \$help, 'version|v' => \$vers); +GetOptions('help|h' => \$help, 'version|v' => \$vers); show_usage and exit 0 if $help; show_version and exit 0 if $vers; @@ -42,7 +42,7 @@ show_version and exit 0 if $vers; update_tree; # retrieve and format list of available updates -sub get_update_list () { +sub get_update_list() { print "Checking for updated SlackBuilds...\n"; my $updates = get_available_updates; # pretty formatting. @@ -56,13 +56,13 @@ sub get_update_list () { } # Text::Tabulate and print list of updates -sub print_output ($) { +sub print_output($) { exists $_[0] or script_error 'print_output requires an argument'; my $listing = shift; if (exists $$listing[0]) { - my $tab = new Text::Tabulate (); - $tab->configure (tab => '\s'); - my $output = $tab->format (@$listing); + my $tab = new Text::Tabulate(); + $tab->configure(tab => '\s'); + my $output = $tab->format(@$listing); say "\n". $output; } else { say "\nNo updates available."; @@ -17,9 +17,9 @@ use File::Basename; use Getopt::Long qw(:config bundling); use File::Path qw(remove_tree); -my $self = basename ($0); +my $self = basename($0); -sub show_usage () { +sub show_usage() { print <<EOF Usage: $self (options) [package] @@ -40,7 +40,7 @@ EOF my ($help, $vers, $clean_dist, $clean_work, $interactive); -GetOptions ( +GetOptions( 'help|h' => \$help, 'version|v' => \$vers, 'clean-dist|d' => \$clean_dist, @@ -54,11 +54,11 @@ show_version and exit 0 if $vers; show_usage, die "You must specify at least one of -d or -w.\n" unless ($clean_dist || $clean_work); -sub remove_stuff ($) { +sub remove_stuff($) { exists $_[0] or script_error 'remove_stuff requires an argument'; -d $_[0] or say 'Nothing to do.' and return 1; my $dir = shift; - opendir (my $dh, $dir); + opendir(my $dh, $dir); FIRST: while (my $ls = readdir $dh) { next FIRST if $ls =~ /^(\.){1,2}$/; my $full = "$dir/$ls"; @@ -67,7 +67,7 @@ sub remove_stuff ($) { next FIRST unless <STDIN> =~ /^[Yy]/; } unlink $full if -f $full; - remove_tree ($full) if -d $full; + remove_tree($full) if -d $full; } } @@ -19,9 +19,9 @@ use File::Copy; use File::Path qw(make_path); use File::Temp qw(tempfile);; -my $self = basename ($0); +my $self = basename($0); -sub show_usage () { +sub show_usage() { print <<EOF Usage: $self [options] [arguments] @@ -47,7 +47,7 @@ EOF my %options; -GetOptions (\%options, 'help|h', 'version|v', 'list|l', 'noclean|c=s', +GetOptions(\%options, 'help|h', 'version|v', 'list|l', 'noclean|c=s', 'distclean|d=s', 'jobs|j=s', 'pkg-dir|p=s', 'sbo-home|s=s'); show_usage and exit 0 if exists $options{help}; @@ -113,7 +113,7 @@ sub config_write { mkdir $conf_dir or die "Unable to create $conf_dir. Exiting.\n"; } if (-f $conf_file) { - my $tempfh = tempfile (DIR => $tempdir); + my $tempfh = tempfile(DIR => $tempdir); my $conffh = open_read $conf_file; my $conftents = do {local $/; <$conffh>}; print {$tempfh} $conftents; @@ -132,13 +132,13 @@ sub config_write { seek $tempfh, 0, 0; my $contents = do {local $/; <$tempfh>}; close $conffh; - eval { $conffh = open_fh ($conf_file, '>') }; + eval { $conffh = open_fh($conf_file, '>') }; warn "Cannot write configuration: $@\n" and return if $@; print {$conffh} $contents or return; close $conffh, close $tempfh; } else { # no config file, easiest case of all. - my $fh = open_fh ($conf_file, '>') or return; + my $fh = open_fh($conf_file, '>') or return; print {$fh} "$key=$val\n"; close $fh; } @@ -147,7 +147,7 @@ sub config_write { while (my ($key, $value) = each %changes) { say "Setting $key to $value..."; - config_write ($key, $value) or warn "Unable to write to $conf_file\n"; + config_write($key, $value) or warn "Unable to write to $conf_file\n"; } exit 0; @@ -16,9 +16,9 @@ use SBO::Lib; use File::Basename; use Getopt::Long qw(:config bundling); -my $self = basename ($0); +my $self = basename($0); -sub show_usage () { +sub show_usage() { print <<EOF Usage: $self (search_term) @@ -42,7 +42,7 @@ EOF my ($help, $vers, $show_info, $show_readme, $show_queue); -GetOptions ( +GetOptions( 'help|h' => \$help, 'version|v' => \$vers, 'info|i' => \$show_info, @@ -60,7 +60,7 @@ my $search = $ARGV[0]; slackbuilds_or_fetch; # find anything with $search in its name -sub perform_search ($) { +sub perform_search($) { exists $_[0] or script_error 'perform_search requires an argument.'; my $search = shift; my (@findings, $name, $found); @@ -82,7 +82,7 @@ sub perform_search ($) { } # pull the contents of a file into a variable and format it for output -sub get_file_contents ($) { +sub get_file_contents($) { exists $_[0] or script_error 'get_file_contents requires an argument'; -f $_[0] or return "$_[0] doesn't exist.\n"; my $fh = open_read shift; @@ -95,7 +95,7 @@ sub get_file_contents ($) { } # get build queue and return it as a single line. -sub show_build_queue ($) { +sub show_build_queue($) { exists $_[0] or script_error 'show_build_queue requires an argument.'; my $queue = get_build_queue([shift], {}); return join(" ", reverse @$queue); @@ -16,9 +16,9 @@ use SBO::Lib; use Getopt::Long qw(:config bundling); use File::Basename; -my $self = basename ($0); +my $self = basename($0); -sub show_usage () { +sub show_usage() { print <<EOF Usage: $self [options] sbo @@ -50,7 +50,7 @@ my $distclean = $config{DISTCLEAN}; my $jobs = $config{JOBS}; my ($help, $vers, $no_install, $non_int, $no_reqs, $compat32); -GetOptions ( +GetOptions( 'help|h' => \$help, 'version|v' => \$vers, 'noclean|c=s' => \$noclean, @@ -72,7 +72,7 @@ exit 0 unless exists $sbos[0]; # Create full queue. my ($remove_queue, %warnings); for my $sbo (@sbos) { - my $queue = get_build_queue ([$sbo], \%warnings); + my $queue = get_build_queue([$sbo], \%warnings); @$queue = reverse(@$queue); $remove_queue = merge_queues($remove_queue, $queue); } @@ -85,7 +85,7 @@ $req_store{$_} = get_requires $_ for @$remove_queue; my (%required_by, @confirmed); # populates the required_by hash -sub get_reverse_reqs ($) { +sub get_reverse_reqs($) { my $installed = shift; FIRST: for my $inst (@$installed) { my $require = get_requires $inst; @@ -101,7 +101,7 @@ get_reverse_reqs $inst_names; # returns a list of installed sbo's that list the given sbo as a requirement, # excluding any installed sbo's that have already been confirmed for removal -sub get_required_by ($) { +sub get_required_by($) { my $sbo = shift; my @dep_of; if ( $required_by{$sbo} ) { @@ -114,7 +114,7 @@ sub get_required_by ($) { return exists $dep_of[0] ? \@dep_of : undef; } -sub confirm_remove ($) { +sub confirm_remove($) { my $sbo = shift; push @confirmed, $sbo unless $sbo ~~ @confirmed; } @@ -157,7 +157,7 @@ FIRST: for my $remove (@$remove_queue) { say "It is recommended that you view the README before continuing."; print "Display README now? [y]: "; my $location = get_sbo_location($remove); - my $fh = open_read ($location .'/README'); + my $fh = open_read($location .'/README'); my $readme = do {local $/; <$fh>}; close $fh; @@ -17,9 +17,9 @@ use File::Basename; use Getopt::Long; my $sbo_home = $config{SBO_HOME}; -my $self = basename ($0); +my $self = basename($0); -sub show_usage () { +sub show_usage() { print <<EOF Usage: $self [options|command] @@ -41,7 +41,7 @@ show_usage and exit 1 unless exists $ARGV[0]; my ($help, $vers); -GetOptions ('help|h' => \$help, 'version|v' => \$vers); +GetOptions('help|h' => \$help, 'version|v' => \$vers); show_usage and exit 0 if $help; show_version and exit 0 if $vers; @@ -17,9 +17,9 @@ use Getopt::Long qw(:config bundling); use File::Basename; use File::Copy; -my $self = basename ($0); +my $self = basename($0); -sub show_usage () { +sub show_usage() { print <<EOF Usage: $self (options) [package] @@ -56,7 +56,7 @@ my $jobs = $config{JOBS}; my ($help, $vers, $force, $no_install, $install_new, $non_int, $no_reqs, $force_reqs, $only_new, $compat32); -GetOptions ( +GetOptions( 'help|h' => \$help, 'version|v' => \$vers, 'noclean|c=s' => \$noclean, @@ -103,25 +103,25 @@ if ($no_reqs or $non_int) { $build_queue = \@ARGV; } else { for my $sbo (@ARGV) { - my $queue = get_build_queue ([$sbo], \%warnings); + my $queue = get_build_queue([$sbo], \%warnings); $build_queue = merge_queues($build_queue, $queue); } } # p7zip fmodapi eawpats TiMidity++ zdoom OpenAL bsnes jdk DevIL spring for my $sbo (@$build_queue) { - $locations{$sbo} = get_sbo_location ($sbo); + $locations{$sbo} = get_sbo_location($sbo); die "Unable to locate $sbo in the SlackBuilds.org tree.\n" unless defined $locations{$sbo}; } -sub get_readme_path ($) { +sub get_readme_path($) { exists $_[0] or script_error 'get_readme_path requires an argument.'; my $sbo = shift; return $locations{$sbo} .'/README'; } # look for any (user|group)add commands in the README -sub get_user_group ($) { +sub get_user_group($) { exists $_[0] or script_error 'get_user_group requires an argument'; my $readme = shift; my @cmds = $readme =~ /^\s*#*\s*(useradd.*|groupadd.*)/mg; @@ -141,7 +141,7 @@ sub ask_user_group { } # see if the README mentions any options -sub get_opts ($) { +sub get_opts($) { exists $_[0] or script_error 'get_opts requires an argument'; my $readme = shift; return $readme =~ /[A-Z0-9]+=[^\s]/ ? 1 : undef; @@ -155,9 +155,9 @@ sub ask_opts { print "\nIt looks like $sbo has options; would you like to set any"; print ' when the slackbuild is run? [n] '; if (<STDIN> =~ /^[Yy]/) { - my $ask = sub () { + my $ask = sub() { print "\nPlease supply any options here, or enter to skip: "; - chomp (my $opts = <STDIN>); + chomp(my $opts = <STDIN>); return if $opts =~ /^\n/; return $opts; }; @@ -176,18 +176,18 @@ sub ask_opts { sub user_prompt { exists $_[1] or script_error 'user_prompt requires two arguments.'; my ($sbo, $location) = @_; - my $fh = open_read ($location .'/README'); + my $fh = open_read($location .'/README'); my $readme = do {local $/; <$fh>}; close $fh; # check for user/group add commands, offer to run any found my $user_group = get_user_group $readme; my $cmds; - $cmds = ask_user_group ($user_group, $readme) if $$user_group[0]; + $cmds = ask_user_group($user_group, $readme) if $$user_group[0]; $commands{$sbo} = $cmds if defined $cmds; # check for options mentioned in the README my $opts = 0; - $opts = ask_opts ($sbo, $readme) if get_opts $readme; + $opts = ask_opts($sbo, $readme) if get_opts $readme; print "\n". $readme unless $opts; $options{$sbo} = $opts if $opts; @@ -197,7 +197,7 @@ sub user_prompt { } # do the things with the provided sbos - whether upgrades or new installs. -sub process_sbos ($) { +sub process_sbos($) { exists $_[0] or script_error 'process_sbos requires an argument.'; my $todo = shift; my %failures; @@ -206,13 +206,13 @@ sub process_sbos ($) { $opts = $options{$sbo} if defined $options{$sbo}; my $cmds = $commands{$sbo} if defined $commands{$sbo}; for my $cmd (@$cmds) { - system ($cmd) == 0 or warn "\"$cmd\" exited non-zero\n"; + system($cmd) == 0 or warn "\"$cmd\" exited non-zero\n"; } # switch compat32 on if upgrading a -compat32 # else make sure compat32 is off $compat32 = $sbo =~ /-compat32$/ ? 1 : 0; my ($version, $pkg, $src); - eval { ($version, $pkg, $src) = do_slackbuild ( + eval { ($version, $pkg, $src) = do_slackbuild( OPTS => $opts, JOBS => $jobs, LOCATION => $locations{$sbo}, @@ -224,10 +224,10 @@ sub process_sbos ($) { do_upgradepkg $pkg unless $no_install; unless ($distclean) { - make_clean (SBO => $sbo, SRC => $src, VERSION => $version) + make_clean(SBO => $sbo, SRC => $src, VERSION => $version) unless $noclean; } else { - make_distclean ( + make_distclean( SBO => $sbo, SRC => $src, VERSION => $version, @@ -238,10 +238,10 @@ sub process_sbos ($) { unless ($config{PKG_DIR} eq 'FALSE') { my $dir = $config{PKG_DIR}; unless (-d $dir) { - mkdir ($dir) or warn "Unable to create $dir\n"; + mkdir($dir) or warn "Unable to create $dir\n"; } if (-d $dir) { - move ($pkg, $dir), say "$pkg stored in $dir"; + move($pkg, $dir), say "$pkg stored in $dir"; } else { warn "$pkg left in /tmp\n"; } @@ -262,7 +262,7 @@ sub print_failures { } } -my $inst_names = get_inst_names (get_installed_sbos); +my $inst_names = get_inst_names(get_installed_sbos); my $upgrade_queue; @$upgrade_queue = (); # deal with any updates prior to any new installs. @@ -333,7 +333,7 @@ FIRST: for my $sbo (@$build_queue) { say "$name already installed." unless $force; next FIRST; } - $locations{$name} = get_sbo_location ($sbo) if $compat32; + $locations{$name} = get_sbo_location($sbo) if $compat32; unless ($non_int) { # if compat32 is TRUE, we need to see if the non-compat version exists. if ($compat32) { @@ -374,16 +374,16 @@ my %failures; if ( $force and ! $force_reqs) { # Install missing reqs then rebuild sbo's %failures = process_sbos $build_queue if exists $$build_queue[0]; - print_failures (%failures); + print_failures(%failures); %failures = process_sbos $upgrade_queue if exists $$upgrade_queue[0]; - print_failures (%failures); + print_failures(%failures); } else { # Upgrade any installed reqs/sbo's then build missing reqs/sbo's %failures = process_sbos $upgrade_queue if exists $$upgrade_queue[0]; - print_failures (%failures); + print_failures(%failures); %failures = process_sbos $build_queue if exists $$build_queue[0]; - print_failures (%failures); + print_failures(%failures); } exit 0; |