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
|
package Test::Sbotools;
use strict;
use warnings;
use Exporter 'import';
use Test::More;
use Test::Execute;
use FindBin '$RealBin';
use Capture::Tiny 'capture_merged';
use Test::Exit;
use lib "$RealBin/../SBO-Lib/lib";
# From Test::Execute
$path = "$RealBin/../";
our @EXPORT_OK = qw/
sbocheck
sboclean
sboconfig
sbofind
sboinstall
sboremove
sbosnap
sboupgrade
set_noclean
set_distclean
set_jobs
set_repo
set_lo
set_version
set_pkg_dir
set_sbo_home
make_slackbuilds_txt
restore_perf_dummy
replace_tags_txt
load
/;
local $Test::Builder::Level = $Test::Builder::Level + 1;
sub sbocheck { script('sbocheck', @_); }
sub sboclean { script('sboclean', @_); }
sub sboconfig { script('sboconfig', @_); }
sub sbofind { script('sbofind', @_); }
sub sboinstall { script('sboinstall', @_); }
sub sboremove { script('sboremove', @_); }
sub sbosnap { script('sbosnap', @_); }
sub sboupgrade { script('sboupgrade', @_); }
sub set_noclean { _set_config('NOCLEAN', @_); }
sub set_distclean { _set_config('DISTCLEAN', @_); }
sub set_jobs { _set_config('JOBS', @_); }
sub set_pkg_dir { _set_config('PKG_DIR', @_); }
sub set_sbo_home { _set_config('SBO_HOME', @_); }
sub set_lo { _set_config('LOCAL_OVERRIDES', @_); }
sub set_version { _set_config('SLACKWARE_VERSION', @_); }
my $sbt = 0;
my $repo = 0;
sub set_repo {
_set_config('REPO', @_);
if (-e "/usr/sbo/repo" and not $repo) {
$repo = 1;
rename '/usr/sbo/repo', "$RealBin/repo.backup";
# if $sbt is true, the SLACKBUILDS.TXT has been created by
# make_slackbuilds_txt and should not be backed up
if ($sbt) { system('rm', "$RealBin/repo.backup/SLACKBUILDS.TXT"); }
}
}
my %config;
my %settings = (
DISTCLEAN => '-d',
JOBS => '-j',
LOCAL_OVERRIDES => '-o',
NOCLEAN => '-c',
PKG_DIR => '-p',
REPO => '-r',
SBO_HOME => '-s',
SLACKWARE_VERSION => '-V',
);
sub _set_config {
my ($config, $value) = @_;
# if %config is empty, populate it
if (not %config) {
sboconfig('-l', { test => 0, expected =>
sub {
my $text = shift;
foreach my $setting (keys %settings) { $text =~ /\Q$setting\E=(.*)/ and $config{$setting} = $1 // 'FALSE'; }
},
});
}
if (defined $value) {
sboconfig($settings{$config}, $value, { test => 0 });
note "Saving original value of '$config': $config{$config}";
} else {
sboconfig($settings{$config}, $config{$config}, { test => 0 });
}
}
my $sbtn = "/usr/sbo/repo/SLACKBUILDS.TXT";
sub make_slackbuilds_txt {
if (not -e $sbtn) { $sbt = 1; system('mkdir', '-p', '/usr/sbo/repo'); system('touch', $sbtn); }
}
sub restore_perf_dummy {
if (!-e '/usr/sbo/distfiles/perf.dummy') {
system('mkdir', '-p', '/usr/sbo/distfiles');
system('cp', "$RealBin/travis-deps/perf.dummy", '/usr/sbo/distfiles');
}
}
my $tags = 0;
my $tags_txt = '/usr/sbo/repo/TAGS.txt';
sub replace_tags_txt {
if (-e $tags_txt) {
if (! $tags) {
$tags = 2;
rename $tags_txt, "$tags_txt.bak";
}
} else {
$tags = 1 if $tags == 0;
}
system('mkdir', '-p', '/usr/sbo/repo');
open my $fh, '>', $tags_txt;
print $fh $_ for @_;
close $fh;
}
# Restore original values when exiting
END {
if (%config) {
_set_config($_) for keys %settings;
}
if ($sbt) {
system(qw!rm -rf!, $sbtn);
}
if ($repo) {
system(qw! rm -rf /usr/sbo/repo !);
rename "$RealBin/repo.backup", "/usr/sbo/repo";
}
if ($tags) {
system(qw!rm -rf !, $tags_txt);
}
if ($tags == 2) {
rename "$tags_txt.bak", $tags_txt;
}
}
sub load {
my ($script, %opts) = @_;
local @ARGV = exists $opts{argv} ? @{ $opts{argv} } : '-h';
my ($ret, $exit, $out, $do_err);
my $eval = eval {
$out = capture_merged { $exit = exit_code {
package main;
$ret = do "$RealBin/../$script";
$do_err = $@;
}; };
1;
};
my $err = $@;
note explain { ret => $ret, exit => $exit, out => $out, eval => $eval, err => $err, do_err => $do_err } if $opts{explain};
}
1;
|
