local-lib5/lib/perl5/File/ChangeNotify/Watcher/Default.pm

   1 package File::ChangeNotify::Watcher::Default;
   2
   3 use strict;
   4 use warnings;
   5
   6 our $VERSION = '0.11';
   7
   8 use File::Find qw( finddepth );
   9 use File::Spec;
  10 use Time::HiRes qw( sleep );
  11
  12 # Trying to import this just blows up on Win32, and checking
  13 # Time::HiRes::d_hires_stat() _also_ blows up on Win32.
  14 BEGIN {
  15     eval { Time::HiRes->import('stat') };
  16 }
  17
  18 use Moose;
  19 use MooseX::SemiAffordanceAccessor;
  20
  21 extends 'File::ChangeNotify::Watcher';
  22
  23 has _map => (
  24     is      => 'rw',
  25     isa     => 'HashRef',
  26     default => sub { {} },
  27 );
  28
  29 sub sees_all_events {0}
  30
  31 sub BUILD {
  32     my $self = shift;
  33
  34     $self->_set_map( $self->_build_map() );
  35 }
  36
  37 sub _build_map {
  38     my $self = shift;
  39
  40     my %map;
  41
  42     File::Find::find(
  43         {
  44             wanted => sub {
  45                 my $path = $File::Find::name;
  46
  47                 if ( $self->_path_is_excluded($path) ) {
  48                     $File::Find::prune = 1;
  49                     return;
  50                 }
  51
  52                 my $entry = $self->_entry_for_map($path) or return;
  53                 $map{$path} = $entry;
  54             },
  55             follow_fast => ( $self->follow_symlinks() ? 1 : 0 ),
  56             no_chdir => 1
  57         },
  58         @{ $self->directories() },
  59     );
  60
  61     return \%map;
  62 }
  63
  64 sub _entry_for_map {
  65     my $self = shift;
  66     my $path = shift;
  67
  68     my $is_dir = -d $path ? 1 : 0;
  69
  70     return if -l $path && !$is_dir;
  71
  72     unless ($is_dir) {
  73         my $filter = $self->filter();
  74         return unless ( File::Spec->splitpath($path) )[2] =~ /$filter/;
  75     }
  76
  77     return {
  78         is_dir => $is_dir,
  79         mtime  => _mtime(*_),
  80         size   => ( $is_dir ? 0 : -s _ ),
  81     };
  82 }
  83
  84 # It seems that Time::HiRes's stat does not act exactly like the
  85 # built-in, so if I do ( stat _ )[9] it will not work (grr).
  86 sub _mtime {
  87     my @stat = stat;
  88
  89     return $stat[9];
  90 }
  91
  92 sub wait_for_events {
  93     my $self = shift;
  94
  95     while (1) {
  96         my @events = $self->_interesting_events();
  97         return @events if @events;
  98
  99         sleep $self->sleep_interval();
 100     }
 101 }
 102
 103 sub _interesting_events {
 104     my $self = shift;
 105
 106     my @interesting;
 107
 108     my $old_map = $self->_map();
 109     my $new_map = $self->_build_map();
 110
 111     for my $path ( sort keys %{$old_map} ) {
 112         if ( !exists $new_map->{$path} ) {
 113             if ( $old_map->{$path}{is_dir} ) {
 114                 $self->_remove_directory($path);
 115             }
 116
 117             push @interesting, $self->event_class()->new(
 118                 path => $path,
 119                 type => 'delete',
 120             );
 121         }
 122         elsif (
 123             !$old_map->{$path}{is_dir}
 124             && (   $old_map->{$path}{mtime} != $new_map->{$path}{mtime}
 125                 || $old_map->{$path}{size} != $new_map->{$path}{size} )
 126             ) {
 127             push @interesting, $self->event_class()->new(
 128                 path => $path,
 129                 type => 'modify',
 130             );
 131         }
 132     }
 133
 134     for my $path ( sort grep { !exists $old_map->{$_} } keys %{$new_map} ) {
 135         if ( -d $path ) {
 136             push @interesting, $self->event_class()->new(
 137                 path => $path,
 138                 type => 'create',
 139                 ),
 140                 ;
 141         }
 142         else {
 143             push @interesting, $self->event_class()->new(
 144                 path => $path,
 145                 type => 'create',
 146             );
 147         }
 148     }
 149
 150     $self->_set_map($new_map);
 151
 152     return @interesting;
 153 }
 154
 155 no Moose;
 156
 157 __PACKAGE__->meta()->make_immutable();
 158
 159 1;
 160
 161 __END__
 162
 163 =head1 NAME
 164
 165 File::ChangeNotify::Watcher::Default - Fallback default watcher subclass
 166
 167 =head1 DESCRIPTION
 168
 169 This class implements watching by comparing two snapshots of the filesystem
 170 tree. It if inefficient and dumb, and so it is the subclass of last resort.
 171
 172 Its C<< $watcher->wait_for_events() >> method sleeps between
 173 comparisons of the filesystem snapshot it takes.
 174
 175 =head1 AUTHOR
 176
 177 Dave Rolsky, E<lt>autarch@urth.orgE<gt>
 178
 179 =head1 COPYRIGHT & LICENSE
 180
 181 Copyright 2009 Dave Rolsky, All Rights Reserved.
 182
 183 This program is free software; you can redistribute it and/or modify
 184 it under the same terms as Perl itself.
 185
 186 =cut