1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
|
#!/usr/bin/env perl
#
# vim: set ts=4:noet
#
# sboupgrade
# script to upgrade (a) SlackBuild(s) by name
#
# authors: Jacob Pipkin <j@dawnrazor.net>
# Luke Williams <xocel@iquidus.org>
# license: WTFPL <http://sam.zoy.org/wtfpl/COPYING>
use 5.16.0;
use strict;
use warnings FATAL => 'all';
use SBO::Lib;
use Getopt::Long qw(:config bundling);
use File::Basename;
use File::Copy;
my $self = basename($0);
sub show_usage {
print <<EOF
Usage: $self (options) [package]
Options (defaults shown first where applicable):
-h|--help:
this screen.
-v|--version:
version information.
-c|--noclean (FALSE|TRUE):
set whether or not to clean working directories after building.
-d|--distclean (TRUE|FALSE):
set whether or not to clean distfiles afterward.
-f|--force:
force an update, even if the "upgrade" version is the same or lower.
-i|--noinstall:
do not run installpkg at the end of the build process.
-j|--jobs (FALSE|#):
specify "-j" setting to make, for multicore systems; overrides conf file.
-r|--nointeractive:
non-interactive; skips README and all prompts.
-z|--force-reqs:
when used with -f, will force rebuilding an SBo's requirements as well.
EOF
}
my $noclean = $config{NOCLEAN};
my $distclean = $config{DISTCLEAN};
my $jobs = $config{JOBS};
my ($help, $vers, $force, $no_install, $non_int, $force_reqs);
# backwards compatibility options
my ($install_new, $no_reqs, $compat32);
GetOptions(
'help|h' => \$help,
'version|v' => \$vers,
'noclean|c=s' => \$noclean,
'distclean|d=s' => \$distclean,
'force|f' => \$force,
'noinstall|i' => \$no_install,
'jobs|j=s' => \$jobs,
'installnew|N' => \$install_new,
'nointeractive|r' => \$non_int,
'norequirements|R' => \$no_reqs,
'force-reqs|z' => \$force_reqs,
'compat32|p' => \$compat32,
);
show_usage() and exit 0 if $help;
show_version() and exit 0 if $vers;
show_usage() and exit 1 unless exists $ARGV[0];
$noclean = $noclean eq 'TRUE' ? 1 : 0;
$distclean = $distclean eq 'TRUE' ? 1 : 0;
if ($jobs) {
usage_error("You have provided an invalid value for -j|--jobs")
unless ($jobs =~ /^\d+$/ || $jobs eq 'FALSE');
}
usage_error("-r|--nointeractive and -z|--force-reqs can not be used together.")
if $non_int && $force_reqs;
usage_error("-R|--norequirements does not make sense without -N|--installnew")
if $no_reqs && ! $install_new;
usage_error("-p|--compat32 does not make sense without -N|--installnew")
if $compat32 && ! $install_new;
# if we can't find SLACKBUILDS.TXT in $config{HOME}, prompt to fetch the tree
slackbuilds_or_fetch();
my @sbos = @ARGV;
# pull locations for everything specified on command line.
my %locations;
for my $sbo (@sbos) {
my $name = $sbo;
$name =~ s/-compat32//;
$locations{$sbo} = get_sbo_location($name);
usage_error("Unable to locate $sbo in the SlackBuilds.org tree.") unless
$locations{$sbo};
if ($sbo =~ /-compat32$/) {
usage_error("compat32 Perl SBos are not supported.")
if $locations{$sbo} =~ qr|/perl/[^/]+$|;
}
}
# get a list of installed SBos to check upgradability against
my $inst_names = get_inst_names(get_installed_packages('SBO'));
my %inst_names;
$inst_names{$_} = 1 for @$inst_names;
# backwards compatibility
if ($install_new) {
# warn about future removal and pause for five seconds - which hopefully
# might encourage the user to read and take note of the warning.
warn "-N is deprecated and will disappear in a future release.\n";
select((select(STDOUT), $| = 1)[0]);
print("."), sleep 1 for 1..5;
say '';
$| = 0;
for my $sbo (@sbos) {
my $name = $sbo;
$name =~ s/$/-compat32/ if $compat32 && $sbo !~ /-compat32$/;
unless ($inst_names{$name}) {
my @args = ('/usr/sbin/sboinstall');
push @args, $noclean ? '-cTRUE' : '-cFALSE';
push @args, $distclean ? '-dTRUE' : '-dFALSE';
push @args, '-R' if $no_reqs;
push @args, '-p' if $compat32;
push @args, '-i' if $no_install;
push @args, '-r' if $non_int;
push @args, '-R' if $no_reqs;
push @args, "-j$jobs" if $jobs;
system(@args, $sbo);
}
}
}
my $upgrade_queue;
# doesn't matter what's updatable and what's not if force is specified,
# but without force, we only want to update what there are updates for
unless ($force) {
my %updates;
my $updates = get_available_updates();
$updates{$$_{name}} = 1 for @$updates;
for my $sbo (@sbos) {
push @$upgrade_queue, $sbo if $updates{$sbo};
}
} else {
if ($force_reqs && ! $non_int) {
my $temp_queue;
for my $sbo (@sbos) {
my $name = $sbo;
$name =~ s/-compat32$//;
my $queue = get_build_queue([$name], my $warnings);
my $queue2;
for my $item (@$queue) {
push @$queue2, $item if $inst_names{$item};
}
$queue = $queue2;
my $cqueue;
# get locations for all the things
my %locs = get_sbo_locations($queue);
my %clocs;
# -compat32-ify the queue and locations if appropriate
if ($sbo =~ /-compat32$/) {
$cqueue = $queue;
s/$/-compat32/g for @$cqueue;
$queue = $cqueue;
for my $key (keys %locs) {
my $val = $locs{$key};
$key =~ s/$/-compat32/;
$clocs{$key} = $val;
}
%locs = %clocs;
}
@locations{keys %locs} = values %locs;
$temp_queue = merge_queues($temp_queue, $queue);
}
$upgrade_queue = $temp_queue;
} else {
for my $sbo (@sbos) {
push @$upgrade_queue, $sbo if $inst_names{$sbo};
}
}
}
# Get user input regarding upgrades
my (@temp_queue, %commands, %options);
FIRST: for my $sbo (@$upgrade_queue) {
unless ($non_int) {
my ($cmds, $opts, $exit) = user_prompt($sbo, $locations{$sbo});
if ($exit) {
warn "Unable to open README for $sbo.\n";
exit $exit;
}
if ($cmds) {
next FIRST if $cmds eq 'N';
}
push(@temp_queue, $sbo);
$commands{$sbo} = $cmds;
$options{$sbo} = $opts;
say "$sbo added to upgrade queue.";
} else {
push(@temp_queue, $sbo);
say "\n$sbo added to upgrade queue.";
}
}
@$upgrade_queue = @temp_queue;
exit 0 unless exists $$upgrade_queue[0];
say "\nUpgrade queue: ". join(' ', @$upgrade_queue);
unless ($non_int) {
print "\nAre you sure you wish to continue? [y]: ";
exit 0 unless <STDIN> =~ /^[Yy\n]/;
}
my ($failures, $exit) = process_sbos(
TODO => $upgrade_queue,
CMDS => \%commands,
OPTS => \%options,
JOBS => $jobs,
LOCATIONS => \%locations,
NOINSTALL => $no_install,
NOCLEAN => $noclean,
DISTCLEAN => $distclean,
NON_INT => $non_int,
);
print_failures($failures);
if ($exit) {
exit $exit;
} else {
exit 0;
}
|
