aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--SBO-Lib/lib/SBO/Lib.pm178
1 files changed, 89 insertions, 89 deletions
diff --git a/SBO-Lib/lib/SBO/Lib.pm b/SBO-Lib/lib/SBO/Lib.pm
index 2dcf0ed..b697def 100644
--- a/SBO-Lib/lib/SBO/Lib.pm
+++ b/SBO-Lib/lib/SBO/Lib.pm
@@ -35,7 +35,7 @@ require Exporter;
use warnings FATAL => 'all';
use strict;
use File::Basename;
-use English '-no_match_vars';
+#use English '-no_match_vars';
use Tie::File;
use IO::File;
use Sort::Versions;
@@ -45,7 +45,7 @@ use File::Path qw(make_path remove_tree);
use Fcntl;
use File::Find;
-$UID == 0 or print "This script requires root privileges.\n" and exit (1);
+$< == 0 or print "This script requires root privileges.\n" and exit (1);
our $conf_dir = '/etc/sbotools';
our $conf_file = "$conf_dir/sbotools.conf";
@@ -70,15 +70,12 @@ for my $key (keys %config) {
}
}
for my $key (@valid_conf_keys) {
- unless ($key eq 'SBO_HOME') {
- $config{$key} = "FALSE" unless exists $config{$key};
- } else {
+ if ($key eq 'SBO_HOME') {
$config{$key} = '/usr/sbo' unless exists $config{$key};
- }
-}
-while (my ($key,$value) = each %config) {
- if ($key eq 'JOBS') {
- $config{JOBS} = 'FALSE' unless $value =~ /^\d+$/;
+ } elsif ($key eq 'JOBS') {
+ $config{$key} = 'FALSE' unless $value =~ /^\d+$/;
+ } else {
+ $config{$key} = 'FALSE' unless exists $config{$key};
}
}
@@ -111,9 +108,12 @@ sub get_slack_version {
open my $slackver, '<', '/etc/slackware-version';
chomp (my $line = <$slackver>);
close ($slackver);
- my $slk_version = split_line ($line,' ',1);
+ my $slk_version = split_line ($line, ' ', 1);
$slk_version = '13.37' if $slk_version eq '13.37.0';
return $slk_version;
+ } else {
+ print "I am unable to locate your /etc/slackware-version file.\n";
+ exit 1;
}
}
@@ -140,10 +140,10 @@ sub slackbuilds_or_fetch {
sub rsync_sbo_tree {
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);
+ 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);
print "Finished.\n";
return 1;
}
@@ -151,7 +151,7 @@ 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";
@@ -160,7 +160,7 @@ sub check_home {
} else {
make_path ($sbo_home) or print "Unable to create $sbo_home. Exiting.\n"
and exit (1);
- }
+ }
}
sub fetch_tree {
@@ -180,20 +180,19 @@ 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);
+ push (@installed, \%hash);
}
}
return @installed;
}
sub clean_line {
- script_error ('clean line requires an argument')
- unless exists $_[0];
+ script_error ('clean line requires an argument') unless exists $_[0];
chomp (my $line = shift);
$line =~ s/[\s"\\]//g;
return $line;
@@ -207,17 +206,17 @@ sub get_available_updates {
next FIRST unless defined $location;
my $regex = qr/^VERSION=/;
- open my $info,'<',"$location/$pkg_list[$c]{name}.info";
+ open my $info, '<', "$location/$pkg_list[$c]{name}.info";
SECOND: while (my $line = <$info>) {
if ($line =~ $regex) {
my $sbo_version = split_equal_one ($line);
- if (versioncmp ($sbo_version,$pkg_list[$c]{version}) == 1) {
+ if (versioncmp ($sbo_version, $pkg_list[$c]{version}) == 1) {
my %hash = (
name => $pkg_list[$c]{name},
installed => $pkg_list[$c]{version},
update => $sbo_version,
);
- push (@updates,\%hash);
+ push (@updates, \%hash);
}
last SECOND;
}
@@ -245,25 +244,25 @@ sub get_sbo_location {
sub split_line {
script_error ('split_line requires three arguments') unless exists $_[2];
- my ($line,$pattern,$index) = @_;
+ 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]);
}
sub split_equal_one {
script_error ('split_equal_one requires an argument') unless exists $_[0];
- return split_line ($_[0],'=',1);
+ return split_line ($_[0], '=', 1);
}
sub find_download_info {
script_error('find_download_info requires four arguments.')
unless exists $_[3];
- my ($sbo,$location,$type,$x64) = @_;
+ my ($sbo, $location, $type, $x64) = @_;
my @return;
my $regex;
if ($type eq 'download') {
@@ -279,13 +278,13 @@ sub find_download_info {
my $empty_regex = qr/=""$/;
my $back_regex = qr/\\$/;
my $more = 'FALSE';
- open my $info,'<',"$location/$sbo.info";
+ open my $info, '<', "$location/$sbo.info";
FIRST: while (my $line = <$info>) {
unless ($more eq 'TRUE') {
if ($line =~ $regex) {
last FIRST if $line =~ $empty_regex;
- unless (index ($line,'UNSUPPORTED') != -1) {
- push (@return,split_equal_one ($line) );
+ unless (index ($line, 'UNSUPPORTED') != -1) {
+ push (@return, split_equal_one ($line) );
$more = 'TRUE' if $line =~ $back_regex;
} else {
last FIRST;
@@ -294,7 +293,7 @@ sub find_download_info {
} else {
$more = 'FALSE' unless $line =~ $back_regex;
$line = clean_line ($line);
- push (@return,$line);
+ push (@return, $line);
}
}
close ($info);
@@ -311,23 +310,23 @@ sub get_sbo_downloads {
script_error ('get_sbo_downloads requires three arguments.')
unless exists $_[2];
script_error ('get_sbo_downloads given a non-directory.') unless -d $_[1];
- my ($sbo,$location,$only32) = @_;
+ my ($sbo, $location, $only32) = @_;
my $arch = get_arch ();
- my (@links,@md5s);
+ my (@links, @md5s);
if ($arch eq 'x86_64') {
unless ($only32) {
- @links = find_download_info ($sbo,$location,'download',1);
- @md5s = find_download_info ($sbo,$location,'md5sum',1);
+ @links = find_download_info ($sbo, $location, 'download', 1);
+ @md5s = find_download_info ($sbo, $location, 'md5sum', 1);
}
}
unless (exists $links[0]) {
- @links = find_download_info ($sbo,$location,'download',0);
- @md5s = find_download_info ($sbo,$location,'md5sum',0);
+ @links = find_download_info ($sbo, $location, 'download', 0);
+ @md5s = find_download_info ($sbo, $location, 'md5sum', 0);
}
my @downloads;
for my $c (keys @links) {
- my %hash = (link => $links[$c],md5sum => $md5s[$c]);
- push (@downloads,\%hash);
+ my %hash = (link => $links[$c], md5sum => $md5s[$c]);
+ push (@downloads, \%hash);
}
return @downloads;
}
@@ -347,14 +346,14 @@ sub compute_md5sum {
sub get_filename_from_link {
script_error ('get_filename_from_link requires an argument')
unless exists $_[0];
- my @split = split ('/',reverse (shift) ,2);
+ my @split = split ('/', reverse (shift) , 2);
chomp (my $filename = $distfiles .'/'. reverse ($split[0]) );
return $filename;
}
sub check_distfile {
script_error ('check_distfile requires two arguments.') unless exists $_[1];
- my ($link,$info_md5sum) = @_;
+ my ($link, $info_md5sum) = @_;
my $filename = get_filename_from_link ($link);
return unless -d $distfiles;
return unless -f $filename;
@@ -365,7 +364,7 @@ sub check_distfile {
sub get_distfile {
script_error ('get_distfile requires an argument') unless exists $_[1];
- my ($link,$expected_md5sum) = @_;
+ my ($link, $expected_md5sum) = @_;
my $filename = get_filename_from_link ($link);
mkdir ($distfiles) unless -d $distfiles;
chdir ($distfiles);
@@ -374,7 +373,7 @@ sub get_distfile {
my $md5sum = compute_md5sum ($filename);
if ($md5sum ne $expected_md5sum) {
print "md5sum failure for $filename.\n";
- exit (1);
+ exit 1;
}
return 1;
}
@@ -382,7 +381,7 @@ sub get_distfile {
sub get_sbo_version {
script_error ('get_sbo_version requires two arguments.')
unless exists $_[1];
- my ($sbo,$location) = @_;
+ my ($sbo, $location) = @_;
my $version;
open my $info, '<', "$location/$sbo.info";
my $version_regex = qr/\AVERSION=/;
@@ -401,19 +400,19 @@ sub get_symlink_from_filename {
unless exists $_[1];
script_error ('get_symlink_from_filename first argument is not a file')
unless -f $_[0];
- my @split = split ('/',reverse ($_[0]) ,2);
+ 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];
- my ($sbo,$location) = @_;
- open my $info,'<',"$location/$sbo.info";
+ 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;
@@ -427,19 +426,19 @@ sub check_multilib {
sub rewrite_slackbuild {
script_error ('rewrite_slackbuild requires two arguments.')
unless exists $_[1];
- my ($slackbuild,$tempfn,%changes) = @_;
- copy ($slackbuild,"$slackbuild.orig");
+ my ($slackbuild, $tempfn, %changes) = @_;
+ copy ($slackbuild, "$slackbuild.orig");
my $makepkg_regex = qr/makepkg/;
my $libdir_regex = qr/^\s*LIBDIRSUFFIX="64"\s*$/;
my $make_regex = qr/^\s*make(| \Q||\E exit 1)$/;
my $arch_out_regex = qr/\$VERSION-\$ARCH-\$BUILD/;
- tie my @sb_file,'Tie::File',$slackbuild;
+ tie my @sb_file, 'Tie::File', $slackbuild;
FIRST: for my $line (@sb_file) {
if ($line =~ $makepkg_regex) {
$line = "$line | tee $tempfn";
}
if (%changes) {
- SECOND: while (my ($key,$value) = each %changes) {
+ SECOND: while (my ($key, $value) = each %changes) {
if ($key eq 'libdirsuffix') {
if ($line =~ $libdir_regex) {
$line =~ s/64/$value/;
@@ -469,7 +468,7 @@ sub revert_slackbuild {
if (-f $slackbuild) {
unlink $slackbuild;
}
- rename ("$slackbuild.orig",$slackbuild);
+ rename ("$slackbuild.orig", $slackbuild);
}
return 1;
}
@@ -477,34 +476,34 @@ sub revert_slackbuild {
sub create_symlinks {
script_error ('create_symlinks requires two arguments.')
unless exists $_[1];
- my ($location,@downloads) = @_;
+ my ($location, @downloads) = @_;
my @symlinks;
for my $c (keys @downloads) {
my $link = $downloads[$c]{link};
my $md5sum = $downloads[$c]{md5sum};
my $filename = get_filename_from_link ($link);
- unless (check_distfile ($link,$md5sum) ) {
- die unless get_distfile ($link,$md5sum);
+ unless (check_distfile ($link, $md5sum) ) {
+ die unless get_distfile ($link, $md5sum);
}
- my $symlink = get_symlink_from_filename ($filename,$location);
- push (@symlinks,$symlink);
- symlink ($filename,$symlink);
+ my $symlink = get_symlink_from_filename ($filename, $location);
+ push (@symlinks, $symlink);
+ symlink ($filename, $symlink);
}
return @symlinks;
}
sub prep_sbo_file {
script_error ('prep_sbo_file requires two arguments') unless exists $_[1];
- my ($sbo,$location) = @_;
+ my ($sbo, $location) = @_;
chdir ($location);
- chmod (0755,"$location/$sbo.SlackBuild");
+ chmod (0755, "$location/$sbo.SlackBuild");
return 1;
}
sub perform_sbo {
script_error ('perform_sbo requires five arguments') unless exists $_[4];
- my ($jobs,$sbo,$location,$arch,$c32,$x32) = @_;
- prep_sbo_file ($sbo,$location);
+ my ($jobs, $sbo, $location, $arch, $c32, $x32) = @_;
+ prep_sbo_file ($sbo, $location);
my $cmd;
my %changes;
unless ($jobs eq 'FALSE') {
@@ -520,9 +519,9 @@ sub perform_sbo {
} else {
$cmd = "$location/$sbo.SlackBuild";
}
- my ($tempfh,$tempfn) = make_temp_file ();
+ my ($tempfh, $tempfn) = make_temp_file ();
close ($tempfh);
- rewrite_slackbuild ("$location/$sbo.SlackBuild",$tempfn,%changes);
+ rewrite_slackbuild ("$location/$sbo.SlackBuild", $tempfn, %changes);
my $out = system ($cmd);
revert_slackbuild ("$location/$sbo.SlackBuild");
die unless $out == 0;
@@ -534,7 +533,7 @@ sub get_pkg_name {
script_error ('get_pkg_name requires an argument') unless exists $_[0];
my $filename = shift;
my $pkg;
- open my $fh,'<',$filename;
+ open my $fh, '<', $filename;
FIRST: while (my $line = <$fh>) {
if ($line =~ /^Slackware\s+package\s+([^\s]+)\s+created\.$/) {
$pkg = $1;
@@ -552,12 +551,12 @@ sub make_temp_file {
$ENV{TEMP};
my $filename = sprintf "%s/%d-%d-0000", $temp_dir, $$, time;
sysopen my ($fh), $filename, O_WRONLY|O_EXCL|O_CREAT;
- return ($fh,$filename);
+ return ($fh, $filename);
}
sub sb_compat32 {
script_error ('sb_compat32 requires six arguments.') unless exists $_[5];
- my ($jobs,$sbo,$location,$arch,$version,@downloads) = @_;
+ my ($jobs, $sbo, $location, $arch, $version, @downloads) = @_;
unless ($arch eq 'x86_64') {
print 'You can only create compat32 packages on x86_64 systems.';
exit 1;
@@ -571,11 +570,11 @@ sub sb_compat32 {
exit 1;
}
}
- my @symlinks = create_symlinks ($location,@downloads);
- my $pkg = perform_sbo ($jobs,$sbo,$location,$arch,1,1);
+ my @symlinks = create_symlinks ($location, @downloads);
+ my $pkg = perform_sbo ($jobs, $sbo, $location, $arch, 1, 1);
my $cmd = '/usr/sbin/convertpkg-compat32';
- my @args = ('-i',"$pkg",'-d','/tmp');
- my $out = system ($cmd,@args);
+ my @args = ('-i', "$pkg", '-d', '/tmp');
+ my $out = system ($cmd, @args);
unlink ($_) for @symlinks;
die unless $out == 0;
return $pkg;
@@ -583,10 +582,10 @@ sub sb_compat32 {
sub sb_normal {
script_error ('sb_normal requires six arguments.') unless exists $_[5];
- my ($jobs,$sbo,$location,$arch,$version,@downloads) = @_;
+ my ($jobs, $sbo, $location, $arch, $version, @downloads) = @_;
my $x32;
if ($arch eq 'x86_64') {
- $x32 = check_x32 ($sbo,$location);
+ $x32 = check_x32 ($sbo, $location);
if ($x32) {
if (! check_multilib () ) {
print "$sbo is 32-bit only, however, this system does not appear
@@ -595,31 +594,32 @@ to be setup for multilib.\n";
}
}
}
- my @symlinks = create_symlinks ($location,@downloads);
- my $pkg = perform_sbo ($jobs,$sbo,$location,$arch,0,$x32);
+ my @symlinks = create_symlinks ($location, @downloads);
+ my $pkg = perform_sbo ($jobs, $sbo, $location, $arch, 0, $x32);
unlink ($_) for @symlinks;
return $pkg;
}
sub do_slackbuild {
script_error ('do_slackbuild requires two arguments.') unless exists $_[1];
- my ($jobs,$sbo,$location,$compat32) = @_;
+ my ($jobs, $sbo, $location, $compat32) = @_;
my $arch = get_arch ();
- my $version = get_sbo_version ($sbo,$location);
+ my $version = get_sbo_version ($sbo, $location);
my $c32 = $compat32 eq 'TRUE' ? 1 : 0;
- my @downloads = get_sbo_downloads ($sbo,$location,$c32);
+ my @downloads = get_sbo_downloads ($sbo, $location, $c32);
my $pkg;
if ($compat32 eq 'TRUE') {
- $pkg = sb_compat32 ($jobs,$sbo,$location,$arch,$version,@downloads);
+ $pkg = sb_compat32
+ ($jobs, $sbo, $location, $arch, $version, @downloads);
} else {
- $pkg = sb_normal ($jobs,$sbo,$location,$arch,$version,@downloads);
+ $pkg = sb_normal ($jobs, $sbo, $location, $arch, $version, @downloads);
}
- return $version,$pkg;
+ return $version, $pkg;
}
sub make_clean {
script_error ('make_clean requires two arguments.') unless exists $_[1];
- my ($sbo,$version) = @_;
+ my ($sbo, $version) = @_;
print "Cleaning for $sbo-$version...\n";
remove_tree ("/tmp/SBo/$sbo-$version") if -d "/tmp/SBo/$sbo-$version";
remove_tree ("/tmp/SBo/package-$sbo") if -d "/tmp/SBo/package-$sbo";
@@ -629,10 +629,10 @@ sub make_clean {
sub make_distclean {
script_error ('make_distclean requires three arguments.')
unless exists $_[2];
- my ($sbo,$version,$location) = @_;
- make_clean ($sbo,$version);
+ my ($sbo, $version, $location) = @_;
+ make_clean ($sbo, $version);
print "Distcleaning for $sbo-$version...\n";
- my @downloads = get_sbo_downloads ($sbo,$location,0);
+ my @downloads = get_sbo_downloads ($sbo, $location, 0);
for my $c (keys @downloads) {
my $filename = get_filename_from_link ($downloads[$c]{link});
unlink ($filename) if -f $filename;
generated by cgit v1.2.3 (git 2.26.2) at 2025-04-29 20:35:13 +0000