File Coverage

blib/lib/Test/BrewBuild.pm
Criterion Covered Total %
statement 155 521 29.7
branch 33 178 18.5
condition 3 21 14.2
subroutine 33 52 63.4
pod 18 18 100.0
total 242 790 30.6


line stmt bran cond sub pod time code
1             package Test::BrewBuild;
2 34     34   316831 use strict;
  34         209  
  34         998  
3 34     34   170 use warnings;
  34         67  
  34         963  
4              
5 34     34   174 use Carp qw(croak);
  34         63  
  34         1884  
6 34     34   228 use Cwd qw(getcwd);
  34         66  
  34         1611  
7 34     34   20715 use Data::Dumper;
  34         230626  
  34         2279  
8 34     34   14567 use File::Copy;
  34         101872  
  34         2235  
9 34     34   17402 use File::Copy::Recursive qw(dircopy);
  34         140575  
  34         2469  
10 34     34   285 use File::Find;
  34         70  
  34         2438  
11 34     34   250 use File::Path qw(remove_tree);
  34         1734  
  34         1968  
12 34     34   10795 use File::Temp;
  34         292822  
  34         2517  
13 34     34   24981 use Getopt::Long qw(GetOptionsFromArray);
  34         354932  
  34         158  
14             Getopt::Long::Configure ("no_ignore_case", "pass_through");
15 34     34   15536 use Logging::Simple;
  34         231786  
  34         1260  
16 34     34   16426 use Module::Load;
  34         38466  
  34         218  
17 34     34   16386 use Plugin::Simple default => 'Test::BrewBuild::Plugin::DefaultExec';
  34         458293  
  34         280  
18 34     34   16788 use Test::BrewBuild::BrewCommands;
  34         100  
  34         1202  
19 34     34   250 use Test::BrewBuild::Constant qw(:all);
  34         68  
  34         3924  
20 34     34   9710 use Test::BrewBuild::Dispatch;
  34         108  
  34         1158  
21 34     34   226 use Test::BrewBuild::Regex;
  34         74  
  34         2372  
22 34     34   16504 use Test::BrewBuild::Tester;
  34         108  
  34         195085  
