File Coverage

blib/lib/App/watchdo.pm
Criterion Covered Total %
statement 33 83 39.7
branch 0 14 0.0
condition 0 9 0.0
subroutine 11 19 57.8
pod 4 4 100.0
total 48 129 37.2


line stmt bran cond sub pod time code
1             package App::watchdo;
2              
3             # Created on: 2015-03-07 08:21:28
4             # Create by: Ivan Wills
5             # $Id$
6             # $Revision$, $HeadURL$, $Date$
7             # $Revision$, $Source$, $Date$
8              
9 1     1   110208 use Moo;
  1         8350  
  1         6  
10 1     1   1502 use warnings;
  1         3  
  1         29  
11 1     1   569 use version;
  1         1990  
  1         6  
12 1     1   82 use Carp;
  1         2  
  1         58  
13 1     1   630 use List::MoreUtils qw/uniq/;
  1         13625  
  1         6  
14 1     1   1728 use Data::Dumper qw/Dumper/;
  1         7027  
  1         79  
15 1     1   559 use English qw/ -no_match_vars /;
  1         3772  
  1         5  
16 1     1   1456 use AnyEvent;
  1         5760  
  1         36  
17 1     1   524 use AnyEvent::Loop;
  1         15293  
  1         37  
18 1     1   536 use AnyEvent::Filesys::Notify;
  1         240303  
  1         41  
19 1     1   892 use Path::Tiny;
  1         11989  
  1         871  
