aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndreas Guldstrand <andreas.guldstrand@gmail.com>2016-02-27 13:12:55 +0100
committerAndreas Guldstrand <andreas.guldstrand@gmail.com>2016-02-27 13:12:55 +0100
commitd705028b246408929c45bfd1bccebe77cf433569 (patch)
treeb5264381cc445f41ae9e496c96e1ad0a37ba00b3
parent06a3c005611777ac6b622a87df6dc503a13faf80 (diff)
downloadsbotools2-d705028b246408929c45bfd1bccebe77cf433569.tar.xz
Change a number of exists() checks on arrays to scalar array instead
-rw-r--r--SBO-Lib/lib/SBO/Lib.pm67
1 files changed, 34 insertions, 33 deletions
diff --git a/SBO-Lib/lib/SBO/Lib.pm b/SBO-Lib/lib/SBO/Lib.pm
index c767c7e..9f75435 100644
--- a/SBO-Lib/lib/SBO/Lib.pm
+++ b/SBO-Lib/lib/SBO/Lib.pm
@@ -129,7 +129,7 @@ sub usage_error {
# sub for opening files, second arg is like '<','>', etc
sub open_fh {
- exists $_[1] or script_error 'open_fh requires two arguments';
+ @_ == 2 or script_error 'open_fh requires two arguments';
unless ($_[1] eq '>') {
-f $_[0] or script_error "open_fh, $_[0] is not a file";
}
@@ -286,7 +286,7 @@ sub pull_sbo_tree {
# rsync the sbo tree from slackbuilds.org to $repo_path
sub rsync_sbo_tree {
- exists $_[0] or script_error('rsync_sbo_tree requires an argument.');
+ @_ == 1 or script_error('rsync_sbo_tree requires an argument.');
my $url = shift;
$url .= '/' unless $url =~ m!/$!; # make sure $url ends with /
my @info;
@@ -297,7 +297,7 @@ sub rsync_sbo_tree {
}
sub git_sbo_tree {
- exists $_[0] or script_error('git_sbo_tree requires an argument.');
+ @_ == 1 or script_error('git_sbo_tree requires an argument.');
my $url = shift;
if (-d "$repo_path/.git" and check_git_remote($repo_path, $url)) {
my $cwd = getcwd();
@@ -317,7 +317,7 @@ sub git_sbo_tree {
}
sub check_git_remote {
- exists $_[1] or script_error('check_git_remote requires two arguments.');
+ @_ == 2 or script_error('check_git_remote requires two arguments.');
my ($path, $url) = @_;
my ($fh, $exit) = open_read("$path/.git/config");
return 0 if $exit;
@@ -392,7 +392,7 @@ sub slackbuilds_or_fetch {
# pull an array of hashes, each hash containing the name and version of a
# package currently installed. Gets filtered using STD, SBO or ALL.
sub get_installed_packages {
- exists $_[0] or script_error('get_installed_packages requires an argument.');
+ @_ == 1 or script_error('get_installed_packages requires an argument.');
my $filter = shift;
my @installed;
@@ -417,7 +417,7 @@ sub get_installed_packages {
# for a ref to an array of hashes of installed packages, return an array ref
# consisting of just their names
sub get_inst_names {
- exists $_[0] or script_error('get_inst_names requires an argument.');
+ @_ == 1 or script_error('get_inst_names requires an argument.');
my $inst = shift;
my @installed;
push @installed, $$_{name} for @$inst;
@@ -432,7 +432,7 @@ sub get_inst_names {
my %orig;
sub get_sbo_location {
- exists $_[0] or script_error('get_sbo_location requires an argument.');
+ @_ >= 1 or script_error('get_sbo_location requires an argument.');
my @sbos = @_;
if (ref $sbos[0] eq 'ARRAY') {
my $tmp = $sbos[0];
@@ -445,7 +445,7 @@ sub get_sbo_location {
}
sub get_sbo_locations {
- exists $_[0] or script_error('get_sbo_locations requires an argument.');
+ @_ >= 1 or script_error('get_sbo_locations requires an argument.');
my @sbos = @_;
if (ref $sbos[0] eq 'ARRAY') {
my $tmp = $sbos[0];
@@ -489,7 +489,7 @@ sub get_sbo_locations {
}
sub is_local {
- exists $_[0] or script_error('is_local requires an argument.');
+ @_ == 1 or script_error('is_local requires an argument.');
my $sbo = shift;
# Make sure we have checked for the slackbuild in question:
get_sbo_location($sbo);
@@ -497,7 +497,7 @@ sub is_local {
}
sub get_orig_location {
- exists $_[0] or script_error('get_orig_location requires an argument.');
+ @_ == 1 or script_error('get_orig_location requires an argument.');
my $sbo = shift;
# Make sure we have checked for the slackbuild in question:
get_sbo_location($sbo);
@@ -505,7 +505,7 @@ sub get_orig_location {
}
sub get_orig_version {
- exists $_[0] or script_error('get_orig_version requires an argument.');
+ @_ == 1 or script_error('get_orig_version requires an argument.');
my $sbo = shift;
my $location = get_orig_location($sbo);
@@ -538,7 +538,7 @@ sub get_local_outdated_versions {
# pull the sbo name from a $location: $repo_path/system/wine, etc.
sub get_sbo_from_loc {
- exists $_[0] or script_error('get_sbo_from_loc requires an argument.');
+ @_ == 1 or script_error('get_sbo_from_loc requires an argument.');
return (shift =~ qr#/([^/]+)$#)[0];
}
@@ -583,7 +583,7 @@ sub get_from_info {
# find the version in the tree for a given sbo (provided a location)
sub get_sbo_version {
- exists $_[0] or script_error('get_sbo_version requires an argument.');
+ @_ == 1 or script_error('get_sbo_version requires an argument.');
my $version = get_from_info(LOCATION => shift, GET => 'VERSION');
return $$version[0] ? $$version[0] : undef;
}
@@ -675,7 +675,7 @@ sub _get_fname {
}
sub get_filename_from_link {
- exists $_[0] or script_error('get_filename_from_link requires an argument');
+ @_ == 1 or script_error('get_filename_from_link requires an argument');
my $filename = _get_fname(shift);
return undef unless defined $filename;
return "$distfiles/$filename";
@@ -695,7 +695,7 @@ sub compute_md5sum {
# for a given distfile, see whether or not it exists, and if so, if its md5sum
# matches the sbo's .info file
sub verify_distfile {
- exists $_[1] or script_error('verify_distfile requires two arguments.');
+ @_ == 2 or script_error('verify_distfile requires two arguments.');
my ($link, $info_md5) = @_;
my $filename = get_filename_from_link($link);
return() unless -f $filename;
@@ -706,7 +706,7 @@ sub verify_distfile {
# for a given distfile, attempt to retrieve it and, if successful, check its
# md5sum against that in the sbo's .info file
sub get_distfile {
- exists $_[1] or script_error('get_distfile requires two arguments');
+ @_ == 2 or script_error('get_distfile requires two arguments');
my ($link, $info_md5) = @_;
my $filename = get_filename_from_link($link);
mkdir $distfiles unless -d $distfiles;
@@ -742,7 +742,7 @@ sub get_distfile {
# for a given distfile, figure out what the full path to its symlink will be
sub get_symlink_from_filename {
- exists $_[1] or script_error(
+ @_ == 2 or script_error(
'get_symlink_from_filename requires two arguments');
-f $_[0] or script_error(
'get_symlink_from_filename first argument is not a file');
@@ -752,7 +752,7 @@ sub get_symlink_from_filename {
# determine whether or not a given sbo is 32-bit only
sub check_x32 {
- exists $_[0] or script_error('check_x32 requires an argument.');
+ @_ == 1 or script_error('check_x32 requires an argument.');
my $dl = get_from_info(LOCATION => shift, GET => 'DOWNLOAD_x86_64');
return $$dl[0] =~ /UN(SUPPOR|TES)TED/ ? 1 : undef;
}
@@ -851,7 +851,7 @@ sub rewrite_slackbuild {
# move a backed-up .SlackBuild file back into place
sub revert_slackbuild {
- exists $_[0] or script_error('revert_slackbuild requires an argument');
+ @_ == 1 or script_error('revert_slackbuild requires an argument');
my $slackbuild = shift;
if (-f "$slackbuild.orig") {
unlink $slackbuild if -f $slackbuild;
@@ -896,7 +896,7 @@ sub check_distfiles {
# given a location and a list of download links, assemble a list of symlinks,
# and create them.
sub create_symlinks {
- exists $_[1] or script_error('create_symlinks requires two arguments.');
+ @_ == 2 or script_error('create_symlinks requires two arguments.');
my ($location, $downloads) = @_;
my @symlinks;
for my $link (keys %$downloads) {
@@ -921,7 +921,7 @@ sub get_pkg_name {
}
sub get_src_dir {
- exists $_[0] or script_error('get_src_dir requires an argument');
+ @_ == 1 or script_error('get_src_dir requires an argument');
my $fh = shift;
my @src_dirs;
# scripts use either $TMP or /tmp/SBo
@@ -948,7 +948,7 @@ sub get_src_dir {
# return a filename from a temp fh for use externally
sub get_tmp_extfn {
- exists $_[0] or script_error('get_tmp_extfn requires an argument.');
+ @_ == 1 or script_error('get_tmp_extfn requires an argument.');
my $fh = shift;
unless (fcntl($fh, F_SETFD, 0)) {
return "Can't unset exec-on-close bit.\n", _ERR_F_SETFD;
@@ -1035,7 +1035,7 @@ sub perform_sbo {
# run convertpkg on a package to turn it into a -compat32 thing
sub do_convertpkg {
- exists $_[0] or script_error('do_convertpkg requires an argument.');
+ @_ == 1 or script_error('do_convertpkg requires an argument.');
my $pkg = shift;
my $tempfh = tempfile(DIR => $tempdir);
my $fn = get_tmp_extfn($tempfh);
@@ -1171,7 +1171,7 @@ sub make_distclean {
# run upgradepkg for a created package
sub do_upgradepkg {
- exists $_[0] or script_error('do_upgradepkg requires an argument.');
+ @_ == 1 or script_error('do_upgradepkg requires an argument.');
system('/sbin/upgradepkg', '--reinstall', '--install-new', shift);
return 1;
}
@@ -1210,20 +1210,20 @@ sub _build_queue {
}
sub get_build_queue {
- exists $_[1] or script_error('get_build_queue requires two arguments.');
+ @_ == 2 or script_error('get_build_queue requires two arguments.');
return [ _build_queue(@_) ];
}
sub merge_queues {
# Usage: merge_queues(\@queue_a, \@queue_b);
# Results in queue_b being merged into queue_a (without duplicates)
- exists $_[1] or script_error('merge_queues requires two arguments.');
+ @_ == 2 or script_error('merge_queues requires two arguments.');
return [ uniq @{$_[0]}, @{$_[1]} ];
}
sub get_readme_contents {
- exists $_[0] or script_error('get_readme_contents requires an argument.');
+ @_ == 1 or script_error('get_readme_contents requires an argument.');
return undef, _ERR_OPENFH if not defined $_[0];
my ($fh, $exit) = open_read(shift .'/README');
return undef, $exit if $exit;
@@ -1261,7 +1261,7 @@ sub get_installed_cpans {
# look for any (user|group)add commands in the README
sub get_user_group {
- exists $_[0] or script_error('get_user_group requires an argument');
+ @_ == 1 or script_error('get_user_group requires an argument');
my $readme = shift;
my @cmds = $readme =~ /^\s*#*\s*(useradd.*|groupadd.*)/mg;
return \@cmds;
@@ -1269,7 +1269,7 @@ sub get_user_group {
# offer to run any user/group add commands
sub ask_user_group {
- exists $_[1] or script_error('ask_user_group requires two arguments');
+ @_ == 2 or script_error('ask_user_group requires two arguments');
my ($cmds, $readme) = @_;
say "\n". $readme;
print "\nIt looks like this slackbuild requires the following";
@@ -1281,14 +1281,15 @@ sub ask_user_group {
# see if the README mentions any options
sub get_opts {
- exists $_[0] or script_error('get_opts requires an argument');
+ @_ == 1 or script_error('get_opts requires an argument');
my $readme = shift;
return $readme =~ /[A-Z0-9]+=[^\s]/ ? 1 : undef;
}
# provide an opportunity to set options
sub ask_opts {
- exists $_[0] or script_error('ask_opts requires an argument');
+ # TODO: check number of args
+ @_ >= 1 or script_error('ask_opts requires an argument');
my ($sbo, $readme) = @_;
say "\n". $readme;
print "\nIt looks like $sbo has options; would you like to set any";
@@ -1314,7 +1315,7 @@ sub ask_opts {
# for a given sbo, check for cmds/opts, prompt the user as appropriate
sub user_prompt {
- exists $_[1] or script_error('user_prompt requires two arguments.');
+ @_ == 2 or script_error('user_prompt requires two arguments.');
my ($sbo, $location) = @_;
if (not defined $location) { usage_error("Unable to locate $sbo in the SlackBuilds.org tree."); }
my ($readme, $exit) = get_readme_contents($location);
@@ -1355,7 +1356,7 @@ sub process_sbos {
my $opts = $args{OPTS};
my $locs = $args{LOCATIONS};
my $jobs = $args{JOBS} =~ /^\d+$/ ? $args{JOBS} : 0;
- exists $$todo[0] or script_error('process_sbos requires TODO.');
+ @$todo >= 1 or script_error('process_sbos requires TODO.');
my (@failures, @symlinks, $err);
FIRST: for my $sbo (@$todo) {
my $compat32 = $sbo =~ /-compat32$/ ? 1 : 0;