File Coverage

blib/lib/App/pfswatch.pm
Criterion Covered Total %
statement 53 88 60.2
branch 16 46 34.7
condition 5 9 55.5
subroutine 13 16 81.2
pod 0 5 0.0
total 87 164 53.0


line stmt bran cond sub pod time code
1             package App::pfswatch;
2              
3 4     4   85622 use strict;
  4         13  
  4         136  
4 4     4   21 use warnings;
  4         7  
  4         104  
5 4     4   87 use 5.008_001;
  4         18  
  4         127  
6 4     4   3699 use Pod::Usage;
  4         254555  
  4         604  
7 4     4   5078 use Getopt::Long;
  4         44549  
  4         25  
8 4     4   4068 use POSIX qw(:sys_wait_h);
  4         26436  
  4         25  
9 4     4   8940 use Filesys::Notify::Simple;
  4         8599  
  4         102  
10 4     4   25 use Carp ();
  4         33  
  4         3615  
11              
12             our $VERSION = '0.08';
13              
14             sub new {
15 4     4 0 3301 my $class = shift;
16 4         14 my %opts = @_;
17 0         0 my %args = (
18             path => _is_arrayref( $opts{path} )
19 4 50       22 ? [ sort @{ $opts{path} } ]
    100          
    50          
    50          
20             : ['.'],
21             exec => _is_arrayref( $opts{exec} ) ? $opts{exec} : undef,
22             quiet => delete $opts{quiet} ? 1 : 0,
23             pipe => delete $opts{pipe} ? 1 : 0,
24             );
25              
26 4 100       21 unless ( $args{exec} ) {
27 1 50       5 my $type
    50          
28             = ref $opts{exec} ? ref $opts{exec}
29             : defined $opts{exec} ? $opts{exec}
30             : 'undef';
31 1         173 Carp::croak(
32             "Mandatory parameter 'exec' does not pass the type constraint because: Validation failed for Array with value $type"
33             );
34             }
35              
36 3         15 bless \%args, $class;
37             }
38              
39             sub new_with_options {
40 1     1 0 2764 my $klass = shift;
41 1   33     9 my $class = ref $klass || $klass;
42              
43 1         7 my %opts = $class->parse_argv(@_);
44 1 50 33     8 if ( $opts{help} or scalar @{ $opts{exec} } == 0 ) {
  1         6  
45 0         0 pod2usage();
46             }
47              
48             $class->new(
49 1 50       10 path => $opts{path},
    50          
50             exec => $opts{exec},
51             quiet => $opts{quiet} ? 1 : 0,
52             pipe => $opts{pipe} ? 1 : 0,
53             );
54             }
55              
56             sub run {
57 0     0 0 0 my $self = shift;
58              
59 0         0 local $| = 1;
60              
61 0         0 my @path = @{ $self->{path} };
  0         0  
62 0 0       0 warn sprintf "Start watching %s\n", join ',', @path
63             unless $self->{quiet};
64              
65 0         0 my $watcher = Filesys::Notify::Simple->new( \@path );
66 0         0 my $cb = $self->_child_callback($watcher);
67              
68             LOOP:
69 0 0       0 if ( my $pid = fork ) {
    0          
70 0         0 waitpid( $pid, 0 );
71 0         0 goto LOOP;
72             }
73             elsif ( $pid == 0 ) {
74              
75             # child
76 0         0 $watcher->wait($cb);
77             }
78             else {
79 0         0 die "cannot fork: $!";
80             }
81             }
82              
83             sub _child_callback {
84 0     0   0 my $self = shift;
85 0         0 my $watcher = shift;
86              
87 0         0 my @cmd = @{ $self->{exec} };
  0         0  
88 0         0 my $ignored_pattern = $self->ignored_pattern;
89              
90             sub {
91 0     0   0 my @events = @_;
92 0         0 my @files;
93 0         0 for my $e (@events) {
94 0 0       0 warn sprintf "[PFSWATCH_DEBUG] Path:%s\n", $e->{path}
95             if $ENV{PFSWATCH_DEBUG};
96 0 0       0 if ( $e->{path} !~ $ignored_pattern ) {
97 0         0 push @files, $e->{path};
98 0         0 last;
99             }
100             }
101 0 0       0 if ( scalar @files > 0 ) {
102 0 0       0 warn sprintf "exec %s\n", join ' ', @cmd
103             unless $self->{quiet};
104 0 0       0 if ( $self->{pipe} ) {
105 0 0       0 open my $child_stdin, "|-", @cmd
106             or die $!;
107 0         0 print $child_stdin @files;
108 0 0       0 close $child_stdin or die $!;
109 0         0 exit 0;
110             }
111             else {
112 0 0       0 exec @cmd or die $!;
113             }
114             }
115 0         0 };
116             }
117              
118             sub parse_argv {
119 6     6 0 4646 my $class = shift;
120 6         18 local @ARGV = @_;
121              
122 6         43 my $p = Getopt::Long::Parser->new( config => ['pass_through'] );
123 6         408 $p->getoptions( \my %opts, 'pipe', 'quiet', 'help|h' );
124              
125 6         1820 my ( @path, @cmd );
126 6         23 my $exec_re = qr/^-(e|-exec)$/i;
127 6         24 while ( my $arg = shift @ARGV ) {
128 8 100       49 if ( $arg =~ $exec_re ) {
129 3         18 @cmd = splice @ARGV, 0, scalar @ARGV;
130             }
131             else {
132 5         16 push @path, $arg;
133             }
134             }
135 6         15 $opts{path} = \@path;
136 6         10 $opts{exec} = \@cmd;
137              
138 6         58 return %opts;
139             }
140              
141             my @DEFAULT_IGNORED = (
142             '', # dotfile
143             );
144              
145             sub ignored_pattern {
146 1     1 0 14 qr{^.*/\..+$}; #dotfile
147             }
148              
149             sub _is_arrayref {
150 8     8   14 my $v = shift;
151 8 100 100     95 $v && ref $v eq 'ARRAY' && scalar @$v > 0 ? 1 : 0;
152             }
153              
154             1;
155             __END__