aboutsummaryrefslogtreecommitdiff
path: root/SBO-Lib
diff options
context:
space:
mode:
Diffstat (limited to 'SBO-Lib')
-rw-r--r--SBO-Lib/lib/SBO/Lib.pm222
1 files changed, 111 insertions, 111 deletions
diff --git a/SBO-Lib/lib/SBO/Lib.pm b/SBO-Lib/lib/SBO/Lib.pm
index 358ea15..57a6c48 100644
--- a/SBO-Lib/lib/SBO/Lib.pm
+++ b/SBO-Lib/lib/SBO/Lib.pm
@@ -5,8 +5,9 @@
# Lib.pm
# shared functions for the sbo_ scripts.
#
-# authors: Jacob Pipkin <j@dawnrazor.net>
-# Luke Williams <xocel@iquidus.org>
+# authors: Jacob Pipkin <j@dawnrazor.net>
+# Luke Williams <xocel@iquidus.org>
+# Andreas Guldstrand <andreas.guldstrand@gmail.com>
# license: WTFPL <http://sam.zoy.org/wtfpl/COPYING>
use 5.16.0;
@@ -364,25 +365,24 @@ sub get_from_info {
}
state $store = {PRGNAM => ['']};
my $sbo = get_sbo_from_loc($args{LOCATION});
- return $$store{$args{GET}} if $$store{PRGNAM}[0] eq $sbo;
+ 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");
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;
- $store = {$contents =~ /^(\w+)=(.*)$/mg};
- # fill the hash with array refs - even for single values,
- # since consistency here is a lot easier than sorting it out later
- for my $key (keys %$store) {
- if ($$store{$key} =~ /\s/) {
- my @array = split ' ', $$store{$key};
- $$store{$key} = \@array;
- } else {
- $$store{$key} = [$$store{$key}];
- }
+ my $last_key = '';
+ $store = {};
+ foreach my $line (split /\n/, $contents) {
+ my ($key, $val) = $last_key;
+ if ($line =~ /^([^=\s]+)=(.*)$/) { $key = $1; $val = $2; }
+ elsif ($line =~ /^\s+([^\s].+)$/) { $val = $1; }
+ else { script_error("error when parsing $sbo.info file. Line: $line") }
+ push @{ $store->{$key} }, ($val ? split(' ', $val) : $val);
+ $last_key = $key;
}
- return exists $$store{$args{GET}} ? $$store{$args{GET}} : undef;
+ return $store->{$args{GET}};
}
# find the version in the tree for a given sbo (provided a location)
@@ -504,13 +504,13 @@ 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 an argument');
+ exists $_[1] or script_error('get_distfile requires two arguments');
my ($link, $info_md5) = @_;
my $filename = get_filename_from_link($link);
mkdir $distfiles unless -d $distfiles;
chdir $distfiles;
unlink $filename if -f $filename;
- if (system("wget --no-check-certificate \"$link\"") != 0) {
+ if (system('wget', '--no-check-certificate', $link) != 0) {
return "Unable to wget $link.\n", _ERR_DOWNLOAD;
}
# can't do anything if the link in the .info doesn't lead to a good d/l
@@ -937,33 +937,33 @@ sub get_requires {
}
sub _uniq {
- my %seen;
- return grep { !$seen{$_}++ } @_;
+ my %seen;
+ return grep { !$seen{$_}++ } @_;
}
sub _build_queue {
- my ($sbos, $warnings) = @_;
- my @queue = @$sbos;
- my @result;
-
- while (my $sbo = shift @queue) {
- next if $sbo eq "%README%";
- my $reqs = get_requires($sbo);
- if (defined $reqs) {
- push @result, _build_queue($reqs, $warnings);
- foreach my $req (@$reqs) {
- $warnings->{$sbo}="%README%" if $req eq "%README%";
- }
- }
- push @result, $sbo;
- }
-
- return _uniq @result;
+ my ($sbos, $warnings) = @_;
+ my @queue = @$sbos;
+ my @result;
+
+ while (my $sbo = shift @queue) {
+ next if $sbo eq "%README%";
+ my $reqs = get_requires($sbo);
+ if (defined $reqs) {
+ push @result, _build_queue($reqs, $warnings);
+ foreach my $req (@$reqs) {
+ $warnings->{$sbo}="%README%" if $req eq "%README%";
+ }
+ }
+ push @result, $sbo;
+ }
+
+ return _uniq @result;
}
sub get_build_queue {
- exists $_[1] or script_error('get_build_queue requires two arguments.');
- return [ _build_queue(@_) ];
+ exists $_[1] or script_error('get_build_queue requires two arguments.');
+ return [ _build_queue(@_) ];
}
sub merge_queues {
@@ -971,7 +971,7 @@ sub merge_queues {
# Results in queue_b being merged into queue_a (without duplicates)
exists $_[1] or script_error('merge_queues requires two arguments.');
- return [ _uniq @{$_[0]}, @{$_[1]} ];
+ return [ _uniq @{$_[0]}, @{$_[1]} ];
}
sub get_readme_contents {
@@ -1012,55 +1012,55 @@ 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');
- my $readme = shift;
- my @cmds = $readme =~ /^\s*#*\s*(useradd.*|groupadd.*)/mg;
- return \@cmds;
+ exists $_[0] or script_error('get_user_group requires an argument');
+ my $readme = shift;
+ my @cmds = $readme =~ /^\s*#*\s*(useradd.*|groupadd.*)/mg;
+ return \@cmds;
}
# offer to run any user/group add commands
sub ask_user_group {
- exists $_[1] or script_error('ask_user_group requires two arguments');
- my ($cmds, $readme) = @_;
- say "\n". $readme;
- print "\nIt looks like this slackbuild requires the following";
- say ' command(s) to be run first:';
- say " # $_" for @$cmds;
- print 'Shall I run them prior to building? [y] ';
+ exists $_[1] or script_error('ask_user_group requires two arguments');
+ my ($cmds, $readme) = @_;
+ say "\n". $readme;
+ print "\nIt looks like this slackbuild requires the following";
+ say ' command(s) to be run first:';
+ say " # $_" for @$cmds;
+ print 'Shall I run them prior to building? [y] ';
return <STDIN> =~ /^[Yy\n]/ ? $cmds : undef;
}
# see if the README mentions any options
sub get_opts {
- exists $_[0] or script_error('get_opts requires an argument');
- my $readme = shift;
- return $readme =~ /[A-Z0-9]+=[^\s]/ ? 1 : undef;
+ exists $_[0] 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');
- my ($sbo, $readme) = @_;
- say "\n". $readme;
- 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 {
- print "\nPlease supply any options here, or enter to skip: ";
- chomp(my $opts = <STDIN>);
- return() if $opts =~ /^\n/;
- return $opts;
- };
- my $kv_regex = qr/[A-Z0-9]+=[^\s]+(|\s([A-Z]+=[^\s]+){0,})/;
- my $opts = $ask->();
- return() unless $opts;
- while ($opts !~ $kv_regex) {
- warn "Invalid input received.\n";
- $opts = $ask->();
- }
- return $opts;
- }
- return();
+ exists $_[0] 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";
+ print ' when the slackbuild is run? [n] ';
+ if (<STDIN> =~ /^[Yy]/) {
+ my $ask = sub {
+ print "\nPlease supply any options here, or enter to skip: ";
+ chomp(my $opts = <STDIN>);
+ return() if $opts =~ /^\n/;
+ return $opts;
+ };
+ my $kv_regex = qr/[A-Z0-9]+=[^\s]+(|\s([A-Z]+=[^\s]+){0,})/;
+ my $opts = $ask->();
+ return() unless $opts;
+ while ($opts !~ $kv_regex) {
+ warn "Invalid input received.\n";
+ $opts = $ask->();
+ }
+ return $opts;
+ }
+ return();
}
# for a given sbo, check for cmds/opts, prompt the user as appropriate
@@ -1099,7 +1099,7 @@ sub process_sbos {
NON_INT => 0,
@_
);
- my $todo = $args{TODO};
+ my $todo = $args{TODO};
my $cmds = $args{CMDS};
my $opts = $args{OPTS};
my $locs = $args{LOCATIONS};
@@ -1129,22 +1129,22 @@ sub process_sbos {
}
}
my $count = 0 unless $args{NON_INT};
- FIRST: for my $sbo (@$todo) {
+ FIRST: for my $sbo (@$todo) {
$count++;
my $options = 0;
$options = $$opts{$sbo} if defined $$opts{$sbo};
my $cmds = $$cmds{$sbo} if defined $$cmds{$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/installing a -compat32
# else make sure compat32 is off
my $compat32 = $sbo =~ /-compat32$/ ? 1 : 0;
my ($version, $pkg, $src, $exit) = do_slackbuild(
- OPTS => $options,
- JOBS => $jobs,
- LOCATION => $$locs{$sbo},
- COMPAT32 => $compat32,
+ OPTS => $options,
+ JOBS => $jobs,
+ LOCATION => $$locs{$sbo},
+ COMPAT32 => $compat32,
);
if ($exit) {
my $fail = $version;
@@ -1164,36 +1164,36 @@ sub process_sbos {
}
}
- do_upgradepkg($pkg) unless $args{NOINSTALL};
-
- unless ($args{DISTCLEAN}) {
- make_clean(SBO => $sbo, SRC => $src, VERSION => $version)
- unless $args{NOCLEAN};
- } else {
- make_distclean(
- SBO => $sbo,
- SRC => $src,
- VERSION => $version,
- LOCATION => $$locs{$sbo},
- );
- }
- # move package to $config{PKG_DIR} if defined
- unless ($config{PKG_DIR} eq 'FALSE') {
- my $dir = $config{PKG_DIR};
- unless (-d $dir) {
- mkdir($dir) or warn "Unable to create $dir\n";
- }
- if (-d $dir) {
- move($pkg, $dir), say "$pkg stored in $dir";
- } else {
- warn "$pkg left in $tmpd\n";
- }
- } elsif ($args{DISTCLEAN}) {
- unlink $pkg;
- }
- }
+ do_upgradepkg($pkg) unless $args{NOINSTALL};
+
+ unless ($args{DISTCLEAN}) {
+ make_clean(SBO => $sbo, SRC => $src, VERSION => $version)
+ unless $args{NOCLEAN};
+ } else {
+ make_distclean(
+ SBO => $sbo,
+ SRC => $src,
+ VERSION => $version,
+ LOCATION => $$locs{$sbo},
+ );
+ }
+ # move package to $config{PKG_DIR} if defined
+ unless ($config{PKG_DIR} eq 'FALSE') {
+ my $dir = $config{PKG_DIR};
+ unless (-d $dir) {
+ mkdir($dir) or warn "Unable to create $dir\n";
+ }
+ if (-d $dir) {
+ move($pkg, $dir), say "$pkg stored in $dir";
+ } else {
+ warn "$pkg left in $tmpd\n";
+ }
+ } elsif ($args{DISTCLEAN}) {
+ unlink $pkg;
+ }
+ }
unlink for @symlinks;
- return \@failures, $exit;
+ return \@failures, $exit;
}
# subroutine to print out failures
@@ -1204,5 +1204,5 @@ sub print_failures {
for my $failure (@$failures) {
warn " $_: $$failure{$_}" for keys %$failure;
}
- }
+ }
}
generated by cgit v1.2.3 (git 2.26.2) at 2025-11-04 05:21:04 +0000