line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Test::BrewBuild::BrewCommands; |
2
|
35
|
|
|
35
|
|
61410
|
use strict; |
|
35
|
|
|
|
|
71
|
|
|
35
|
|
|
|
|
936
|
|
3
|
35
|
|
|
35
|
|
148
|
use warnings; |
|
35
|
|
|
|
|
64
|
|
|
35
|
|
|
|
|
721
|
|
4
|
|
|
|
|
|
|
|
5
|
35
|
|
|
35
|
|
11719
|
use version; |
|
35
|
|
|
|
|
49893
|
|
|
35
|
|
|
|
|
193
|
|
6
|
|
|
|
|
|
|
|
7
|
35
|
|
|
35
|
|
2805
|
use Data::Dumper; |
|
35
|
|
|
|
|
5131
|
|
|
35
|
|
|
|
|
1598
|
|
8
|
35
|
|
|
35
|
|
12370
|
use Test::BrewBuild::Constant qw(:all); |
|
35
|
|
|
|
|
76
|
|
|
35
|
|
|
|
|
3746
|
|
9
|
35
|
|
|
35
|
|
11784
|
use Test::BrewBuild::Regex; |
|
35
|
|
|
|
|
76
|
|
|
35
|
|
|
|
|
36082
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
our $VERSION = '2.20'; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
my $log; |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
sub new { |
16
|
11
|
|
|
11
|
1
|
34
|
my ($class, $plog) = @_; |
17
|
|
|
|
|
|
|
|
18
|
11
|
|
|
|
|
29
|
my $self = bless {}, $class; |
19
|
|
|
|
|
|
|
|
20
|
11
|
|
|
|
|
48
|
$self->{min_perl_version} = MIN_PERL_VER; |
21
|
|
|
|
|
|
|
|
22
|
11
|
|
|
|
|
44
|
$self->{log} = $plog->child('BrewCommands'); |
23
|
11
|
|
|
|
|
265
|
$log = $self->{log}; |
24
|
|
|
|
|
|
|
|
25
|
11
|
|
|
|
|
30
|
$log->child('new')->_7("instantiating new object"); |
26
|
|
|
|
|
|
|
|
27
|
11
|
|
|
|
|
972
|
$self->brew; |
28
|
|
|
|
|
|
|
|
29
|
11
|
|
|
|
|
33
|
return $self; |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
sub brew { |
32
|
11
|
|
|
11
|
1
|
20
|
my $self = shift; |
33
|
|
|
|
|
|
|
|
34
|
11
|
50
|
|
|
|
34
|
return $self->{brew} if $self->{brew}; |
35
|
|
|
|
|
|
|
|
36
|
11
|
|
|
|
|
19
|
my $brew; |
37
|
|
|
|
|
|
|
|
38
|
11
|
50
|
|
|
|
32
|
if ($self->is_win){ |
39
|
0
|
|
|
|
|
0
|
for (split /;/, $ENV{PATH}){ |
40
|
0
|
0
|
|
|
|
0
|
if (-x "$_/berrybrew.exe"){ |
41
|
0
|
|
|
|
|
0
|
$brew = "$_/berrybrew.exe"; |
42
|
0
|
|
|
|
|
0
|
last; |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
else { |
47
|
11
|
|
|
|
|
49
|
$brew = 'perlbrew'; |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
11
|
50
|
|
|
|
40
|
$log->child('brew')->_6("*brew cmd is: $brew") if $brew; |
51
|
11
|
|
|
|
|
969
|
$self->{brew} = $brew; |
52
|
|
|
|
|
|
|
|
53
|
11
|
|
|
|
|
20
|
return $brew; |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
sub info { |
56
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
57
|
|
|
|
|
|
|
|
58
|
0
|
0
|
|
|
|
0
|
return $self->is_win |
59
|
|
|
|
|
|
|
? `$self->{brew} available 2>nul` |
60
|
|
|
|
|
|
|
: `perlbrew available 2>/dev/null`; |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
sub installed { |
63
|
2
|
|
|
2
|
1
|
18
|
my ($self, $legacy, $info) = @_; |
64
|
|
|
|
|
|
|
|
65
|
2
|
|
|
|
|
26
|
$log->child('installed')->_6("cleaning up perls installed"); |
66
|
|
|
|
|
|
|
|
67
|
2
|
50
|
|
|
|
349
|
return if ! $info; |
68
|
|
|
|
|
|
|
|
69
|
0
|
0
|
|
|
|
0
|
my @installed = $self->is_win |
70
|
0
|
|
|
|
|
0
|
? $info =~ /${ re_brewcommands('installed_berrybrew') }/g |
71
|
0
|
|
|
|
|
0
|
: $info =~ /${ re_brewcommands('installed_perlbrew') }/g; |
72
|
|
|
|
|
|
|
|
73
|
0
|
|
|
|
|
0
|
@installed = $self->_legacy_perls($legacy, @installed); |
74
|
|
|
|
|
|
|
|
75
|
0
|
|
|
|
|
0
|
return @installed; |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
sub using { |
78
|
0
|
|
|
0
|
1
|
0
|
my ($self, $info) = @_; |
79
|
|
|
|
|
|
|
|
80
|
0
|
|
|
|
|
0
|
$log->child( 'using' )->_6( "checking for which ver we're using" ); |
81
|
|
|
|
|
|
|
|
82
|
0
|
0
|
|
|
|
0
|
if ($self->is_win) { |
83
|
0
|
|
|
|
|
0
|
my @installed = $info =~ /${ re_brewcommands('using_berrybrew') }/g; |
|
0
|
|
|
|
|
0
|
|
84
|
0
|
|
|
|
|
0
|
return $installed[0]; |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
else { |
87
|
0
|
|
|
|
|
0
|
my $using = version->parse($])->normal; |
88
|
0
|
|
|
|
|
0
|
$using =~ s/v//; |
89
|
0
|
|
|
|
|
0
|
$using = "perl-$using"; |
90
|
0
|
|
|
|
|
0
|
return $using; |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
sub available { |
94
|
1
|
|
|
1
|
1
|
7
|
my ($self, $legacy, $info) = @_; |
95
|
|
|
|
|
|
|
|
96
|
1
|
|
|
|
|
10
|
$log->child('available')->_6("determining available perls"); |
97
|
|
|
|
|
|
|
|
98
|
1
|
50
|
|
|
|
87
|
my @avail = $self->is_win |
99
|
0
|
|
|
|
|
0
|
? $info =~ /${ re_brewcommands('available_berrybrew') }/g |
100
|
1
|
|
|
|
|
15
|
: $info =~ /${ re_brewcommands('available_perlbrew') }/g; |
101
|
|
|
|
|
|
|
|
102
|
1
|
|
|
|
|
10
|
@avail = $self->_legacy_perls($legacy, @avail); |
103
|
|
|
|
|
|
|
|
104
|
1
|
|
|
|
|
3
|
my %seen; |
105
|
1
|
|
|
|
|
4
|
$seen{$_}++ for @avail; |
106
|
1
|
|
|
|
|
4
|
return keys %seen; |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
sub install { |
109
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
110
|
|
|
|
|
|
|
|
111
|
0
|
0
|
|
|
|
0
|
my $install_cmd = $self->is_win |
112
|
|
|
|
|
|
|
? "$self->{brew} install" |
113
|
|
|
|
|
|
|
: 'perlbrew install --notest -j 4'; |
114
|
|
|
|
|
|
|
|
115
|
0
|
|
|
|
|
0
|
$log->child('install')->_6("install cmd is: $install_cmd"); |
116
|
|
|
|
|
|
|
|
117
|
0
|
|
|
|
|
0
|
return $install_cmd; |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
sub remove { |
120
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
121
|
|
|
|
|
|
|
|
122
|
0
|
|
|
|
|
0
|
my $remove_cmd; |
123
|
|
|
|
|
|
|
|
124
|
0
|
0
|
|
|
|
0
|
if ($self->is_win){ |
125
|
0
|
|
|
|
|
0
|
$remove_cmd = "$self->{brew} remove" |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
else { |
128
|
0
|
|
|
|
|
0
|
my $perlbrew_ver = `$self->{brew} version`; |
129
|
0
|
|
|
|
|
0
|
($perlbrew_ver) = $perlbrew_ver =~ /(\d+\.\d+)/; |
130
|
|
|
|
|
|
|
|
131
|
0
|
0
|
|
|
|
0
|
if (version->parse($perlbrew_ver) > version->parse('0.76')){ |
132
|
0
|
|
|
|
|
0
|
$remove_cmd = 'perlbrew --yes uninstall'; |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
else { |
135
|
0
|
|
|
|
|
0
|
$remove_cmd = 'perlbrew uninstall'; |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
0
|
|
|
|
|
0
|
$log->child('remove')->_6("remove cmd is: $remove_cmd"); |
140
|
|
|
|
|
|
|
|
141
|
0
|
|
|
|
|
0
|
return $remove_cmd; |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
sub is_win { |
144
|
16
|
50
|
|
16
|
1
|
78
|
my $is_win = ($^O =~ /Win/) ? 1 : 0; |
145
|
16
|
|
|
|
|
11631
|
return $is_win; |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
sub info_cache { |
148
|
4
|
|
|
4
|
1
|
15
|
my ($self, $reset) = @_; |
149
|
|
|
|
|
|
|
|
150
|
4
|
100
|
|
|
|
14
|
if ($reset){ |
151
|
1
|
|
|
|
|
24
|
$log->child('info_cache')->_7("resetting info_cache"); |
152
|
1
|
|
|
|
|
446
|
$self->{info_cache} = 0; |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
|
155
|
4
|
50
|
|
|
|
11
|
if (! $self->{info_cache}){ |
156
|
4
|
50
|
|
|
|
16
|
$self->{info_cache} = $self->is_win |
157
|
|
|
|
|
|
|
? `$self->{brew} available 2>nul` |
158
|
|
|
|
|
|
|
: `perlbrew available 2>/dev/null`; |
159
|
|
|
|
|
|
|
|
160
|
4
|
|
|
|
|
257
|
$log->child('info_cache')->_7("cached availability info"); |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
|
163
|
4
|
|
|
|
|
1345
|
$log->child('info_cache')->_6("using cached availability info"); |
164
|
|
|
|
|
|
|
|
165
|
4
|
|
|
|
|
658
|
return $self->{info_cache}; |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
sub _legacy_perls { |
168
|
1
|
|
|
1
|
|
6
|
my ($self, $legacy, @perls) = @_; |
169
|
|
|
|
|
|
|
|
170
|
1
|
50
|
|
|
|
10
|
if ($legacy) { |
171
|
0
|
|
|
|
|
0
|
$log->child('_legacy_perls')->_7( |
172
|
|
|
|
|
|
|
"legacy is enabled, using perls older than 5.8.9" |
173
|
|
|
|
|
|
|
); |
174
|
0
|
0
|
|
|
|
0
|
return @perls if $legacy; |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
else { |
177
|
1
|
|
|
|
|
7
|
$log->child('_legacy_perls')->_7( |
178
|
|
|
|
|
|
|
"legacy is disabled, ignoring perls older than 5.8.9" |
179
|
|
|
|
|
|
|
); |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
|
182
|
1
|
|
|
|
|
93
|
my @avail; |
183
|
|
|
|
|
|
|
|
184
|
1
|
|
|
|
|
7
|
for my $ver_string (@perls){ |
185
|
0
|
|
|
|
|
0
|
my ($ver) = $ver_string =~ /(5\.\d+\.\d+)/; |
186
|
|
|
|
|
|
|
|
187
|
0
|
0
|
|
|
|
0
|
if (version->parse($ver) > version->parse($self->{min_perl_version})){ |
188
|
0
|
|
|
|
|
0
|
push @avail, $ver_string; |
189
|
|
|
|
|
|
|
} |
190
|
|
|
|
|
|
|
} |
191
|
1
|
|
|
|
|
11
|
return @avail; |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
1; |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
=head1 NAME |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
Test::BrewBuild::BrewCommands - Provides Windows/Unix *brew command |
198
|
|
|
|
|
|
|
translations for Test::BrewBuild |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
=head1 METHODS |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
=head2 new |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
Returns a new Test::BrewBuild::BrewCommands object. |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
=head2 brew |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
Returns C if on Unix, and the full executable path for |
209
|
|
|
|
|
|
|
C if on Windows. |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
=head2 info |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
Returns the string result of C<*brew available>. |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
=head2 info_cache($reset) |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
Fetches, then caches the results of '*brew available'. This is due to the fact |
218
|
|
|
|
|
|
|
that perlbrew does an Internet lookup for the information, and berrybrew will |
219
|
|
|
|
|
|
|
shortly as well. |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
The cache is rebuilt on each new program run. |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
Parameters: |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
$reset |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
Bool, optional. Set to a true value to flush out the cache so it will be |
228
|
|
|
|
|
|
|
re-initialized. |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
=head2 installed($info) |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
Takes the output of C<*brew available> in a string form. Returns the currently |
233
|
|
|
|
|
|
|
installed versions, formatted in a platform specific manner. |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
=head2 using($info) |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
Returns the current version of perl we're using. C<$info> is the output from |
238
|
|
|
|
|
|
|
C. |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
=head2 available($legacy, $info) |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
Similar to C, but returns all perls available. If C<$legacy> is |
243
|
|
|
|
|
|
|
false, we'll only return C versions C<5.8.0+>. |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
=head2 install |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
Returns the current OS's specific C<*brew install> command. |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
=head2 remove |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
Returns the current OS's specific C<*brew remove> command. |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
=head2 is_win |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
Returns 0 if on Unix, and 1 if on Windows. |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
=head1 AUTHOR |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
Steve Bertrand, C<< >> |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
Copyright 2017 Steve Bertrand. |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
266
|
|
|
|
|
|
|
under the terms of either: the GNU General Public License as published |
267
|
|
|
|
|
|
|
by the Free Software Foundation; or the Artistic License. |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
See L for more information. |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
=cut |
273
|
|
|
|
|
|
|
|