File Coverage

script/prowess

Criterion	Covered	Total	%
statement	54	54	100.0
branch	11	16	68.7
condition	7	11	63.6
subroutine	9	9	100.0
pod			n/a
total	81	90	90.0

#!/usr/bin/env perl
use strict;
use warnings;
use App::Prove;
use Filesys::Notify::Simple;
use constant DEBUG => $ENV{PROWESS_DEBUG} || 0;

sub parse_argv {
  my $self = shift;
  my (@prove, @watch);

  while (defined(my $k = shift @_)) {
    if ($k eq '-w' and @_ and -d $_[0]) {
      push @watch, shift;
    }
    else {
      push @prove, $k;
    }
  }

  @watch = grep { -d $_ } qw( bin lib script t xt ) unless @watch;

  warn '[prowess] watching ', join(', ', @watch), "\n" if DEBUG;
  return {prove => \@prove, watch => \@watch};
}

sub run_prove {
  my ($self, $args) = @_;
  my $prove = App::Prove->new;

  $prove->process_args(@$args);

  defined(my $pid = fork) or die "fork: $!";
  exit exit($prove->run ? 0 : 1) unless $pid;    # child
  warn "[prowess] prove @$args ($pid)\n" if DEBUG;
  return $pid;
}

sub run {
  my $self    = shift;
  my $args    = $self->parse_argv(@_);
  my $watcher = Filesys::Notify::Simple->new($args->{watch});
  my $ignore  = qr{(?:/\.[^/]+$|\.bak$|\.old$|\.swp$|~$)};
  my @changed = (1);
  my $exit    = 0;

  while (1) {
    my $pid = @changed ? $self->run_prove($args->{prove}) : 0;
    eval {
      # Try to capture:
      # kevent error: Interrupt innerhalb eines Systemaufrufs at /usr/perl5.20.0/lib/site_perl/5.20.0/Filesys/Notify/KQueue.pm line 114.
      $watcher->wait(
        sub {
          return unless @changed = grep { !-d $_ && $_ !~ $ignore } map { $_->{path} } @_;
          warn "[prowess] changed: @changed\n" if DEBUG;
          my $kill = kill TERM => $pid;
          warn "[prowess] kill TERM $pid\n" if DEBUG and $kill;
          waitpid $pid, 0;
          $exit = $? >> 8;
          warn "[prowess] prove \$?=$exit\n" if DEBUG;
        }
      );
    };
    warn "# $@" if DEBUG;
    last if $ENV{PROWESS_ONCE};
  }

  return $exit;
}

my $prowess = bless {}, __PACKAGE__;
exit $prowess->run(@ARGV) unless defined wantarray;
return $prowess;