File Coverage

blib/lib/App/Prun.pm
Criterion Covered Total %
statement 17 39 43.5
branch 0 10 0.0
condition n/a
subroutine 6 12 50.0
pod 0 4 0.0
total 23 65 35.3


line stmt bran cond sub pod time code
1 2     2   133866 use strict;
  2         9  
  2         56  
2 2     2   9 use warnings;
  2         4  
  2         88  
3             package App::Prun;
4             $App::Prun::VERSION = '1.10';
5 2     2   1708 use Moo;
  2         25702  
  2         11  
6 2     2   4798 use Storable qw( freeze ); # to support testing
  2         3313  
  2         175  
7 2     2   1066 use namespace::clean;
  2         27355  
  2         14  
8              
9 2     2   563 use 5.010;
  2         7  
10              
11             has pm => ( is => 'ro', required => 1 );
12             has report_failed_procs => ( is => 'ro', default => 1 );
13             has exit_on_failed_proc => ( is => 'ro', default => 0 );
14              
15             sub BUILD {
16 0     0 0   my $self = shift;
17 0     0     $self->pm->run_on_finish(sub{ $self->on_finish_callback(@_) });
  0            
18 0           $self->pm->set_waitpid_blocking_sleep(0);
19             }
20              
21             sub on_finish_callback {
22 0     0 0   my $self = shift;
23 0           my ($pid, $rc, $id, $sig, $core, $ref) = @_;
24              
25 0 0         if ($rc) {
26 0 0         print STDERR "[$pid] Command '$id' failed with exit code $rc\n"
27             if $self->report_failed_procs;
28              
29 0 0         return unless $self->exit_on_failed_proc;
30              
31 0           $self->pm->wait_all_children;
32 0           exit 1;
33             }
34             }
35              
36             sub run_command {
37 0     0 0   my $self = shift;
38 0           my $cmd = shift;
39              
40 0           chomp $cmd;
41              
42             # Skip blank lines and comments
43 0 0         return if (/^\s*(#|$)/);
44              
45 0 0         $self->pm->start($cmd) and return;
46              
47             # In the child now
48              
49 0           my $rc = system($cmd);
50 0           $self->pm->finish($rc >> 8);
51             }
52              
53 0     0 0   sub done { shift->pm->wait_all_children }
54              
55             sub _test_dump {
56 0     0     $Storable::forgive_me = 1;
57 0           print freeze(shift);
58 0           exit 255;
59             }
60              
61             # ABSTRACT: Provides the prun script as a command line interface to L.
62             1;
63              
64             __END__