File Coverage

script/prowess
Criterion Covered Total %
statement 52 52 100.0
branch 10 14 71.4
condition 6 8 75.0
subroutine 9 9 100.0
pod n/a
total 77 83 92.7


line stmt bran cond sub pod time code
1             #!/usr/bin/env perl
2 3     3   26360 use strict;
  3         7  
  3         88  
3 3     3   13 use warnings;
  3         6  
  3         91  
4 3     3   2914 use App::Prove;
  3         181945  
  3         92  
5 3     3   2341 use Filesys::Notify::Simple;
  3         6077  
  3         105  
6 3   50 3   17 use constant DEBUG => $ENV{PROWESS_DEBUG} || 0;
  3         4  
  3         1919  
7              
8             sub parse_argv {
9 6     6   780 my $self = shift;
10 6         8 my (@prove, @watch);
11              
12 6         35 while (defined(my $k = shift @_)) {
13 11 100 66     164 if ($k eq '-w' and @_ and -d $_[0]) {
      100        
14 5         29 push @watch, shift;
15             }
16             else {
17 6         24 push @prove, $k;
18             }
19             }
20              
21 6 100       20 @watch = grep { -d $_ } qw( bin lib script t xt ) unless @watch;
  5         68  
22              
23 6         11 warn '[prowess] watching ', join(', ', @watch), "\n" if DEBUG;
24 6         48 return {prove => \@prove, watch => \@watch};
25             }
26              
27             sub run_prove {
28 3     3   6 my ($self, $args) = @_;
29 3         28 my $prove = App::Prove->new;
30              
31 3         373 $prove->process_args(@$args);
32              
33 3 50       11972 defined(my $pid = fork) or die "fork: $!";
34 3 50       121 exit exit($prove->run ? 0 : 1) unless $pid; # child
    100          
35 2         13 warn "[prowess] prove @$args ($pid)\n" if DEBUG;
36 2         83 return $pid;
37             }
38              
39             sub run {
40 3     3   1464 my $self = shift;
41 3         18 my $args = $self->parse_argv(@_);
42 3         26 my $watcher = Filesys::Notify::Simple->new($args->{watch});
43 3         1564 my $exit = 0;
44              
45 3         5 while (1) {
46 3         15 my $pid = $self->run_prove($args->{prove});
47 2         45 eval {
48             # Try to capture:
49             # kevent error: Interrupt innerhalb eines Systemaufrufs at /usr/perl5.20.0/lib/site_perl/5.20.0/Filesys/Notify/KQueue.pm line 114.
50             $watcher->wait(
51             sub {
52 2 50   2   593559 return unless my @changed = grep { !-d $_ } map { $_->{path} } @_;
  2         70  
  2         16  
53 2         9 warn "[prowess] changed: @changed\n" if DEBUG;
54 2         35 my $kill = kill TERM => $pid;
55 2         3 warn "[prowess] kill TERM $pid\n" if DEBUG and $kill;
56 2         1196 waitpid $pid, 0;
57 2         13 $exit = $? >> 8;
58 2         15 warn "[prowess] prove \$?=$exit\n" if DEBUG;
59             }
60 2         195 );
61             };
62 2         16 warn "# $@" if DEBUG;
63 2 50       16 last if $ENV{PROWESS_ONCE};
64             }
65              
66 2         108 return $exit;
67             }
68              
69             my $prowess = bless {}, __PACKAGE__;
70             exit $prowess->run(@ARGV) unless defined wantarray;
71             return $prowess;