diff options
| -rw-r--r-- | SBO-Lib/lib/SBO/Lib.pm | 159 | ||||
| -rwxr-xr-x | sboinstall | 22 | ||||
| -rwxr-xr-x | sboupgrade | 76 |
3 files changed, 131 insertions, 126 deletions
diff --git a/SBO-Lib/lib/SBO/Lib.pm b/SBO-Lib/lib/SBO/Lib.pm index 0d99a0d..f49b0b1 100644 --- a/SBO-Lib/lib/SBO/Lib.pm +++ b/SBO-Lib/lib/SBO/Lib.pm @@ -42,7 +42,7 @@ use File::Copy; use File::Path qw(make_path remove_tree); use Fcntl; -$UID == 0 or print "This script requires root privileges.\n" and exit(1); +$UID == 0 or print "This script requires root privileges.\n" and exit (1); our $conf_dir = '/etc/sbotools'; our $conf_file = "$conf_dir/sbotools.conf"; @@ -59,7 +59,7 @@ if (-f $conf_file) { open my $reader, '<', $conf_file; my $text = do {local $/; <$reader>}; %config = $text =~ /^(\w+)=(.*)$/mg; - close($reader); + close ($reader); } for my $key (keys %config) { unless ($key ~~ @valid_conf_keys) { @@ -90,7 +90,7 @@ sub script_error { print "$_[0]\n"; print "Exiting.\n"; } - exit(1); + exit 1; } sub show_version { @@ -102,9 +102,9 @@ sub show_version { sub get_slack_version { if (-f '/etc/slackware-version') { open my $slackver, '<', '/etc/slackware-version'; - chomp(my $line = <$slackver>); - close($slackver); - my $slk_version = split_line($line,' ',1); + chomp (my $line = <$slackver>); + close ($slackver); + my $slk_version = split_line ($line,' ',1); $slk_version = '13.37' if $slk_version eq '13.37.0'; return $slk_version; } @@ -116,17 +116,17 @@ sub check_slackbuilds_txt { } else { print "I am unable to find SLACKBUILDS.TXT.\n"; print "Perhaps you need to \"sbosnap fetch\"?\n"; - exit(1); + exit 1; } } sub rsync_sbo_tree { - my $slk_version = get_slack_version(); + my $slk_version = get_slack_version (); my $cmd = 'rsync'; my @arg = ('-a','--exclude=*.tar.gz','--exclude=*.tar.gz.asc'); - push(@arg,"rsync://slackbuilds.org/slackbuilds/$slk_version/*"); - push(@arg,$config{SBO_HOME}); - system($cmd,@arg); + push (@arg,"rsync://slackbuilds.org/slackbuilds/$slk_version/*"); + push (@arg,$config{SBO_HOME}); + system ($cmd,@arg); print "Finished.\n"; return 1; } @@ -134,28 +134,28 @@ sub rsync_sbo_tree { 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); while (readdir $home_handle) { next if /^\.[\.]{0,1}$/; print "$sbo_home exists and is not empty. Exiting.\n"; - exit(1); + exit 1; } } else { - make_path($sbo_home) or print "Unable to create $sbo_home. Exiting.\n" - and exit(1); + make_path ($sbo_home) or print "Unable to create $sbo_home. Exiting.\n" + and exit (1); } } sub fetch_tree { - check_home(); + check_home (); print "Pulling SlackBuilds tree...\n"; - rsync_sbo_tree(); + rsync_sbo_tree (); } sub update_tree { - check_slackbuilds_txt(); + check_slackbuilds_txt (); print "Updating SlackBuilds tree...\n"; - rsync_sbo_tree(); + rsync_sbo_tree (); } sub get_installed_sbos { @@ -163,21 +163,21 @@ sub get_installed_sbos { opendir my $diread, '/var/log/packages'; while (my $ls = readdir $diread) { next if $ls =~ /\A\./; - if (index($ls,"SBo") != -1) { - my @split = split(/-/,reverse($ls),4); + if (index ($ls,"SBo") != -1) { + my @split = split (/-/,reverse ($ls) ,4); my %hash; - $hash{name} = reverse($split[3]); - $hash{version} = reverse($split[2]); - push(@installed,\%hash); + $hash{name} = reverse ($split[3]); + $hash{version} = reverse ($split[2]); + push (@installed,\%hash); } } return @installed; } sub clean_line { - script_error('clean line requires an argument') + script_error ('clean line requires an argument') unless exists $_[0]; - chomp(my $line = shift); + chomp (my $line = shift); $line =~ s/[\s"\\]//g; return $line; } @@ -228,23 +228,23 @@ sub clean_line { # iterate over all the lines! # sub get_available_updates { - check_slackbuilds_txt(); + check_slackbuilds_txt (); my (@updates,$index); - my @pkg_list = get_installed_sbos(); + my @pkg_list = get_installed_sbos (); open my $sb_txt, '<', $slackbuilds_txt; my $found = 'FALSE'; FIRST: while (my $line = <$sb_txt>) { if ($found eq 'TRUE') { if ($line =~ /VERSION/) { $found = 'FALSE'; - my $sbo_version = split_line($line,' ',2); - if (versioncmp($sbo_version,$pkg_list[$index]{version}) == 1) { + my $sbo_version = split_line ($line,' ',2); + if (versioncmp ($sbo_version,$pkg_list[$index]{version}) == 1) { my %hash = ( name => $pkg_list[$index]{name}, installed => $pkg_list[$index]{version}, update => $sbo_version, ); - push(@updates,\%hash); + push (@updates,\%hash); } } } else { @@ -263,10 +263,10 @@ sub get_available_updates { } sub check_sbo_name_validity { - script_error('check_sbo_name_validity requires an argument') + script_error ('check_sbo_name_validity requires an argument') unless exists $_[0]; my $sbo = shift; - check_slackbuilds_txt(); + check_slackbuilds_txt (); my $valid = 'FALSE'; my $regex = qr/$name_regex\Q$sbo\E\n\z/; open my $sb_txt, '<', $slackbuilds_txt; @@ -276,19 +276,19 @@ sub check_sbo_name_validity { last FIRST; } } - close($sb_txt); + close ($sb_txt); unless ($valid eq 'TRUE') { print "$sbo does not exist in the SlackBuilds tree. Exiting.\n"; - exit(1); + exit 1; } return 1; } sub get_sbo_location { - script_error('get_sbo_location requires an argument.Exiting.') + script_error ('get_sbo_location requires an argument.Exiting.') unless exists $_[0]; my $sbo = shift; - check_slackbuilds_txt(); + check_slackbuilds_txt (); my $found = 'FALSE'; my $location; my $regex = qr/$name_regex\Q$sbo\E\n\z/; @@ -300,32 +300,32 @@ sub get_sbo_location { } if ($found eq 'TRUE') { if ($line =~ /LOCATION/) { - my $loc_line = split_line($line,' ',2); + my $loc_line = split_line ($line,' ',2); $loc_line =~ s#^\./##; $location = "$config{SBO_HOME}/$loc_line"; last FIRST; } } } - close($sb_txt); + close ($sb_txt); return $location; } sub split_line { - script_error('split_line requires three arguments') unless exists $_[2]; + script_error ('split_line requires three arguments') unless exists $_[2]; my ($line,$pattern,$index) = @_; my @split; if ($pattern eq ' ') { - @split = split("$pattern",$line); + @split = split ("$pattern",$line); } else { - @split = split(/$pattern/,$line); + @split = split (/$pattern/,$line); } - return clean_line($split[$index]); + return clean_line ($split[$index]); } sub split_equal_one { - script_error("split_equal_one requires an argument") unless exists $_[0]; - return split_line($_[0],'=',1); + script_error ('split_equal_one requires an argument') unless exists $_[0]; + return split_line ($_[0],'=',1); } sub find_download_info { @@ -404,53 +404,53 @@ sub get_sbo_downloads { } sub compute_md5sum { - script_error('compute_md5sum requires an argument.') unless exists $_[0]; - script_error('compute_md5sum argument is not a file.') unless -f $_[0]; + script_error ('compute_md5sum requires an argument.') unless exists $_[0]; + script_error ('compute_md5sum argument is not a file.') unless -f $_[0]; my $filename = shift; open my $reader, '<', $filename; my $md5 = Digest::MD5->new; - $md5->addfile($reader); + $md5->addfile ($reader); my $md5sum = $md5->hexdigest; - close($reader); + close ($reader); return $md5sum; } sub get_filename_from_link { - script_error('get_filename_from_link requires an argument') + script_error ('get_filename_from_link requires an argument') unless exists $_[0]; - my @split = split('/',reverse($_[0]),2); - chomp(my $filename = $distfiles .'/'. reverse($split[0])); + my @split = split ('/',reverse ($_[0]) ,2); + chomp (my $filename = $distfiles .'/'. reverse ($split[0]) ); return $filename; } sub check_distfile { - script_error('check_distfile requires an argument.') unless exists $_[0]; - my $filename = get_filename_from_link($_[0]); + script_error ('check_distfile requires an argument.') unless exists $_[0]; + my $filename = get_filename_from_link ($_[0]); return unless -d $distfiles; return unless -f $filename; - my $md5sum = compute_md5sum($filename); + my $md5sum = compute_md5sum ($filename); return unless $_[1] eq $md5sum; return 1; } sub get_distfile { - script_error('get_distfile requires an argument') unless exists $_[1]; + script_error ('get_distfile requires an argument') unless exists $_[1]; my ($link,$expected_md5sum) = @_; - my $filename = get_filename_from_link($link); - mkdir($distfiles) unless -d $distfiles; - chdir($distfiles); - my $out = system("wget $link"); + my $filename = get_filename_from_link ($link); + mkdir ($distfiles) unless -d $distfiles; + chdir ($distfiles); + my $out = system ("wget $link"); return unless $out == 0; - my $md5sum = compute_md5sum($filename); + my $md5sum = compute_md5sum ($filename); if ($md5sum ne $expected_md5sum) { print "md5sum failure for $filename.\n"; - exit(1); + exit (1); } return 1; } sub get_sbo_version { - script_error('get_sbo_version requires two arguments.') + script_error ('get_sbo_version requires two arguments.') unless exists $_[1]; my ($sbo,$location) = @_; my $version; @@ -458,32 +458,32 @@ sub get_sbo_version { my $version_regex = qr/\AVERSION=/; FIRST: while (my $line = <$info>) { if ($line =~ $version_regex) { - $version = split_equal_one($line); + $version = split_equal_one ($line); last FIRST; } } - close($info); + close ($info); return $version; } sub get_symlink_from_filename { - script_error('get_symlink_from_filename requires two arguments') + script_error ('get_symlink_from_filename requires two arguments') unless exists $_[1]; - script_error('get_symlink_from_filename first argument is not a file') + script_error ('get_symlink_from_filename first argument is not a file') unless -f $_[0]; - my @split = split('/',reverse($_[0]),2); - my $fn = reverse($split[0]); + my @split = split ('/',reverse ($_[0]) ,2); + my $fn = reverse ($split[0]); return "$_[1]/$fn"; } sub check_x32 { - script_error('check_x32 requires two arguments.') unless exists $_[1]; + script_error ('check_x32 requires two arguments.') unless exists $_[1]; my ($sbo,$location) = @_; open my $info,'<',"$location/$sbo.info"; my $regex = qr/^DOWNLOAD_x86_64/; FIRST: while (my $line = <$info>) { if ($line =~ $regex) { - return 1 if index($line,'UNSUPPORTED') != -1; + return 1 if index ($line,'UNSUPPORTED') != -1; } } return; @@ -561,18 +561,9 @@ sub make_distclean { } sub do_upgradepkg { - script_error ('do_upgradepkg requires two arguments.') unless exists $_[1]; - my ($sbo,$version) = @_; - my $pkg; - my $pkg_regex = qr/^(\Q$sbo\E-\Q$version\E-[^-]+-.*_SBo.t[xblg]z)$/; - opendir my $diread, '/tmp/'; - FIRST: while (my $ls = readdir $diread) { - if ($ls =~ $pkg_regex) { - chomp($pkg = "/tmp/$1"); - last FIRST; - } - } - system("/sbin/upgradepkg --reinstall --install-new $pkg"); - return $pkg; + script_error ('do_upgradepkg requires an argument.') unless exists $_[0]; + my $pkg = shift; + system ("/sbin/upgradepkg --reinstall --install-new $pkg"); + return; } @@ -13,7 +13,7 @@ use File::Basename; use strict; use warnings FATAL => 'all'; -my $self = basename($0); +my $self = basename ($0); sub show_usage { print <<EOF @@ -25,26 +25,28 @@ Options: -c: do not clean working files/directories after the build. -d: clean distfiles afterward. -r: skip viewing of the SBo README. + -i: do not run installpkg at the end of the build process. EOF } my %options; -getopts('hvcdr',\%options); +getopts ('hvcdri',\%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]; -unshift(@ARGV,'-c') if exists $options{c}; -unshift(@ARGV,'-d') if exists $options{d}; -unshift(@ARGV,'-r') if exists $options{r}; +unshift (@ARGV,'-c') if exists $options{c}; +unshift (@ARGV,'-d') if exists $options{d}; +unshift (@ARGV,'-r') if exists $options{r}; +unshift (@ARGV,'-i') if exists $options{i}; my $string = ''; for (@ARGV) { $string .= " $_"; } -system("/usr/sbin/sboupgrade -N $string"); -exit(0); +system ("/usr/sbin/sboupgrade -N $string"); +exit 0; @@ -16,7 +16,7 @@ use strict; use warnings FATAL => 'all'; my %config = %SBO::Lib::config; -my $self = basename($0); +my $self = basename ($0); sub show_usage { print <<EOF @@ -30,6 +30,7 @@ Options: -f: force an update, even if the "upgrade" version is the same or lower. -N: install any new SBo's listed. -r: skip viewing of the SBo README. + -i: do not run installpkg at the end of the build process. Example: $self -d libsexy @@ -40,11 +41,11 @@ EOF } my %options; -getopts('hvacdfj:Nr',\%options); +getopts ('hvacdfj:Nri',\%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} ? 'FALSE' : $config{NOCLEAN}; my $distclean = exists $options{d} ? 'TRUE' : $config{DISTCLEAN}; my $force = exists $options{f} ? 'TRUE' : 'FALSE'; @@ -52,64 +53,75 @@ my $force = exists $options{f} ? 'TRUE' : 'FALSE'; my $jobs = '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'; -show_usage() and exit(1) unless exists $ARGV[0]; +show_usage () and exit (1) unless exists $ARGV[0]; for my $sbo_name (@ARGV) { - check_sbo_name_validity($sbo_name); + check_sbo_name_validity ($sbo_name); } sub get_readme_path { - script_error('get_readme_path requires an argument.') unless exists $_[0]; + script_error ('get_readme_path requires an argument.') unless exists $_[0]; my $sbo = shift; - my $location = get_sbo_location($sbo); + my $location = get_sbo_location ($sbo); return $location .'/README'; } sub readme_prompt { - script_error('readme_prompt requires an argument.') unless exists $_[0]; + script_error ('readme_prompt requires an argument.') unless exists $_[0]; my $sbo = shift; - my $readme_path = get_readme_path($sbo); + my $readme_path = get_readme_path ($sbo); open my $readme,'<',$readme_path; print "\n",<$readme>; - close($readme); + close ($readme); print "\nProceed with $sbo? [yn]: "; my $test = <STDIN>; - exit(0) unless $test =~ /^[Yy]/; + exit (0) unless $test =~ /^[Yy]/; return 1; } sub process_sbos { - script_error('process_sbos requires an argument.') unless exists $_[0]; + script_error ('process_sbos requires an argument.') unless exists $_[0]; my @todo = @_; my @failures; for my $sbo (@todo) { - readme_prompt($sbo) unless $no_readme eq 'TRUE'; + readme_prompt ($sbo) unless $no_readme eq 'TRUE'; my $version; eval { - $version = do_slackbuild($jobs,$sbo); + $version = do_slackbuild ($jobs,$sbo); }; if ($@) { - push(@failures,$sbo); + push (@failures,$sbo); } else { unless ($distclean eq 'TRUE') { if ($noclean eq 'FALSE') { - make_clean($sbo,$version); + make_clean ($sbo,$version); } } else { - make_distclean($sbo,$version); + make_distclean ($sbo,$version); } - my $pkg = do_upgradepkg($sbo,$version); + my $pkg; + my $pkg_regex = qr/^(\Q$sbo\E-\Q$version\E-[^-]+-.*_SBo.t[xblg]z)$/; + opendir my $diread, '/tmp/'; + FIRST: while (my $ls = readdir $diread) { + if ($ls =~ $pkg_regex) { + chomp ($pkg = "/tmp/$1"); + last FIRST; + } + } + + do_upgradepkg ($pkg) unless $no_install eq 'TRUE'; unless ($config{PKG_DIR} eq 'FALSE') { unless (-d $config{PKG_DIR}) { - mkdir($config{PKG_DIR}) or + mkdir ($config{PKG_DIR}) or warn "Unable to create $config{PKG_DIR}\n"; } - move($pkg,$config{PKG_DIR}) if -d $config{PKG_DIR}; + move ($pkg,$config{PKG_DIR}) if -d $config{PKG_DIR}; print "$pkg stored in $config{PKG_DIR}\n"; } elsif ($distclean eq 'TRUE') { - unlink($pkg); + unlink ($pkg); } } } @@ -120,7 +132,7 @@ sub process_sbos { my @updates unless $force eq 'TRUE'; unless ($force eq 'TRUE') { - my @updates_array = get_available_updates(); + my @updates_array = get_available_updates (); for my $index (keys @updates_array) { push(@updates,$updates_array[$index]{name}); } @@ -132,14 +144,14 @@ my @todo_upgrade; unless ($force eq 'TRUE') { for (@ARGV) { if ($_ ~~ @updates) { - push(@todo_upgrade,$_); + push (@todo_upgrade,$_); } } } else { for (@ARGV) { SECOND: for my $c (keys @installed) { if ($_ eq $installed[$c]{name}) { - push(@todo_upgrade,$_); + push (@todo_upgrade,$_); last SECOND; } } @@ -147,17 +159,17 @@ unless ($force eq 'TRUE') { } my @failed; -@failed = process_sbos(@todo_upgrade) if exists $todo_upgrade[0]; +@failed = process_sbos (@todo_upgrade) if exists $todo_upgrade[0]; sub print_failures { if (exists $failed[0]) { print "Failures:\n"; print " $_\n" for (@failed); - exit(1); + exit (1); } } -print_failures() unless $install_new eq 'TRUE'; +print_failures () unless $install_new eq 'TRUE'; my @todo_install; my $has = 'FALSE'; @@ -169,15 +181,15 @@ for (@ARGV) { } } unless ($has eq 'TRUE') { - push(@todo_install,$_); + push (@todo_install,$_); } else { print "$_ already installed.\n"; } $has = 'FALSE'; } -@failed = process_sbos(@todo_install) if exists $todo_install[0]; +@failed = process_sbos (@todo_install) if exists $todo_install[0]; -print_failures(); +print_failures (); -exit(0); +exit (0); |