23              
24             our $VERSION = '2.21';
25              
26             my $log;
27             my $bcmd;
28              
29             sub new {
30 11     11 1 5876 my ($class, %args) = @_;
31 11         41 my $self = bless { }, $class;
32              
33             # see if we have config file data
34              
35 11 50       42 if ($self->config_file) {
36 11         40 $self->_config;
37             }
38              
39             # override the config file and populate the rest of the args
40              
41 11         61 for (keys %args){
42 9         36 $self->{args}{$_} = $args{$_};
43             }
44              
45 11         61 $log = $self->_create_log($args{debug});
46 11         68 $log->_6("in new(), constructing " . __PACKAGE__ . " object");
47              
48 11         1056 $bcmd = Test::BrewBuild::BrewCommands->new($log);
49              
50 11         49 $self->_set_plugin();
51              
52 11         1395 $self->tempdir;
53 11         38 $log->_7("using temp bblog dir: " . $self->tempdir);
54              
55 11         1039 return $self;
56             }
57             sub options {
58 0     0 1 0 my ($self, $args) = @_;
59 0         0 my %opts;
60              
61 0         0 my @arg_directives = grep {$_ =~ /^-/} @$args;
  0         0  
62              
63 0         0 my $bad_opt = _validate_opts(\@arg_directives);
64              
65             GetOptionsFromArray(
66             $args,
67             "on=s@" => \$opts{on},
68             "n|new=s" => \$opts{new},
69             "r|remove" => \$opts{remove},
70             "R|revdep" => \$opts{revdep},
71             "plugin=s" => \$opts{plugin},
72             "a|args=s@" => \$opts{args},
73             "d|debug=i" => \$opts{debug},
74             "i|install=s@" => \$opts{install},
75             "N|notest" => \$opts{notest},
76             "S|save" => \$opts{save_reports},
77             "l|legacy" => \$opts{legacy},
78             "T|selftest" => \$opts{selftest},
79             "D|dispatch" => \$opts{dispatch},
80             "t|tester=s@" => \$opts{testers},
81             "X|nocache" => \$opts{nocache},
82             "s|setup" => \$opts{setup},
83             "h|help" => \$opts{help},
84 0         0 );
85              
86 0 0       0 $opts{error} = 1 if $bad_opt;
87              
88 0         0 return %opts;
89             }
90             sub config_file {
91 23     23 1 39 shift;
92 23 50       55 if (is_win()){
93 0 0       0 return $ENV{BB_CONF} if $ENV{BB_CONF};
94 0         0 return "$ENV{USERPROFILE}/brewbuild/brewbuild.conf";
95             }
96             else {
97 23 100       82 return $ENV{BB_CONF} if $ENV{BB_CONF};
98 19         87 return "$ENV{HOME}/brewbuild/brewbuild.conf";
99             }
100             }
101             sub is_win {
102 33 50   33 1 165 my $is_win = ($^O =~ /Win/) ? 1 : 0;
103 33         89 return $is_win;
104             }
105             sub brew_info {
106 3     3 1 6 my $self = shift;
107 3         28 my $log = $log->child('brew_info');
108              
109 3         77 my $brew_info;
110              
111 3 50       12 if ($self->{args}{nocache}){
112             # don't use cached info
113 0         0 $brew_info = $bcmd->info;
114             }
115             else {
116 3         18 $brew_info = $bcmd->info_cache;
117             }
118              
119 3 50       51 $log->_6("brew info set to:\n$brew_info") if $brew_info;
120              
121 3         107 return $brew_info;
122             }
123             sub perls_available {
124 1     1 1 4 my $self = shift;
125 1         3 my $log = $log->child('perls_available');
126 1         34 my @perls_available = $bcmd->available($self->legacy, $self->brew_info);
127 1         12 $log->_6("perls available: " . join ', ', @perls_available);
128 1         80 return @perls_available;
129             }
130             sub perls_installed {
131 2     2 1 8 my $self = shift;
132 2         7 my $log = $log->child('perls_installed');
133 2         76 $log->_6("checking perls installed");
134 2         352 return $bcmd->installed($self->legacy, $self->brew_info);
135             }
136             sub instance_install {
137 1     1 1 991 my ($self, $install, $timeout) = @_;
138              
139             # timeout an install after...
140              
141 1 50       4 if (! $timeout){
142 1 50       5 if ($self->{args}{timeout}){
143 0         0 $timeout = $self->{args}{timeout};
144             }
145             else {
146 1         2 $timeout = INSTANCE_INSTALL_TIMEOUT;
147             }
148             }
149              
150 1         5 my $log = $log->child('instance_install');
151              
152 1         37 my @perls_available = $self->perls_available;
153 1         14 my @perls_installed = $self->perls_installed;
154 1         9 my @new_installs;
155              
156 1 50       53 if (ref $install eq 'ARRAY'){
    50          
    50          
157 0         0 for my $version (@$install){
158 0 0 0     0 $version = "perl-$version" if ! $self->is_win && $version !~ /perl/;
159              
160 0 0       0 if ($self->is_win){
161 0 0       0 if ($version !~ /_/){
162 0         0 $log->_7("MSWin: no bit suffix supplied");
163 0 0       0 if (! grep {$_ =~ /$version/} @perls_available){
  0         0  
164 0         0 $version .= '_64';
165 0         0 $log->_7("MSWin: default to available 64-bit $version");
166             }
167             else {
168 0         0 $version .= '_32';
169 0         0 $log->_7("MSWin: no 64-bit version... using $version");
170             }
171             }
172             }
173 0 0       0 $version =~ s/_.*$// if ! $self->is_win;
174              
175 0 0       0 if (! grep { $version eq $_ } @perls_available){
  0         0  
176 0         0 $log->_0("$version is not a valid perl version");
177 0         0 next;
178             }
179              
180 0 0       0 if (grep { $version eq $_ } @perls_installed){
  0         0  
181 0         0 $log->_6("$version is already installed... skipping");
182 0         0 next;
183             }
184 0         0 push @new_installs, $version;
185             }
186             }
187             elsif ($install == -1) {
188 0         0 $log->_5("installing all available perls");
189              
190 0         0 for my $perl (@perls_available){
191 0 0       0 if (grep { $_ eq $perl } @perls_installed) {
  0         0  
192 0         0 $log->_6( "$perl already installed... skipping" );
193 0         0 next;
194             }
195 0         0 push @new_installs, $perl;
196             }
197             }
198             elsif ($install) {
199 1         23 $log->_5("looking to install $install perl instance(s)");
200              
201 1         89 my %avail = map {$_ => 1} @perls_available;
  0         0  
202              
203 1         14 while ($install > 0){
204 1 50       13 last if ! keys %avail;
205              
206 0         0 my $candidate = (keys %avail)[rand keys %avail];
207 0         0 delete $avail{$candidate};
208              
209 0 0       0 if (grep { $_ eq $candidate } @perls_installed) {
  0         0  
210 0         0 $log->_6( "$candidate already installed... skipping" );
211 0         0 next;
212             }
213              
214 0         0 push @new_installs, $candidate;
215 0         0 $install--;
216             }
217             }
218              
219 1 50       12 if (@new_installs){
220 0         0 $log->_4("preparing to install..." . join ', ', @new_installs);
221              
222 0         0 my $install_cmd = $bcmd->install;
223              
224 0         0 for my $ver (@new_installs) {
225 0         0 $log->_0( "installing $ver..." );
226 0         0 $log->_5( "...using cmd: $install_cmd" );
227 0         0 undef $@;
228 0         0 eval {
229             local $SIG{ALRM} = sub {
230 0     0   0 croak "$ver failed to install... skipping"
231 0         0 };
232 0         0 alarm $timeout;
233 0         0 `$install_cmd $ver`;
234 0         0 alarm 0;
235             };
236 0 0       0 if ($@){
237 0         0 $log->_0($@);
238 0         0 $log->_1("install of $ver failed: uninstalling the remnants..");
239 0         0 $self->instance_remove($ver);
240 0         0 next;
241             }
242             }
243 0 0       0 $bcmd->info_cache(1) if ! $self->{args}{nocache};
244             }
245             else {
246 1         12 $log->_5("using existing versions only, nothing to install");
247             }
248             }
249             sub instance_remove {
250 1     1 1 10 my ($self, $version) = @_;
251              
252 1         41 my $log = $log->child('instance_remove');
253              
254 1         35 my @perls_installed = $self->perls_installed;
255              
256 1         8 $log->_6("perls installed: " . join ', ', @perls_installed);
257              
258 1         279 my $remove_cmd = $bcmd->remove;
259              
260 1         53 $log->_4( "using '$remove_cmd' remove command" );
261              
262 1 50       282 if ($version){
263 1         21 $log->_5("$version supplied, removing...");
264 1 50       291 if ($self->is_win){
265 0         0 `$remove_cmd $version 2`
266             }
267             else {
268 1         3607 `$remove_cmd $version 2>/dev/null`;
269             }
270 1 50       81 $bcmd->info_cache(1) if ! $self->{args}{nocache};
271             }
272             else {
273 0         0 $log->_0("removing previous installs...");
274              
275 0         0 for my $installed_perl (@perls_installed){
276              
277 0         0 my $using = $bcmd->using($self->brew_info);
278              
279 0 0       0 if ($using eq $installed_perl) {
280 0         0 $log->_5( "not removing version we're using: $using" );
281 0         0 next;
282             }
283              
284 0         0 $log->_5( "exec'ing $remove_cmd $installed_perl" );
285              
286 0 0       0 if ($bcmd->is_win) {
287 0         0 `$remove_cmd $installed_perl 2>nul`;
288             }
289             else {
290 0         0 `$remove_cmd $installed_perl 2>/dev/null`;
291             }
292 0 0       0 $bcmd->info_cache(1) if ! $self->{args}{nocache};
293             }
294             }
295              
296 1         33 $log->_4("removal of existing perl installs complete...\n");
297             }
298             sub revdep {
299 0     0 1 0 my ($self, %args) = @_;
300              
301 0         0 delete $self->{args}{args};
302              
303             # these args aren't sent through to test()
304              
305 0         0 delete $args{revdep};
306 0         0 delete $self->{args}{delete};
307 0         0 delete $args{remove};
308 0         0 delete $args{install};
309 0         0 delete $args{new};
310              
311 0         0 $args{plugin} = 'Test::BrewBuild::Plugin::TestAgainst';
312              
313 0         0 my @revdeps = $self->revdeps;
314 0         0 my @ret;
315              
316 0         0 my $rlist = "\nreverse dependencies: " . join ', ', @revdeps;
317 0         0 $rlist .= "\n\n";
318 0         0 push @ret, $rlist;
319              
320 0         0 for (@revdeps){
321 0         0 $args{plugin_arg} = $_;
322 0         0 my $bb = __PACKAGE__->new(%args);
323 0         0 $bb->log()->file($self->log()->file());
324 0         0 push @ret, $bb->test;
325             }
326 0         0 return \@ret;
327             }
328             sub test {
329 0     0 1 0 my $self = shift;
330              
331 0 0       0 exit if $self->{args}{notest};
332              
333 0         0 my $log = $log->child('test');
334 0     0   0 local $SIG{__WARN__} = sub {};
335 0         0 $log->_6("warnings trapped locally");
336              
337 0         0 my $failed = 0;
338              
339 0         0 my @perls_installed = $bcmd->installed(0, $self->brew_info);
340              
341 0         0 my $results = $self->_exec;
342              
343 0 0       0 if (@perls_installed == 1){
344 0 0       0 if ($results !~ /${ re_brewbuild('check_result') }/){
  0         0  
345 0         0 $results = "$perls_installed[0]\n==========\n" . $results;
346             }
347             }
348              
349 0         0 $log->_7("\n*****\n$results\n*****");
350              
351 0         0 my @ver_results = $results =~ /${ re_brewbuild('check_result') }/g;
  0         0  
352              
353 0         0 $log->_5("got " . scalar @ver_results . " results");
354              
355 0         0 my (@pass, @fail);
356              
357 0         0 for my $result (@ver_results){
358 0         0 my $ver;
359              
360 0 0       0 if ($result =~ /${ re_brewbuild('extract_perl_version') }/){
  0         0  
361 0         0 $ver = $1;
362 0         0 $ver =~ s/[Pp]erl-//;
363             }
364 0         0 my $res;
365              
366 0 0 0     0 if ($result =~ /Successfully tested / && $result !~ /FAIL/){
367 0         0 $log->_6("$ver PASSED...");
368 0         0 $res = 'PASS';
369              
370 0         0 push @pass, "$ver :: $res\n";
371 0         0 $self->_save_reports($ver, $res, $result);
372             }
373             else {
374 0         0 $log->_6("$ver FAILED...");
375 0         0 $res = 'FAIL';
376 0         0 $failed = 1;
377              
378 0         0 push @fail, "$ver :: $res\n";
379 0         0 $self->_save_reports($ver, $res, $result);
380             }
381             }
382              
383 0         0 $self->_copy_logs;
384              
385 0         0 $log->_5(__PACKAGE__ ." run finished\n");
386              
387 0         0 my $ret = "\n";
388 0 0       0 $ret .= "$self->{args}{plugin_arg}\n" if $self->{args}{plugin_arg};
389 0         0 $ret .= $_ for @pass;
390 0         0 $ret .= $_ for @fail;
391 0         0 $ret .= "\n\n";
392              
393 0         0 return $ret;
394             }
395             sub tempdir {
396 22     22 1 95 my $self = shift;
397 22 100       136 return $self->{tempdir} if $self->{tempdir};
398              
399 11         100 my $dir = File::Temp->newdir;
400 11         6712 my $dir_name = $dir->dirname;
401 11         352 $self->{temp_handle} = $dir;
402 11         32 $self->{tempdir} = $dir_name;
403 11         24 return $self->{tempdir};
404             }
405             sub workdir {
406 1     1 1 95 my $self = shift;
407 1 50       4 return is_win()
408             ? "$ENV{USERPROFILE}/brewbuild"
409             : "$ENV{HOME}/brewbuild";
410             }
411             sub log {
412 0     0 1 0 my $self = shift;
413 0         0 $self->{log}->_6(ref($self) ." class/obj accessing the log object");
414 0         0 $self->{log};
415             }
416             sub revdeps {
417 0     0 1 0 my $self = shift;
418              
419 0         0 load 'MetaCPAN::Client';
420 0         0 my $mcpan = MetaCPAN::Client->new;
421              
422 0         0 my $log = $log->child('revdeps');
423 0         0 $log->_6('running --revdep');
424              
425 0         0 my $mod;
426              
427             find(
428             {
429             wanted => sub {
430 0 0   0   0 return if $mod;
431              
432 0 0 0     0 if (-f && $_ =~ /\.pm$/){
433              
434 0         0 $log->_6("processing module '$_'");
435              
436 0         0 s|lib/||;
437 0         0 s|/|-|g;
438 0         0 s|\.pm||;
439              
440 0         0 $log->_6("module file converted to '$_'");
441              
442 0         0 my $dist;
443              
444 0         0 eval {
445 0         0 $dist = $mcpan->distribution($_);
446             };
447 0 0       0 $mod = $_ if ref $dist;
448              
449             }
450             },
451 0         0 no_chdir => 1,
452             },
453             'lib/'
454             );
455              
456 0         0 $log->_7("using '$mod' as the project we're working on");
457              
458 0         0 my @revdeps = $self->_get_revdeps($mod);
459 0         0 return @revdeps;
460             }
461             sub legacy {
462 6     6 1 24 my ($self, $legacy) = @_;
463 6 100 100     46 if (! defined $legacy && defined $self->{args}{legacy}){
464 1         6 return $self->{args}{legacy};
465              
466             }
467 5 100       21 $self->{args}{legacy} = defined $legacy ? $legacy : 0;
468 5         22 return $self->{args}{legacy};
469             }
470             sub setup {
471 0     0 1 0 print "\n";
472 0         0 my @setup = ;
473 0         0 print $_ for @setup;
474 0         0 exit;
475             }
476             sub help {
477 0     0 1 0 print <
478              
479             Usage: brewbuild [OPTIONS]
480              
481             Local usage options:
482              
483             -o | --on Perl version number to run against (can be supplied multiple times). Can not be used on Windows
484             -R | --revdep Run tests, install, then run tests on all CPAN reverse dependency modules
485             -n | --new How many random versions of perl to install (-1 to install all)
486             -r | --remove Remove all installed perls (less the current one)
487             -i | --install Number portion of an available perl version according to "*brew available". Multiple versions can be sent in at once
488             -S | --save By default, we save only FAIL logs. This will also save the PASS logs
489             -N | --notest Do not run tests. Allows you to --remove and --install without testing
490             -X | --nocache By default, we cache the results of 'perlbrew available'. Disable with this flag.
491              
492             Network dispatching options:
493              
494             -D | --dispatch Dispatch a basic run to remote testers
495             -t | --tester Testers to dispatch to. Can be supplied multiple times. Format: "host[:port]"
496              
497             Help options:
498              
499             -s | --setup Display test platform setup instructions
500             -h | --help Print this help message
501              
502             Special options:
503              
504             -p | --plugin Module name of the exec command plugin to use
505             -a | --args List of args to pass into the plugin (one arg per loop)
506             -l | --legacy Operate on perls < 5.8.9. The default plugins won't work with this flag set if a lower version is installed
507             -T | --selftest Testing only: prevent recursive testing on Test::BrewBuild
508             -d | --debug 0-7, sets logging verbosity, default is 0
509              
510             EOF
511 0         0 return 1;
512             }
513             sub _config {
514             # slurp in config file elements
515              
516 11     11   26 my $self = shift;
517              
518 11         27 my $conf_file = $self->config_file;
519              
520 11 100       231 if (-f $conf_file){
521 2         17 my $conf = Config::Tiny->read($conf_file)->{brewbuild};
522 2         433 for (keys %$conf){
523 12         31 $self->{args}{$_} = $conf->{$_};
524             }
525             }
526             }
527             sub _attach_build_log {
528             # attach the cpanm logs to the PASS/FAIL logs
529              
530 0     0   0 my ($self, $bblog) = @_;
531              
532 0         0 my $bbfile;
533             {
534 0         0 local $/ = undef;
  0         0  
535 0 0       0 open my $bblog_fh, '<', $bblog or croak $!;
536 0         0 $bbfile = <$bblog_fh>;
537 0         0 close $bblog_fh;
538             }
539              
540 0 0       0 if ($bbfile =~ /${ re_brewbuild('check_failed') }/){
  0         0  
541 0         0 my $build_log = $1;
542 0 0       0 open my $bblog_wfh, '>>', $bblog or croak $!;
543 0         0 print $bblog_wfh "\n\nCPANM BUILD LOG\n";
544 0         0 print $bblog_wfh "===============\n";
545              
546 0 0       0 open my $build_log_fh, '<', $build_log or croak $!;
547              
548 0         0 while (<$build_log_fh>){
549 0         0 print $bblog_wfh $_;
550             }
551 0         0 close $bblog_wfh;
552             }
553             }
554             sub _copy_logs {
555             # copy the log files out of the temp dir
556              
557 0     0   0 my $self = shift;
558 0 0       0 dircopy $self->{tempdir}, "bblog" if $self->{tempdir};
559 0 0       0 unlink 'bblog/stderr.bblog' if -e 'bblog/stderr.bblog';
560             }
561             sub _create_log {
562             # set up the log object
563              
564 11     11   48 my ($self, $level) = @_;
565              
566 11 100       123 $self->{log} = Logging::Simple->new(
567             name => 'BrewBuild',
568             level => defined $level ? $level : 0,
569             );
570              
571 11         1835 $self->{log}->_7("in _create_log()");
572              
573 11 100       1214 if ($self->{log}->level < 6){
574 10         329 $self->{log}->display(0);
575 10         293 $self->{log}->custom_display("-");
576 10 50       161 $self->{log}->_5("set log level to " . defined $level ? $level : 0);
577             }
578              
579 11         741 return $self->{log};
580             }
581             sub _exec {
582             # perform the actual *brew build commands (called by test())
583              
584 0     0   0 my $self = shift;
585              
586 0         0 my $log = $log->child('exec');
587              
588 0 0       0 if ($self->{args}{plugin_arg}) {
589             $log->_5( "" .
590             "fetching instructions from the plugin with arg " .
591             $self->{args}{plugin_arg}
592 0         0 );
593             }
594              
595             my @exec_cmd = $self->{exec_plugin}->(
596             __PACKAGE__,
597             $self->log,
598             $self->{args}{plugin_arg}
599 0         0 );
600              
601 0         0 chomp @exec_cmd;
602              
603 0         0 $log->_6("instructions to be executed:\n" . join "\n", @exec_cmd);
604              
605 0         0 my $brew = $bcmd->brew;
606              
607 0 0       0 if ($self->{args}{on}){
608 0         0 my $vers = join ',', @{ $self->{args}{on} };
  0         0  
609 0         0 $log->_5("versions to run on: $vers");
610              
611 0         0 my $wfh = File::Temp->new(UNLINK => 1);
612 0         0 my $fname = $wfh->filename;
613              
614 0         0 $log->_6("created temp file for storing output: $fname");
615              
616 0 0       0 open $wfh, '>', $fname or croak $!;
617 0         0 for (@exec_cmd){
618 0         0 s/\n//g;
619             }
620 0         0 my $cmd = join ' && ', @exec_cmd;
621 0         0 $cmd = "system(\"$cmd\")";
622 0         0 print $wfh $cmd;
623 0         0 close $wfh;
624              
625 0         0 $self->_dzil_shim($fname);
626 0         0 $log->_5("exec'ing: $brew exec --with $vers " . join ', ', @exec_cmd);
627              
628 0         0 my $ret
629             = `$brew exec --with $vers perl $fname 2>$self->{tempdir}/stderr.bblog`;
630              
631 0         0 $self->_dzil_unshim;
632              
633 0         0 return $ret;
634             }
635             else {
636              
637 0 0       0 if ($bcmd->is_win){
638              
639             # all of this because berrybrew doesn't get the path right
640             # when calling ``berrybrew exec perl ...''
641              
642 0         0 my %res_hash;
643              
644 0         0 $self->_dzil_shim;
645              
646 0         0 for (@exec_cmd){
647 0         0 $log->_5("exec'ing: $brew exec:\n". join ', ', @exec_cmd);
648 0         0 my $res = `$brew exec $_`;
649              
650 0         0 my @results = $res =~ /${ re_brewbuild('check_result') }/gsx;
  0         0  
651              
652 0         0 for (@results){
653 0 0       0 if ($_ =~ /${ re_brewbuild('extract_result') }/gsx){
  0         0  
654 0         0 push @{ $res_hash{$1} }, $2;
  0         0  
655             }
656             }
657             }
658              
659 0         0 $self->_dzil_unshim;
660              
661 0         0 my $result;
662              
663 0         0 for (keys %res_hash){
664 0         0 $result .= $_ . join '', @{ $res_hash{$_} };
  0         0  
665             }
666              
667 0         0 return $result;
668             }
669             else {
670 0         0 my $wfh = File::Temp->new(UNLINK => 1);
671 0         0 my $fname = $wfh->filename;
672              
673 0         0 $log->_6("created temp file for storing output: $fname");
674              
675 0 0       0 open $wfh, '>', $fname or croak $!;
676 0         0 for (@exec_cmd){
677 0         0 s/\n//g;
678             }
679 0         0 my $cmd = join ' && ', @exec_cmd;
680 0         0 $cmd = "system(\"$cmd\")";
681 0         0 print $wfh $cmd;
682 0         0 close $wfh;
683              
684 0         0 $self->_dzil_shim($fname);
685              
686 0         0 my $ret = `$brew exec perl $fname 2>$self->{tempdir}/stderr.bblog`;
687              
688 0         0 $self->_dzil_unshim;
689              
690 0         0 return $ret;
691             }
692             }
693             }
694             sub _dzil_shim {
695             # shim for working on Dist::Zilla modules
696              
697 0     0   0 my ($self, $cmd_file) = @_;
698              
699             # return early if possible
700              
701 0 0 0     0 return if -e 'Build.PL' || -e 'Makefile.PL';
702 0 0       0 return if ! -e 'dist.ini';
703              
704 0         0 my $log = $log->child('_dzil_shim');
705 0         0 $log->_5("dzil dist... loading the shim");
706              
707 0 0       0 my $path_sep = $self->is_win ? ';' : ':';
708              
709 0 0       0 if (! grep {-x "$_/dzil"} split /$path_sep/, $ENV{PATH} ){
  0         0  
710 0         0 $log->fatal(
711             "this appears to be a Dist::Zilla module, but the dzil binary " .
712             "can't be found\n"
713             );
714             }
715              
716 0         0 $self->{is_dzil} = 1;
717              
718 0 0       0 open my $fh, '<', 'dist.ini' or croak $!;
719              
720 0         0 my ($dist, $version);
721              
722 0         0 while (<$fh>){
723 0 0       0 if (/${ re_brewbuild('extract_dzil_dist_name') }/){
  0         0  
724 0         0 $dist = $1;
725             }
726 0 0       0 if (/${ re_brewbuild('extract_dzil_dist_version') }/){
  0         0  
727 0         0 $version = $1;
728             }
729 0 0 0     0 last if $dist && $version;
730             }
731              
732 0         0 $log->_7("running dzil commands: 'dzil authordeps --missing | cpanm', " .
733             "'dzil build'"
734             );
735              
736 0         0 `dzil authordeps --missing | cpanm`;
737 0         0 `dzil clean`;
738 0         0 `dzil build`;
739              
740 0         0 my $dir = "$dist-$version";
741 0 0       0 copy $cmd_file, $dir if defined $cmd_file;
742 0         0 chdir $dir;
743 0         0 $log->_7("entered $dir directory");
744             }
745             sub _dzil_unshim {
746             # unshim after doing dzil work
747              
748 0     0   0 my $self = shift;
749              
750 0         0 my $log = $log->child('_dzil_unshim');
751              
752 0 0       0 if (! $self->{is_dzil}){
753 0         0 $log->_7("not a dzil distribution; nothing to do");
754 0         0 return;
755             }
756              
757 0         0 $log->_5("removing dzil shim");
758              
759 0         0 $self->{is_dzil} = 0;
760 0         0 chdir '..';
761 0         0 $log->_7("changed to '..' dir");
762             }
763             sub _get_revdeps {
764 0     0   0 my ($self, $module) = @_;
765              
766 0         0 load 'MetaCPAN::Client';
767              
768 0         0 my $mcpan = MetaCPAN::Client->new;
769              
770 0         0 my $rs = $mcpan->reverse_dependencies($module);
771              
772 0         0 my @revdeps;
773              
774 0         0 while (my $release = $rs->next){
775 0         0 push @revdeps, $release->distribution;
776             }
777              
778 0         0 @revdeps = grep {$_ ne 'Test-BrewBuild'} @revdeps;
  0         0  
779              
780 0         0 for (@revdeps){
781 0         0 s/-/::/g;
782             }
783              
784 0         0 return @revdeps;
785             }
786             sub _process_stderr {
787             # compile data written to STDERR
788              
789 0     0   0 my $self = shift;
790            
791 0         0 my $errlog = "$self->{tempdir}/stderr.bblog";
792              
793 0 0       0 if (-e $errlog){
794 0 0       0 open my $errlog_fh, '<', $errlog or croak $!;
795            
796 0         0 my $error_contents;
797             {
798 0         0 local $/ = undef;
  0         0  
799 0         0 $error_contents = <$errlog_fh>;
800             }
801 0         0 close $errlog_fh;
802              
803 0         0 my @errors = $error_contents =~ /${ re_brewbuild('extract_errors') }/g;
  0         0  
804              
805 0         0 my %error_map;
806              
807 0         0 for (@errors){
808 0 0       0 if (/${ re_brewbuild('extract_error_perl_ver') }/){
  0         0  
809 0         0 $error_map{$1} = $_;
810             }
811             }
812            
813 0 0       0 if (! keys %error_map){
814 0         0 $error_map{0} = $error_contents;
815             }
816 0         0 return %error_map;
817             }
818             }
819             sub _save_reports {
820             # save FAIL and optionally PASS report logs
821              
822 0     0   0 my ($self, $ver, $status, $result) = @_;
823              
824 0 0 0     0 if ($status ne 'FAIL' && ! $self->{args}{save_reports}){
825 0         0 return;
826             }
827              
828 0         0 my $tested_mod = $self->{args}{plugin_arg};
829              
830 0 0       0 if (defined $tested_mod){
831 0         0 $tested_mod =~ s/::/-/g;
832 0         0 my $report = "$self->{tempdir}/$tested_mod-$ver-$status.bblog";
833 0 0       0 open my $wfh, '>', $report, or croak $!;
834              
835 0         0 print $wfh $result;
836              
837 0 0       0 if (! $self->is_win){
838 0         0 my %errors = $self->_process_stderr;
839              
840 0 0       0 if (defined $errors{0}){
841 0         0 print $wfh "\nCPANM ERROR LOG\n";
842 0         0 print $wfh "===============\n";
843 0         0 print $wfh $errors{0};
844             }
845             else {
846 0         0 for (keys %errors){
847 0 0       0 if (version->parse($_) == version->parse($ver)){
848 0         0 print $wfh "\nCPANM ERROR LOG\n";
849 0         0 print $wfh "===============\n";
850 0         0 print $wfh $errors{$_};
851             }
852             }
853             }
854             }
855 0         0 close $wfh;
856 0         0 $self->_attach_build_log($report);
857             }
858             else {
859 0         0 my $report = "$self->{tempdir}/$ver-$status.bblog";
860 0 0       0 open my $wfh, '>', $report or croak $!;
861 0         0 print $wfh $result;
862              
863 0 0       0 if (! $self->is_win){
864 0         0 my %errors = $self->_process_stderr;
865 0         0 for (keys %errors){
866 0 0       0 if (version->parse($_) == version->parse($ver)){
867 0         0 print $wfh "\nCPANM ERROR LOG\n";
868 0         0 print $wfh "===============\n";
869 0         0 print $wfh $errors{$_};
870             }
871             }
872             }
873 0         0 close $wfh;
874 0 0       0 $self->_attach_build_log($report) if ! $self->is_win;
875             }
876             }
877             sub _set_plugin {
878             # import the exec plugin
879              
880 9     9   18 my $self = shift;
881 9         33 my $log = $log->child('_set_plugin');
882             my $plugin = $self->{args}{plugin}
883             ? $self->{args}{plugin}
884 9 50       263 : $ENV{TBB_PLUGIN};
885              
886 9 50       62 $log->_5("plugin param set to: " . defined $plugin ? $plugin : 'default');
887              
888 9         902 $plugin = $self->plugins($plugin, can => ['brewbuild_exec']);
889              
890 9         692 my $exec_plugin_sub = $plugin .'::brewbuild_exec';
891 9         42 $self->{exec_plugin} = \&$exec_plugin_sub;
892              
893 9         59 $log->_4("successfully loaded $plugin plugin");
894             }
895             sub _validate_opts {
896             # validate command line arguments
897              
898 0     0     my $args = shift;
899              
900 0           my @valid_args = qw(
901             on o new n remove r revdep R plugin p args a debug d install i help h
902             N notest setup s legacy l selftest T t testers S save D dispatch X
903             nocache
904             );
905              
906 0           my $bad_opt = 0;
907 0           my $i;
908 0 0         if (@$args) {
909 0           my @params = grep {++$i % 2 != 0} @$args;
  0            
910 0           for my $arg (@params) {
911 0           $arg =~ s/^-{1,2}//g;
912 0 0         if (!grep { $arg eq $_ } @valid_args) {
  0            
913 0           $bad_opt = 1;
914 0           last;
915             }
916             }
917             }
918 0           return $bad_opt;
919             }
920              
921             1;
922              
923             =head1 NAME
924              
925             Test::BrewBuild - Perl/Berry brew unit testing automation, with remote tester
926             dispatching capabilities.
927              
928             =head1 DESCRIPTION
929              
930             This module is the backend for the C script that is accompanied by
931             this module.
932              
933             For end-user use, see
934             L.
935             You can also read the documentation for the network dispatcher
936             L,
937             the remote test listener
938             L,
939             or browse through the L for network testing.
940              
941             This module provides you the ability to perform your unit tests across all of
942             your L (Unix) or L
943             (Windows) Perl instances.
944              
945             For Windows, you'll need to install B>,
946             and for Unix, you'll need B>.
947              
948             It allows you to remove and reinstall on each test run, install random versions
949             of perl, or install specific versions.
950              
951             All unit tests are run against all installed instances, unless specified
952             otherwise.
953              
954             =head1 SYNOPSIS
955              
956             use Test::BrewBuild;
957              
958             my $bb = Test::BrewBuild->new;
959              
960             my @perls_available = $bb->perls_available;
961             my @perls_installed = $bb->perls_installed;
962              
963             # remove all currently installed instances of perl, less the one you're
964             # using
965              
966             $bb->instance_remove;
967              
968             # install four new random versions of perl
969              
970             $bb->instance_install(4);
971              
972             # install two specific versions
973              
974             $bb->instance_install(['5.10.1', '5.20.3']);
975              
976             # install all instances
977              
978             $bb->instance_install(-1);
979              
980             # find and test against all the current module's reverse CPAN dependencies
981              
982             $bb->revdep;
983              
984             # run the unit tests of the current module only
985              
986             $bb->test;
987              
988             =head1 METHODS
989              
990              
991              
992             =head2 new(%args)
993              
994             Returns a new C object. See the documentation for the
995             L
996             script to understand what the arguments are and do.
997              
998             Many of the options can be saved in a configuration file if you want to set them
999             permanently, or override defaults. Options passed into the various methods will
1000             override those in the configuration file.
1001             See L.
1002              
1003             =head2 brew_info
1004              
1005             Returns in string form the full output of C<*brew available>.
1006              
1007             =head2 perls_available
1008              
1009             Returns an array containing all perls available, whether already installed or
1010             not.
1011              
1012             =head2 perls_installed
1013              
1014             Returns an array of the names of all perls currently installed under your
1015             C<*brew> setup.
1016              
1017             =head2 instance_install
1018              
1019             If an integer is sent in, we'll install that many random versions of perl. If
1020             the integer is C<-1>, we'll install all available versions. You can also send in
1021             an array reference, where each element is a version of perl, and we'll install
1022             those instead.
1023              
1024             You can send a second parameter, an integer for a time out. On each install,
1025             we'll bail if it takes longer than this time. Default is 300 seconds. If you're
1026             on a fast machine, you should probably lower this value.
1027              
1028             On Windows, where you want to install specific perls, we'll default to
1029             installing 64-bit versions only, if a 64 bit perl is available for the version
1030             desired and you haven't added the C<_64/_32> suffix per C.
1031              
1032             Simply add the C<_32> suffix if you want to install it specifically. Note that
1033             if you're dispatching to Unix and Windows servers, the Unix systems will remove
1034             this invalid portion of the version prior to processing further.
1035              
1036             =head2 instance_remove
1037              
1038             Uninstalls all currently installed perls, less the one you are currently
1039             Ced or Cd to.
1040              
1041             =head2 test
1042              
1043             Processes and returns the test results as a string scalar of the distribution
1044             located in the current working directory.
1045              
1046             =head2 revdeps
1047              
1048             Returns a list of the reverse dependencies (according to CPAN) that the module
1049             you're working on in the current working directory have.
1050              
1051             =head2 revdep
1052              
1053             Loops over all of the current module's reverse dependencies, and executes
1054             C on each one at a time. This helps you confirm whether your new build
1055             won't break your downstream users' modules.
1056              
1057             =head2 legacy
1058              
1059             By default, we don't install perl versions less than v5.8.9. Pass in a true
1060             value to override this default.
1061              
1062             =head2 options(\%args)
1063              
1064             Takes a hash reference of the command-line argument list, and converts it into
1065             a hash of the translated C parameters along with their values.
1066              
1067             Returns the converted hash for passing back into C.
1068              
1069             If an invalid argument is included, we'll set C<$args{error} = 1;>. It is up to
1070             the caller to look for and process an error handling routine.
1071              
1072             =head2 config_file
1073              
1074             Returns a string that contains the path/filename of the configuration file, if
1075             available.
1076              
1077             =head2 plugin('Module::Name')
1078              
1079             Fetches and installs a custom plugin which contains the code that
1080             C will execute. If not used or the module specified
1081             can't be located (or it contains errors), we fall back to the default bundled
1082             L (which is the canonical example for
1083             writing new plugins).
1084              
1085             Note that you can send in a custom plugin C<*.pm> filename to plugin as opposed
1086             to a module name if the module isn't installed. If the file isn't in the
1087             current working directory, send in the relative or full path.
1088              
1089             =head2 is_win
1090              
1091             Helper method, returns true if the current OS is Windows, false if not.
1092              
1093             =head2 log
1094              
1095             Returns an instance of the packages log object for creating child log objects.
1096              
1097             =head2 tempdir
1098              
1099             Sets up the object with a temporary directory used for test logs, that will be
1100             removed after the run.
1101              
1102             =head2 workdir
1103              
1104             Returns the brewbuild working directory.
1105              
1106             =head2 setup
1107              
1108             Prints out detailed information on setting up a testing environment, on Windows
1109             and Unix.
1110              
1111             =head2 help
1112              
1113             Displays the C command line usage information.
1114              
1115             =head1 TROUBLESHOOTING
1116              
1117             =head2 Installation Issues
1118              
1119             On some Linux variants, not all of the software required for SSL is installed.
1120              
1121             If you have install failures (reading the `cpanm` build log often complains
1122             about L failing), try running the following command line
1123             commands, then re-run C:
1124              
1125             sudo apt-get install libssl-dev
1126             sudo apt-get install libz-dev
1127              
1128             =head1 AUTHOR
1129              
1130             Steve Bertrand, C<< >>
1131              
1132             =head1 SEE ALSO
1133              
1134             Berrybrew for Windows:
1135              
1136             L
1137              
1138             Perlbrew for Unixes:
1139              
1140             L
1141              
1142             =head1 LICENSE AND COPYRIGHT
1143              
1144             Copyright 2017 Steve Bertrand.
1145              
1146             This program is free software; you can redistribute it and/or modify it
1147             under the terms of either: the GNU General Public License as published
1148             by the Free Software Foundation; or the Artistic License.
1149              
1150             See L for more information.
1151              
1152             =cut
1153              
1154             1;
1155              
1156             __DATA__