From 446aa59e3c96cdbac09248024d462d50c9c303b2 Mon Sep 17 00:00:00 2001 From: Andreas Guldstrand Date: Thu, 19 Nov 2015 14:15:12 +0100 Subject: get_distfile needs 2 arguments, checks for 2 arguments, but error message was about 1 --- SBO-Lib/lib/SBO/Lib.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'SBO-Lib/lib') diff --git a/SBO-Lib/lib/SBO/Lib.pm b/SBO-Lib/lib/SBO/Lib.pm index 358ea15..7eba745 100644 --- a/SBO-Lib/lib/SBO/Lib.pm +++ b/SBO-Lib/lib/SBO/Lib.pm @@ -504,7 +504,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 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; -- cgit v1.2.3 From 712ea0ac188aa2a22df1c3aca4cf4f17adf6b69e Mon Sep 17 00:00:00 2001 From: Andreas Guldstrand Date: Thu, 19 Nov 2015 14:15:46 +0100 Subject: Use list-form of system() so we avoid the shell --- SBO-Lib/lib/SBO/Lib.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'SBO-Lib/lib') diff --git a/SBO-Lib/lib/SBO/Lib.pm b/SBO-Lib/lib/SBO/Lib.pm index 7eba745..4bf7394 100644 --- a/SBO-Lib/lib/SBO/Lib.pm +++ b/SBO-Lib/lib/SBO/Lib.pm @@ -510,7 +510,7 @@ sub get_distfile { 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 -- cgit v1.2.3 From 815a350b74918bc72c60d799d3a856952bd1683d Mon Sep 17 00:00:00 2001 From: Andreas Guldstrand Date: Thu, 19 Nov 2015 15:59:08 +0100 Subject: Fixed .info file parsing This fixes #5 Also added tests for #5 --- SBO-Lib/lib/SBO/Lib.pm | 25 ++++++++++++------------- 1 file changed, 12 insertions(+), 13 deletions(-) (limited to 'SBO-Lib/lib') diff --git a/SBO-Lib/lib/SBO/Lib.pm b/SBO-Lib/lib/SBO/Lib.pm index 4bf7394..ec9f4de 100644 --- a/SBO-Lib/lib/SBO/Lib.pm +++ b/SBO-Lib/lib/SBO/Lib.pm @@ -364,25 +364,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}]; - } - } - return exists $$store{$args{GET}} ? $$store{$args{GET}} : undef; + 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 $store->{$args{GET}}; } # find the version in the tree for a given sbo (provided a location) -- cgit v1.2.3 From 920b0a16407371b87e06b5e8cdfbe3a275f4dfee Mon Sep 17 00:00:00 2001 From: Andreas Guldstrand Date: Thu, 19 Nov 2015 16:31:30 +0100 Subject: Fixed up authors listing --- SBO-Lib/lib/SBO/Lib.pm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'SBO-Lib/lib') diff --git a/SBO-Lib/lib/SBO/Lib.pm b/SBO-Lib/lib/SBO/Lib.pm index ec9f4de..66159c1 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 -# Luke Williams +# authors: Jacob Pipkin +# Luke Williams +# Andreas Guldstrand # license: WTFPL use 5.16.0; -- cgit v1.2.3 From 00590bd832126a1f2217c2ec9dfe8ee15be51627 Mon Sep 17 00:00:00 2001 From: Andreas Guldstrand Date: Thu, 19 Nov 2015 16:39:30 +0100 Subject: Fix up indenting with tabs consistently --- SBO-Lib/lib/SBO/Lib.pm | 172 ++++++++++++++++++++++++------------------------- 1 file changed, 86 insertions(+), 86 deletions(-) (limited to 'SBO-Lib/lib') diff --git a/SBO-Lib/lib/SBO/Lib.pm b/SBO-Lib/lib/SBO/Lib.pm index 66159c1..d0e2fad 100644 --- a/SBO-Lib/lib/SBO/Lib.pm +++ b/SBO-Lib/lib/SBO/Lib.pm @@ -372,16 +372,16 @@ sub get_from_info { # suck it all in, clean it all up, stuff it all in $store. my $contents = do {local $/; <$fh>}; $contents =~ s/("|\\\n)//g; - 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; - } + 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 $store->{$args{GET}}; } @@ -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 =~ /^[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 ( =~ /^[Yy]/) { - my $ask = sub { - print "\nPlease supply any options here, or enter to skip: "; - chomp(my $opts = ); - 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 ( =~ /^[Yy]/) { + my $ask = sub { + print "\nPlease supply any options here, or enter to skip: "; + chomp(my $opts = ); + 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,7 +1129,7 @@ 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}; @@ -1178,22 +1178,22 @@ sub process_sbos { ); } # 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; - } - } + 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; } - } + } } -- cgit v1.2.3 From 8d7884f0bb6e114f877a186c6fdf850068690201 Mon Sep 17 00:00:00 2001 From: Andreas Guldstrand Date: Thu, 19 Nov 2015 16:42:06 +0100 Subject: Missed some indents --- SBO-Lib/lib/SBO/Lib.pm | 38 +++++++++++++++++++------------------- 1 file changed, 19 insertions(+), 19 deletions(-) (limited to 'SBO-Lib/lib') diff --git a/SBO-Lib/lib/SBO/Lib.pm b/SBO-Lib/lib/SBO/Lib.pm index d0e2fad..57a6c48 100644 --- a/SBO-Lib/lib/SBO/Lib.pm +++ b/SBO-Lib/lib/SBO/Lib.pm @@ -1135,16 +1135,16 @@ sub process_sbos { $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,20 +1164,20 @@ 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 + 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) { -- cgit v1.2.3