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
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
|
package SBO::Lib::Build;
use 5.016;
use strict;
use warnings;
our $VERSION = '2.4';
use SBO::Lib::Util qw/ :const prompt script_error get_sbo_from_loc get_arch check_multilib uniq %config in /;
use SBO::Lib::Tree qw/ get_sbo_location /;
use SBO::Lib::Info qw/ get_sbo_version check_x32 get_requires /;
use SBO::Lib::Download qw/ get_sbo_downloads get_dl_fns get_filename_from_link check_distfiles /;
use Exporter 'import';
use Fcntl qw(F_SETFD F_GETFD);
use File::Copy; # copy() and move()
use File::Path qw/ make_path remove_tree /;
use File::Temp qw/ tempdir tempfile /;
use Tie::File;
use Cwd;
our @EXPORT_OK = qw{
do_convertpkg
do_slackbuild
do_upgradepkg
get_build_queue
get_dc_regex
get_pkg_name
get_src_dir
get_tmp_extfn
make_clean
make_distclean
merge_queues
perform_sbo
process_sbos
revert_slackbuild
rewrite_slackbuild
run_tee
$tempdir
$tmpd
$env_tmp
};
our %EXPORT_TAGS = (
all => \@EXPORT_OK,
);
=pod
=encoding UTF-8
=head1 NAME
SBO::Lib::Build - Routines for building slackware packages from SlackBuilds.org.
=head1 SYNOPSIS
use SBO::Lib::Build qw/ perform_sbo /;
my ($foo, $bar, $exit) = perform_sbo(LOCATION => $location, ARCH => 'x86_64');
=head1 VARIABLES
=head2 $env_tmp
This will reflect the C<$TMP> from the environment, being C<undef> if it is not
set.
=head2 $tmpd
Will be the same as C<$TMP> if it is set, otherwise it will be C</tmp/SBo>.
=head2 $tempdir
This is a temporary directory created for sbotools' use, and it should be
cleaned up when sbotools exits.
=cut
# get $TMP from the env, if defined - we use two variables here because there
# are times when we need to know if the environment variable is set, and other
# times where it doesn't matter.
our $env_tmp = $ENV{TMP};
our $tmpd = $env_tmp ? $env_tmp : '/tmp/SBo';
make_path($tmpd) unless -d $tmpd;
our $tempdir = tempdir(CLEANUP => 1, DIR => $tmpd);
=head1 SUBROUTINES
=cut
=head2 do_convertpkg
my ($name32, $exit) = do_convertpkg($name64);
C<do_convertpkg()> runs C<convertpkg> on the package in C<$name64>.
It returns two values. If the second value is true, the first will contain an
error message. Otherwise it will contain the name of the converted package.
=cut
# run convertpkg on a package to turn it into a -compat32 thing
sub do_convertpkg {
script_error('do_convertpkg requires an argument.') unless @_ == 1;
my $pkg = shift;
my $c32tmpd = $env_tmp // '/tmp';
my ($out, $ret) = run_tee("/bin/bash -c '/usr/sbin/convertpkg-compat32 -i $pkg -d $c32tmpd'");
if ($ret != 0) {
return "convertpkg-compt32 returned non-zero exit status\n",
_ERR_CONVERTPKG;
}
unlink $pkg;
return get_pkg_name($out);
}
=head2 do_slackbuild
my ($ver, $pkg, $src, $exit) = do_slackbuild(LOCATION => $location);
C<do_slackbuild()> will make some checks and set up the C<perform_sbo()> call,
if needed run C<do_convertpkg()>, and return the results.
It will return a list of four values. If the fourth one is a true value, the
first one will be an error message. Otherwise the first will be the version,
the second will be the package, and the third will be an array reference to the
source directories created by the build.
=cut
# "public interface", sort of thing.
sub do_slackbuild {
my %args = (
OPTS => 0,
JOBS => 0,
LOCATION => '',
COMPAT32 => 0,
@_
);
$args{LOCATION} or script_error('do_slackbuild requires LOCATION.');
my $location = $args{LOCATION};
my $sbo = get_sbo_from_loc($location);
my $arch = get_arch();
my $multilib = check_multilib();
my $version = get_sbo_version($location);
my $x32;
# ensure x32 stuff is set correctly, or that we're setup for it
if ($args{COMPAT32}) {
unless ($multilib) {
return "compat32 requires multilib.\n", (undef) x 2,
_ERR_NOMULTILIB;
}
unless (-f '/usr/sbin/convertpkg-compat32') {
return "compat32 requires /usr/sbin/convertpkg-compat32.\n",
(undef) x 2, _ERR_NOCONVERTPKG;
}
} else {
if ($arch eq 'x86_64') {
$x32 = check_x32 $args{LOCATION};
if ($x32 && ! $multilib) {
my $warn =
"$sbo is 32-bit which requires multilib on x86_64.\n";
return $warn, (undef) x 2, _ERR_NOMULTILIB;
}
}
}
# setup and run the .SlackBuild itself
my ($pkg, $src, $exit) = perform_sbo(
OPTS => $args{OPTS},
JOBS => $args{JOBS},
LOCATION => $location,
ARCH => $arch,
C32 => $args{COMPAT32},
X32 => $x32,
);
return $pkg, (undef) x 2, $exit if $exit;
if ($args{COMPAT32}) {
($pkg, $exit) = do_convertpkg($pkg);
return $pkg, (undef) x 2, $exit if $exit;
}
return $version, $pkg, $src;
}
=head2 do_upgradepkg
do_upgradepkg($pkg);
C<do_upgradepkg()> runs C<upgradepkg> on C<$pkg>.
There is no useful return value.
=cut
# run upgradepkg for a created package
sub do_upgradepkg {
script_error('do_upgradepkg requires an argument.') unless @_ == 1;
system('/sbin/upgradepkg', '--reinstall', '--install-new', shift);
return 1;
}
=head2 get_build_queue
my @queue = @{ get_build_queue($sbo, my $warnings) };
C<get_build_queue()> gets the prerequisites for C<$sbo>, and updates the
C<$warnings> hash reference with any C<%README%> encountered. It returns the
prerequisites and the C<$sbo> in the order in which they need to be built.
=cut
sub get_build_queue {
script_error('get_build_queue requires two arguments.') unless @_ == 2;
return [ _build_queue(@_) ];
}
=head2 get_dc_regex
my ($rx, $initial) = get_dc_regex($line);
C<get_dc_regex()> when given a line that is an untar or similar command, creates
a regular expression which should match the filename. This is returned, together
with the C<$initial> character which will start the filename match.
=cut
# given a line that looks like it's decompressing something, try to return a
# valid filename regex
sub get_dc_regex {
my $line = shift;
# get rid of initial 'tar x'whatever stuff
$line =~ s/^.*(?<![a-z])(tar|p7zip|unzip|ar|rpm2cpio|sh)\s+[^\s]+\s+//;
# need to know preceeding character - should be safe to assume it's either
# a slash or a space
my $initial = $line =~ qr|/| ? '/' : ' ';
# get rid of initial path info
$line =~ s|^\$[^/]+/||;
# convert any instances of command substitution to [^-]+
$line =~ s/\$\([^)]+\)/[^-]+/g;
# convert any bash variables to [^-]+
$line =~ s/\$({|)[A-Za-z0-9_]+(}|)/[^-]+/g;
# get rid of anything excess at the end
$line =~ s/\s+.*$//;
# fix .?z* at the end
$line =~ s/\.\?z\*/\.[a-z]z.*/;
# return what's left as a regex
my $regex = qr/$initial$line/;
return $regex, $initial;
}
=head2 get_pkg_name
my $name = get_pkg_name($str);
C<get_pkg_name()> searches C<$str> for text matching the output of C<makepkg>
where it outputs the filename of the package it made, and returns it.
=cut
# pull the created package name from the temp file we tee'd to
sub get_pkg_name {
my $str = shift;
my ($out) = $str =~ m/^Slackware\s+package\s+([^\s]+)\s+created\.$/m;
return $out;
}
=head2 get_src_dir
my @dirs = @{ get_src_dir(@orig_dirs) };
C<get_src_dir()> returns a list of the directories under C</tmp/SBo> or C<$TMP>
that aren't in @orig_dirs.
=cut
sub get_src_dir {
my @ls = @_;
my @src_dirs;
# scripts use either $TMP or /tmp/SBo
if (opendir(my $tsbo_dh, $tmpd)) {
FIRST: while (my $ls = readdir $tsbo_dh) {
next FIRST if in($ls => qw/ . .. /, qr/^package-/, @ls);
next FIRST unless -d "$tmpd/$ls";
push @src_dirs, $ls;
}
close $tsbo_dh;
}
return \@src_dirs;
}
=head2 get_tmp_extfn
my ($ret, $exit) = get_tmp_extfn($fh);
C<get_tmp_extfn()> gets the filename in the form of C</dev/fd/X> for the C<$fh>
passed in, setting flags on it that make it usable from other processes without
messing things up.
It returns the filename if successful, otherwise it returns C<undef>.
=cut
# return a filename from a temp fh for use externally
sub get_tmp_extfn {
script_error('get_tmp_extfn requires an argument.') unless @_ == 1;
my $fh = shift;
unless (fcntl($fh, F_SETFD, 0)) { return undef; }
return '/dev/fd/'. fileno $fh;
}
=head2 make_clean
make_clean(SBO => $sbo, SRC => $src, VERSION => $ver);
C<make_clean()> removes source directories, package directories, and compat32
directories that are left over from a slackbuild run.
It has no useful return value.
=cut
# remove work directories (source and packaging dirs under /tmp/SBo or $TMP and /tmp or $OUTPUT)
sub make_clean {
my %args = (
SBO => '',
SRC => '',
VERSION => '',
@_
);
unless ($args{SBO} && $args{SRC} && $args{VERSION}) {
script_error('make_clean requires three arguments.');
}
my $src = $args{SRC};
say "Cleaning for $args{SBO}-$args{VERSION}...";
for my $dir (@$src) {
remove_tree("$tmpd/$dir") if -d "$tmpd/$dir";
}
my $output = $ENV{OUTPUT} // '/tmp';
remove_tree("$output/package-$args{SBO}") if
-d "$output/package-$args{SBO}";
if ($args{SBO} =~ /^(.+)-compat32$/) {
my $pkg_name = $1;
remove_tree("/tmp/package-$args{SBO}") if
not defined $env_tmp and
-d "/tmp/package-$args{SBO}";
remove_tree("$tmpd/package-$pkg_name") if
-d "$tmpd/package-$pkg_name";
}
return 1;
}
=head2 make_distclean
make_distclean(SRC => $src, VERSION => $ver, LOCATION => $loc);
C<make_distclean()> does everything C<make_clean()> does, but in addition it
also removes distribution files, such as the downloaded source tarballs.
It has no useful return value.
=cut
# remove distfiles
sub make_distclean {
my %args = (
SRC => '',
VERSION => '',
LOCATION => '',
@_
);
unless ($args{SRC} && $args{VERSION} && $args{LOCATION}) {
script_error('make_distclean requires four arguments.');
}
my $sbo = get_sbo_from_loc($args{LOCATION});
make_clean(SBO => $sbo, SRC => $args{SRC}, VERSION => $args{VERSION});
say "Distcleaning for $sbo-$args{VERSION}...";
# remove any distfiles for this particular SBo.
my $downloads = get_sbo_downloads(LOCATION => $args{LOCATION});
for my $key (keys %$downloads) {
my $filename = get_filename_from_link($key);
unlink $filename if -f $filename;
}
return 1;
}
=head2 merge_queues
my @merged = @{ merge_queues([@queue1], [@queue2]) };
C<merge_queues> takes two array references and merges them with C<@queue1> in
front, and then anything in C<@queue2> that wasn't already in C<@queue1>. This
is then returned as an array reference.
=cut
sub merge_queues {
# Usage: merge_queues(\@queue_a, \@queue_b);
# Results in queue_b being merged into queue_a (without duplicates)
script_error('merge_queues requires two arguments.') unless @_ == 2;
return [ uniq @{$_[0]}, @{$_[1]} ];
}
=head2 perform_sbo
my ($pkg, $src, $exit) = perform_sbo(LOCATION => $location, ARCH => $arch);
C<perform_sbo()> preps and runs a .SlackBuild. It returns a list of three
values, and if the third one is a true value, the first one will be an error
message. Otherwise the first one will be the package name that was built, and
the second one will be an array reference containing the source directories
that were created.
=cut
# prep and run .SlackBuild
sub perform_sbo {
my %args = (
OPTS => 0,
JOBS => 0,
LOCATION => '',
ARCH => '',
C32 => 0,
X32 => 0,
@_
);
unless ($args{LOCATION} && $args{ARCH}) {
script_error('perform_sbo requires LOCATION and ARCH.');
}
my $location = $args{LOCATION};
my $sbo = get_sbo_from_loc($location);
# we need to get a listing of /tmp/SBo, or $TMP, if we can, before we run
# the SlackBuild so that we can compare to a listing taken afterward.
my @src_ls;
if (opendir(my $tsbo_dh, $tmpd)) {
@src_ls = grep { ! in( $_ => qw/ . .. /) } readdir $tsbo_dh;
}
my ($cmd, %changes);
# set any changes we need to make to the .SlackBuild, setup the command
$cmd = '';
if ($args{ARCH} eq 'x86_64' and ($args{C32} || $args{X32})) {
if ($args{C32}) {
$changes{libdirsuffix} = '';
} elsif ($args{X32}) {
$changes{arch_out} = 'i486';
}
$cmd .= '. /etc/profile.d/32dev.sh &&';
}
if ($args{JOBS} and $args{JOBS} ne 'FALSE') {
$changes{jobs} = 1;
}
$cmd .= " $args{OPTS}" if $args{OPTS};
$cmd .= " MAKEOPTS=\"-j$args{JOBS}\"" if $changes{jobs};
# set TMP/OUTPUT if set in the environment
$cmd .= " TMP=$env_tmp" if $env_tmp;
$cmd .= " OUTPUT=$ENV{OUTPUT}" if defined $ENV{OUTPUT};
$cmd .= " /bin/bash $location/$sbo.SlackBuild";
# attempt to rewrite the slackbuild, or exit if we can't
my ($fail, $exit) = rewrite_slackbuild(
SBO => $sbo,
SLACKBUILD => "$location/$sbo.SlackBuild",
CHANGES => \%changes,
C32 => $args{C32},
);
return $fail, undef, $exit if $exit;
# run the slackbuild, grab its exit status, revert our changes
my $cwd = getcwd();
chdir $location;
my ($out, $ret) = run_tee($cmd);
chdir $cwd;
revert_slackbuild("$location/$sbo.SlackBuild");
# return error now if the slackbuild didn't exit 0
return "$sbo.SlackBuild return non-zero\n", undef, _ERR_BUILD if $ret != 0;
my $pkg = get_pkg_name($out);
return "$sbo.SlackBuild didn't create a package\n", undef, _ERR_BUILD if not defined $pkg;
my $src = get_src_dir(@src_ls);
return $pkg, $src;
}
=head2 process_sbos
my ($failures, $exit) = process_sbos(TODO => [@queue]);
C<process_sbos()> processes the C<@queue> of slackbuilds and returns a list of
two values containing any failed builds in an array ref in the first value, and
the exit status in the second.
=cut
# do the things with the provided sbos - whether upgrades or new installs.
sub process_sbos {
my %args = (
TODO => '',
CMDS => '',
OPTS => '',
JOBS => 'FALSE',
LOCATIONS => '',
NOINSTALL => 0,
NOCLEAN => 'FALSE',
DISTCLEAN => 'FALSE',
NON_INT => 0,
@_
);
my $todo = $args{TODO};
my $cmds = $args{CMDS};
my $opts = $args{OPTS};
my $locs = $args{LOCATIONS};
my $jobs = $args{JOBS} =~ /^\d+$/ ? $args{JOBS} : 0;
@$todo >= 1 or script_error('process_sbos requires TODO.');
my (@failures, @symlinks, $err);
FIRST: for my $sbo (@$todo) {
my $compat32 = $sbo =~ /-compat32$/ ? 1 : 0;
my ($temp_syms, $exit) = check_distfiles(
LOCATION => $$locs{$sbo}, COMPAT32 => $compat32
);
# if $exit is defined, prompt to proceed or return with last $exit
if ($exit) {
$err = $exit;
my $fail = $temp_syms;
push @failures, {$sbo => $fail};
# return now if we're not interactive
return \@failures, $exit if $args{NON_INT};
say "Unable to download/verify source file(s) for $sbo:";
say " $fail";
if (prompt('Do you want to proceed?' , default => 'no')) {
next FIRST;
} else {
unlink for @symlinks;
return \@failures, $exit;
}
} else {
push @symlinks, @$temp_syms;
}
}
my $count = 0;
FIRST: for my $sbo (@$todo) {
$count++;
my $options = $$opts{$sbo} // 0;
my $cmds = $$cmds{$sbo} // [];
for my $cmd (@$cmds) {
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,
);
if ($exit) {
my $fail = $version;
push @failures, {$sbo => $fail};
# return now if we're not interactive
return \@failures, $exit if $args{NON_INT};
# or if this is the last $sbo
return \@failures, $exit if $count == @$todo;
say "Failure encountered while building $sbo:";
say " $fail";
if (prompt('Do you want to proceed?', default => 'no')) {
next FIRST;
} else {
unlink for @symlinks;
return \@failures, $exit;
}
}
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, $err;
}
=head2 revert_slackbuild
revert_slackbuild($path);
C<revert_slackbuild()> moves back a slackbuild that was rewritten by
C<rewrite_slackbuild()>.
There is no useful return value.
=cut
# move a backed-up .SlackBuild file back into place
sub revert_slackbuild {
script_error('revert_slackbuild requires an argument') unless @_ == 1;
my $slackbuild = shift;
if (-f "$slackbuild.orig") {
unlink $slackbuild if -f $slackbuild;
rename "$slackbuild.orig", $slackbuild;
}
return 1;
}
=head2 rewrite_slackbuild
my ($ret, $exit) = rewrite_slackbuild(SLACKBUILD => $path);
C<rewrite_slackbuild()> when given a path and some changes to make, will move
and copy the C<$path> and rewrite the copy with the needed changes.
It returns a list of two values. The second value is the exit status, and if it
is true, the first value will be an error message.
=cut
# make a backup of the existent SlackBuild, and rewrite the original as needed
sub rewrite_slackbuild {
my %args = (
SBO => '',
SLACKBUILD => '',
CHANGES => {},
C32 => 0,
@_
);
$args{SLACKBUILD} or script_error('rewrite_slackbuild requires SLACKBUILD.');
my $slackbuild = $args{SLACKBUILD};
my $changes = $args{CHANGES};
# $status will be undefined if either the rename or the copy fails, otherwise it will be 1
my $status = eval {
rename($slackbuild, "$slackbuild.orig") or die "not ok";
copy("$slackbuild.orig", $slackbuild) or die "not ok";
1;
};
if (not $status) {
rename "$slackbuild.orig", $slackbuild if not -f $slackbuild;
return "Unable to backup $slackbuild to $slackbuild.orig\n",
_ERR_OPENFH;
}
my $libdir_regex = qr/^\s*LIBDIRSUFFIX="64"\s*$/;
my $arch_regex = qr/\$VERSION-\$ARCH-\$BUILD/;
my $dc_regex = qr/(?<![a-z])(tar|p7zip|unzip|ar|rpm2cpio|sh)\s+/;
my $make_regex = qr/^\s*make\s*$/;
# tie the slackbuild, because this is the easiest way to handle this.
tie my @sb_file, 'Tie::File', $slackbuild;
# if we're dealing with a compat32, we need to change the tar line(s) so
# that the 32-bit source is untarred
if ($args{C32}) {
my $location = get_sbo_location($args{SBO});
my $downloads = get_sbo_downloads(
LOCATION => $location,
32 => 1,
);
my $fns = get_dl_fns([keys %$downloads]);
for my $line (@sb_file) {
if ($line =~ $dc_regex) {
my ($regex, $initial) = get_dc_regex($line);
for my $fn (@$fns) {
$fn = "$initial$fn";
$line =~ s/$regex/$fn/ if $fn =~ $regex;
}
}
}
}
for my $line (@sb_file) {
# then check for and apply any other %$changes
if (exists $$changes{libdirsuffix}) {
$line =~ s/64/$$changes{libdirsuffix}/ if $line =~ $libdir_regex;
}
if (exists $$changes{arch_out}) {
$line =~ s/\$ARCH/$$changes{arch_out}/ if $line =~ $arch_regex;
}
if (exists $changes->{jobs}) {
$line =~ s/make/make \$MAKEOPTS/ if $line =~ $make_regex;
}
}
untie @sb_file;
return 1;
}
=head2 run_tee
my ($output, $exit) = run_tee($cmd);
C<run_tee()> runs the C<$cmd >under C<tee(1)> to allow both displaying its
output and returning it as a string. It returns a list of the output and the
exit status (C<$?> in bash). If it can't even run the bash interpreter, the
output will be C<undef> and the exit status will hold a true value.
=cut
sub run_tee {
my $cmd = shift;
my $out_fh = tempfile(DIR => $tempdir);
my $out_fn = get_tmp_extfn($out_fh);
return undef, _ERR_F_SETFD if not defined $out_fn;
my $exit_fh = tempfile(DIR => $tempdir);
my $exit_fn = get_tmp_extfn($exit_fh);
return undef, _ERR_F_SETFD if not defined $exit_fn;
$cmd = sprintf '( %s; echo $? > %s ) | tee %s', $cmd, $exit_fn, $out_fn;
my $ret = system('/bin/bash', '-c', $cmd);
return undef, $ret if $ret;
seek $exit_fh, 0, 0;
chomp($ret = readline $exit_fh);
seek $out_fh, 0, 0;
my $out = do { local $/; readline $out_fh; };
return $out, $ret;
}
=head1 AUTHORS
SBO::Lib was originally written by Jacob Pipkin <j@dawnrazor.net> with
contributions from Luke Williams <xocel@iquidus.org> and Andreas
Guldstrand <andreas.guldstrand@gmail.com>.
=head1 LICENSE
The sbotools are licensed under the WTFPL <http://sam.zoy.org/wtfpl/COPYING>.
Copyright (C) 2012-2017, Jacob Pipkin, Luke Williams, Andreas Guldstrand.
=cut
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;
}
1;
|