20              
21             our $VERSION = version->new('0.1.1');
22              
23             has [qw/git run done/] => ( is => 'rw' );
24             has [qw/dirs files exclude changed/] => (
25             is => 'rw',
26             default => sub {[]},
27             );
28             has wait => (
29             is => 'rw',
30             default => 1,
31             );
32             has vcs => (
33             is => 'rw',
34             lazy => 1,
35             default => sub {
36             require VCS::Which;
37             return VCS::Which->new;
38             },
39             );
40              
41             sub watch {
42 0     0 1   my ($self) = @_;
43              
44             my $notify = AnyEvent::Filesys::Notify->new(
45             dirs => [ $self->get_dirs ],
46             cb => sub {
47 0     0     my @changed = @_;
48 0           $self->changed([ @{ $self->changed }, @changed ]);
  0            
49              
50 0 0         if ( ! $self->done ) {
51 0           $self->done( AE::timer $self->wait, 0, sub { $self->doit() } );
  0            
52             }
53             },
54 0           parse_events => 1,
55             );
56              
57 0           return AnyEvent::Loop::run();
58             }
59              
60             sub doit {
61 0     0 1   my ($self) = @_;
62 0           my %files = map { $_ => 1 } $self->get_files();
  0            
63 0           my %dirs = map { $_ => 1 } @{ $self->dirs() };
  0            
  0            
64 0           my %seen;
65              
66             my @monitored;
67 0           for my $changed (@{ $self->changed() }) {
  0            
68 0           my $path = $changed->path;
69             push @monitored, $changed if (
70             !$seen{$path}++
71             || $files{$path}
72             || $dirs{$path}
73             ) && (
74             ! @{ $self->exclude }
75 0 0 0       || ! grep { $path =~ /$_/ } @{ $self->exclude }
      0        
      0        
76             );
77             }
78              
79 0 0         $self->run()->(@monitored) if @monitored;
80 0           $self->done(undef);
81 0           $self->changed([]);
82             }
83              
84             sub get_dirs {
85 0     0 1   my ($self) = @_;
86              
87             return uniq sort +(
88 0 0         @{ $self->dirs || [] },
89 0           map {path($_)->parent . ''}
  0            
90             $self->get_files,
91             );
92             }
93              
94             sub get_files {
95 0     0 1   my ($self) = @_;
96              
97 0           return ( $self->_files_from_fs, $self->_files_from_git );
98             }
99              
100             sub _files_from_fs {
101 0     0     my ($self) = @_;
102              
103 0 0         return map { -d $_ ? _recurse($_) : $_ }
104 0           @{ $self->files };
  0            
105             }
106              
107             sub _files_from_git {
108 0     0     my ($self) = @_;
109              
110 0 0         return if !$self->git;
111              
112 0           my $status = $self->vcs->status('.');
113             return (
114 0           map { chomp $_; $_ } ## no critic
  0            
115 0           map { @{ $status->{$_} } }
  0            
116 0           grep { $_ ne 'merge' }
117 0           keys %{ $status }
  0            
118             );
119             }
120              
121             sub _recurse {
122 0     0     my $dir = path(shift);
123 0           my @files;
124              
125 0           for my $child ($dir->children) {
126 0 0         if (-d $child) {
127 0           push @files, _recurse($child);
128             }
129             else {
130 0           push @files, $child;
131             }
132             }
133              
134 0           return @files;
135             }
136              
137             1;
138              
139             __DATA__
140              
141             =head1 NAME
142              
143             App::watchdo - Run a command when watched files change
144              
145             =head1 VERSION
146              
147             This documentation refers to App::watchdo version 0.1.1
148              
149             =head1 SYNOPSIS
150              
151             watch-do [option]
152             watch-do -w file1 [-w file2 ...] [--] cmd
153              
154             OPTIONS:
155             cmd Command to run when file changes
156             -w --watch[=]file File to be watched for changes
157             -g --git Use git to find what to watch (ie monitor files that git see have changed)
158              
159             -v --verbose Show more detailed option
160             --version Prints the version information
161             --help Prints this help information
162             --man Prints the full documentation for watch-do
163              
164             =head1 DESCRIPTION
165              
166             =head1 SUBROUTINES/METHODS
167              
168             =over 4
169              
170             =item C<doit ()>
171              
172             Runs the requested command when a file has changed
173              
174             =item C<get_dirs ()>
175              
176             Gets the unique list of directories to look in
177              
178             =item C<get_files ()>
179              
180             Gets all the files to be watched
181              
182             =item C<watch ()>
183              
184             Runs the event loop to watch for changes in files.
185              
186             =back
187              
188             =head1 ATTRIBUTES
189              
190             =over 4
191              
192             =item C<changed>
193              
194             Array of changed files
195              
196             =item C<done>
197              
198             Stores callback method for alerting of changed files
199              
200             =item C<dirs>
201              
202             Stores the directories that are being monitored
203              
204             =item C<files>
205              
206             Stores the files that are being monitored
207              
208             =item C<exclude>
209              
210             Stores a list of regexps of files that should not trigger changed events
211              
212             =item C<git>
213              
214             Flag for using git to find files that should be monitored
215              
216             =item C<run>
217              
218             The function to be called when file are changed
219              
220             =item C<wait>
221              
222             Time to wait for changes to settle to changed events are not filed too quickly
223              
224             =back
225              
226             =head1 DIAGNOSTICS
227              
228             =head1 CONFIGURATION AND ENVIRONMENT
229              
230             =head1 DEPENDENCIES
231              
232             =head1 INCOMPATIBILITIES
233              
234             =head1 BUGS AND LIMITATIONS
235              
236             There are no known bugs in this module.
237              
238             Please report problems to Ivan Wills (ivan.wills@gmail.com).
239              
240             Patches are welcome.
241              
242             =head1 AUTHOR
243              
244             Ivan Wills - (ivan.wills@gmail.com)
245              
246             =head1 LICENSE AND COPYRIGHT
247              
248             Copyright (c) 2014-2016 Ivan Wills (14 Mullion Close, Hornsby Heights, NSW Australia 2077).
249             All rights reserved.
250              
251             This module is free software; you can redistribute it and/or modify it under
252             the same terms as Perl itself. See L<perlartistic>. This program is
253             distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
254             without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
255             PARTICULAR PURPOSE.
256              
257             =cut