File Coverage

blib/lib/Test/BrewBuild.pm
Criterion Covered Total %
statement 155 516 30.0
branch 33 174 18.9
condition 3 21 14.2
subroutine 33 52 63.4
pod 18 18 100.0
total 242 781 30.9


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