1package POE::Component::DirWatch; 2 3our $VERSION = "0.300004"; 4 5use POE; 6use Moose; 7use Class::Load; 8use MooseX::Types::Path::Class qw/Dir/; 9 10sub import { 11 my ($class, %args) = @_; 12 return if delete $args{no_aio}; 13 return unless eval { Class::Load::load_class("POE::Component::AIO") }; 14 if (eval { Class::Load::load_class("POE::Component::DirWatch::Role::AIO") }){ 15 $class->meta->make_mutable; 16 POE::Component::DirWatch::Role::AIO->meta->apply($class->meta); 17 $class->meta->make_immutable; 18 } 19 return; 20} 21 22#--------#---------#---------#---------#---------#---------#---------#--------# 23 24has alias => ( 25 is => 'ro', 26 isa => 'Str', 27 required => 1, 28 default => 'dirwatch' 29); 30 31has directory => ( 32 is => 'rw', 33 isa => Dir, 34 required => 1, 35 coerce => 1 36); 37 38has interval => ( 39 is => 'rw', 40 isa => 'Int', 41 required => 1 42); 43 44has next_poll => ( 45 is => 'rw', 46 isa => 'Int', 47 clearer => 'clear_next_poll', 48 predicate => 'has_next_poll' 49); 50 51has filter => ( 52 is => 'rw', 53 isa => 'CodeRef', 54 clearer => 'clear_filter', 55 predicate => 'has_filter' 56); 57 58has dir_callback => ( 59 is => 'rw', 60 isa => 'Ref', 61 clearer => 'clear_dir_callback', 62 predicate => 'has_dir_callback' 63); 64 65has file_callback => ( 66 is => 'rw', 67 isa => 'Ref', 68 clearer => 'clear_file_callback', 69 predicate => 'has_file_callback' 70); 71 72sub BUILD { 73 my ($self, $args) = @_; 74 POE::Session->create( 75 object_states => [ 76 $self, 77 { 78 _start => '_start', 79 _pause => '_pause', 80 _resume => '_resume', 81 _child => '_child', 82 _stop => '_stop', 83 shutdown => '_shutdown', 84 poll => '_poll', 85 ($self->has_dir_callback ? (dir_callback => '_dir_callback') : () ), 86 ($self->has_file_callback ? (file_callback => '_file_callback') : () ), 87 }, 88 ] 89 ); 90} 91 92sub session { $poe_kernel->alias_resolve( shift->alias ) } 93 94#--------#---------#---------#---------#---------#---------#---------#--------- 95 96sub _start { 97 my ($self, $kernel) = @_[OBJECT, KERNEL]; 98 $kernel->alias_set($self->alias); # set alias for ourselves and remember it 99 $self->next_poll( $kernel->delay_set(poll => $self->interval) ); 100} 101 102sub _pause { 103 my ($self, $kernel, $until) = @_[OBJECT, KERNEL, ARG0]; 104 $kernel->alarm_remove($self->next_poll) if $self->has_next_poll; 105 $self->clear_next_poll; 106 return unless defined $until; 107 108 my $t = time; 109 $until += $t if $t > $until; 110 $self->next_poll( $kernel->alarm_set(poll => $until) ); 111 112} 113 114sub _resume { 115 my ($self, $kernel, $when) = @_[OBJECT, KERNEL, ARG0]; 116 $kernel->alarm_remove($self->next_poll) if $self->has_next_poll; 117 $self->clear_next_poll; 118 $when = 0 unless defined $when; 119 120 my $t = time; 121 $when += $t if $t > $when; 122 $self->next_poll( $kernel->alarm_set(poll => $when) ); 123} 124 125sub _stop {} 126 127sub _child {} 128 129#--------#---------#---------#---------#---------#---------#---------#--------- 130 131sub pause { 132 my ($self, $until) = @_; 133 $poe_kernel->call($self->alias, _pause => $until); 134} 135 136sub resume { 137 my ($self, $when) = @_; 138 $poe_kernel->call($self->alias, _resume => $when); 139} 140 141sub shutdown { 142 my ($self) = @_; 143 $poe_kernel->alarm_remove($self->next_poll) if $self->has_next_poll; 144 $self->clear_next_poll; 145 $poe_kernel->post($self->alias, 'shutdown'); 146} 147 148#--------#---------#---------#---------#---------#---------#---------#--------- 149 150sub _poll { 151 my ($self, $kernel) = @_[OBJECT, KERNEL]; 152 $self->clear_next_poll; 153 154 #just do this part once per poll 155 my $filter = $self->has_filter ? $self->filter : undef; 156 my $has_dir_cb = $self->has_dir_callback; 157 my $has_file_cb = $self->has_file_callback; 158 159 while (my $child = $self->directory->next) { 160 if($child->is_dir){ 161 next unless $has_dir_cb; 162 next if ref $filter && !$filter->($child); 163 $kernel->yield(dir_callback => $child); 164 } else { 165 next unless $has_file_cb; 166 next if $child->basename =~ /^\.+$/; 167 next if ref $filter && !$filter->($child); 168 $kernel->yield(file_callback => $child); 169 } 170 } 171 172 $self->next_poll( $kernel->delay_set(poll => $self->interval) ); 173} 174 175#these are only here so allow method modifiers to hook into them 176#these are prime candidates for inlining when the class is made immutable 177sub _file_callback { 178 my ($self, $kernel, $file) = @_[OBJECT, KERNEL, ARG0]; 179 $self->file_callback->($file); 180} 181 182sub _dir_callback { 183 my ($self, $kernel, $dir) = @_[OBJECT, KERNEL, ARG0]; 184 $self->dir_callback->($dir); 185} 186 187#--------#---------#---------#---------#---------#---------#---------#--------- 188 189sub _shutdown { 190 my ($self, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP]; 191 #cleaup heap, alias, alarms (no lingering refs n ish) 192 %$heap = (); 193 $kernel->alias_remove($self->alias); 194 $kernel->alarm_remove_all(); 195} 196 197#--------#---------#---------#---------#---------#---------#---------#--------- 198 199__PACKAGE__->meta->make_immutable; 200 201no Moose; 202 2031; 204 205__END__; 206 207=head1 NAME 208 209POE::Component::DirWatch - POE directory watcher 210 211=head1 SYNOPSIS 212 213 use POE::Component::DirWatch; 214 215 my $watcher = POE::Component::DirWatch->new 216 ( 217 alias => 'dirwatch', 218 directory => '/some_dir', 219 filter => sub { $_[0]->is_file ? $_[0] =~ /\.gz$/ : 1 }, 220 dir_callback => sub{ ... }, 221 file_callback => sub{ ... }, 222 interval => 1, 223 ); 224 225 $poe_kernel->run; 226 227=head1 DESCRIPTION 228 229POE::Component::DirWatch watches a directory for files or directories. 230Upon finding either it will invoke a user-supplied callback function 231depending on whether the item is a file or directory. 232 233=head1 ASYNCHRONOUS IO SUPPORT 234 235This object supports asynchronous IO access using L<IO::AIO>. At load time, 236the class will detect whether IO::AIO is present in the host system and, if it 237is present, apply the L<POE::Component::DirWatch::Role::AIO> role to the 238current class, adding the C<aio> attribute, the <aio_callback> event, and 239replacing C<_poll> with an asynchronous version. If you do not wish to use AIO 240you can specify so with he C<no_aio> flag like this: 241 242 use POE::Component::DirWatch (no_aio => 1); 243 244=head1 ATTRIBUTES 245 246=head2 alias 247 248Read only alias for the DirWatch session. Defaults to C<dirwatch> if not 249specified. You can NOT rename a session at runtime. 250 251=head2 directory 252 253Read-write, required. A L<Path::Class::Dir> object for the directory watched. 254Automatically coerces strings into L<Path::Class::Dir> objects. 255 256=head2 interval 257 258Required read-write integer representing interval between the end of a poll 259event and the scheduled start of the next. Defaults to 1. 260 261=head2 file_callback 262 263=over 4 264 265=item B<has_file_callback> - predicate 266 267=item B<clear_file_callback> - clearer 268 269=back 270 271Optional read-write code reference to call when a file is found. The code 272reference will passed a single argument, a L<Path::Class::File> object 273representing the file found. It usually makes most sense to process the file 274and remove it from the directory to avoid duplicate processing 275 276=head2 dir_callback 277 278=over 4 279 280=item B<has_dir_callback> - predicate 281 282=item B<clear_dir_callback> - clearer 283 284=back 285 286Optional read-write code reference to call when a directory is found. The code 287reference will passed a single argument, a L<Path::Class::Dir> object 288representing the directory found. 289 290=head2 filter 291 292=over 4 293 294=item B<has_filter> - predicate 295 296=item B<clear_filter> - clearer 297 298=back 299 300An optional read-write code reference that, if present, will be called for each 301item in the watched directory. The code reference will passed a single 302argument, a L<Path::Class::File> or L<Path::Class::Dir> object representing 303the file/dir found. The code should return true if the callback should be 304called and false if the file should be ignored. 305 306=head2 next_poll 307 308=over 4 309 310=item B<has_next_poll> - predicate 311 312=item B<clear_next_poll> - clearer 313 314=back 315 316The ID of the alarm for the next scheduled poll, if any. Has clearer 317and predicate methods named C<clear_next_poll> and C<has_next_poll>. 318Please note that clearing the C<next_poll> just clears the next poll id, 319it does not remove the alarm, please use C<pause> for that. 320 321=head1 OBJECT METHODS 322 323=head2 new( \%attrs) 324 325 See SYNOPSIS and ATTRIBUTES. 326 327=head2 session 328 329Returns a reference to the actual POE session. 330Please avoid this unless you are subclassing. Even then it is recommended that 331it is always used as C<$watcher-E<gt>session-E<gt>method> because copying the 332object reference around could create a problem with lingering references. 333 334=head2 pause [$until] 335 336Synchronous call to _pause. This just posts an immediate _pause event to the 337kernel. 338 339=head2 resume [$when] 340 341Synchronous call to _resume. This just posts an immediate _resume event to the 342kernel. 343 344=head2 shutdown 345 346Convenience method that posts a FIFO shutdown event. 347 348=head2 meta 349 350See L<Moose>; 351 352=head1 EVENT HANDLING METHODS 353 354These methods are not part of the public interface of this class, and expect 355to be called from whithin POE with the standard positional arguments. 356Use them at your own risk. 357 358=head2 _start 359 360Runs when C<$poe_kernel-E<gt>run> is called to set the session's alias and 361schedule the first C<poll> event. 362 363=head2 _poll 364 365Triggered by the C<poll> event this is the re-occurring action. _poll will use 366get a list of all items in the directory and call the appropriate callback. 367 368=head2 _file_callback 369 370Will execute the C<file_callback> code reference, if any. 371 372=head2 _pause [$until] 373 374Triggered by the C<_pause> event this method will remove the alarm scheduling 375the next directory poll. It takes an optional argument of $until, which 376dictates when the polling should begin again. If $until is an integer smaller 377than the result of time() it will treat $until as the number of seconds to wait 378before polling. If $until is an integer larger than the result of time() it 379will treat $until as an epoch timestamp. 380 381 #these two are the same thing 382 $watcher->pause( time() + 60); 383 $watcher->pause( 60 ); 384 385 #this is one also the same 386 $watcher->pause; 387 $watcher->resume( 60 ); 388 389 390=head2 _resume [$when] 391 392Triggered by the C<_resume> event this method will remove the alarm scheduling 393the next directory poll (if any) and schedule a new poll alarm. It takes an 394optional argument of $when, which dictates when the polling should begin again. 395If $when is an integer smaller than the result of time() it will treat $until 396as the number of seconds to wait before polling. If $until is an integer larger 397than the result of time() it will treat $when as an epoch timestamp and 398schedule the poll alarm accordingly. If not specified, the alarm will be 399scheduled with a delay of zero. 400 401=head2 _shutdown 402 403Delete the C<heap>, remove the alias we are using and remove all set alarms. 404 405=head2 BUILD 406 407Constructor. C<create()>s a L<POE::Session>. 408 409=head1 TODO 410 411=over 4 412 413=item More examples 414 415=item More tests 416 417=item ChangeNotify support (patches welcome!) 418 419=back 420 421=head1 SEE ALSO 422 423L<POE::Session>, L<POE::Component>, L<Moose>, L<POE>, 424 425The git repository for this project can be found in on github, 426L<http://github.com/arcanez/poe-component-dirwatch/> 427 428=head1 AUTHOR 429 430Guillermo Roditi, <groditi@cpan.org> 431 432=head1 BUGS 433 434Please report any bugs or feature requests to 435C<bug-poe-component-dirwatch at rt.cpan.org>, or through the web interface at 436L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=POE-Component-DirWatch>. 437I will be notified, and then you'll automatically be notified of progress on 438your bug as I make changes. 439 440=head1 ACKNOWLEDGEMENTS 441 442=over 4 443 444=item #poe & #moose on irc.perl.org 445 446=item Matt S Trout 447 448=item Rocco Caputo 449 450=item Charles Reiss 451 452=item Stevan Little 453 454=item Eric Cholet 455 456=back 457 458=head1 COPYRIGHT 459 460Copyright 2006-2008 Guillermo Roditi. This is free software; you may 461redistribute it and/or modify it under the same terms as Perl itself. 462 463=cut 464