File Coverage

blib/lib/POE/Wheel/FollowTail.pm
Criterion Covered Total %
statement 241 284 84.8
branch 87 152 57.2
condition 21 55 38.1
subroutine 21 23 91.3
pod 4 5 80.0
total 374 519 72.0


line stmt bran cond sub pod time code
1             package POE::Wheel::FollowTail;
2              
3 21     21   20459 use strict;
  21         52  
  21         1581  
4              
5 21     21   134 use vars qw($VERSION @ISA);
  21         37  
  21         18174  
6             $VERSION = '1.367'; # NOTE - Should be #.### (three decimal places)
7              
8 21     21   394 use Carp qw( croak carp );
  21         50  
  21         3334  
9 21     21   172 use Symbol qw( gensym );
  21         50  
  21         1352  
10 21     21   150 use POSIX qw(SEEK_SET SEEK_CUR SEEK_END S_ISCHR S_ISBLK);
  21         38  
  21         263  
11 21     21   2761 use POE qw(Wheel Driver::SysRW Filter::Line);
  21         50  
  21         200  
12             push @ISA, qw(POE::Wheel);
13 21     21   268 use IO::Handle ();
  21         138  
  21         526  
14 21     21   97 use Errno qw(ENOENT);
  21         38  
  21         24590  
15              
16 0     0 0 0 sub CRIMSON_SCOPE_HACK ($) { 0 }
17              
18             sub SELF_HANDLE () { 0 }
19             sub SELF_FILENAME () { 1 }
20             sub SELF_DRIVER () { 2 }
21             sub SELF_FILTER () { 3 }
22             sub SELF_INTERVAL () { 4 }
23             sub SELF_EVENT_INPUT () { 5 }
24             sub SELF_EVENT_ERROR () { 6 }
25             sub SELF_EVENT_RESET () { 7 }
26             sub SELF_UNIQUE_ID () { 8 }
27             sub SELF_STATE_READ () { 9 }
28             sub SELF_LAST_STAT () { 10 }
29             sub SELF_FOLLOW_MODE () { 11 }
30             sub SELF_EVENT_IDLE () { 12 }
31              
32             sub MODE_TIMER () { 0x01 } # Follow on a timer loop.
33             sub MODE_SELECT () { 0x02 } # Follow via select().
34              
35             # Turn on tracing. A lot of debugging occurred just after 0.11.
36             sub TRACE_POLL () { 0 }
37             sub TRACE_RESET () { 0 }
38             sub TRACE_STAT () { 0 }
39             sub TRACE_STAT_VERBOSE () { 0 }
40              
41             # Tk doesn't provide a SEEK method, as of 800.022
42             BEGIN {
43 21 50   21   203537 if (exists $INC{'Tk.pm'}) {
44 0         0 eval <<' EOE';
45             sub Tk::Event::IO::SEEK {
46             my $o = shift;
47             $o->wait(Tk::Event::IO::READABLE);
48             my $h = $o->handle;
49             sysseek($h, shift, shift);
50             }
51             EOE
52             }
53             }
54              
55             #------------------------------------------------------------------------------
56              
57             sub new {
58 99     99 1 117244 my $type = shift;
59 99         576 my %params = @_;
60              
61 99 50 33     1253 croak "wheels no longer require a kernel reference as their first parameter"
62             if @_ and (ref($_[0]) eq 'POE::Kernel');
63              
64 99 50       368 croak "$type requires a working Kernel" unless (defined $poe_kernel);
65              
66 99 50 50     926 croak "FollowTail requires a Handle or Filename parameter, but not both"
67             unless $params{Handle} xor defined $params{Filename};
68              
69 99         277 my $driver = delete $params{Driver};
70 99 100       1260 $driver = POE::Driver::SysRW->new() unless defined $driver;
71              
72 99         247 my $filter = delete $params{Filter};
73 99 100       1263 $filter = POE::Filter::Line->new() unless defined $filter;
74              
75 99 50       335 croak "InputEvent required" unless defined $params{InputEvent};
76              
77 99         389 my $handle = $params{Handle};
78 99         175 my $filename = $params{Filename};
79              
80 99 100       376 my $poll_interval = (
81             defined($params{PollInterval})
82             ? $params{PollInterval}
83             : 1
84             );
85              
86 99         153 my $seek;
87 99 50       463 if (exists $params{SeekBack}) {
    50          
88 0         0 $seek = $params{SeekBack} * -1;
89 0 0       0 if (exists $params{Seek}) {
90 0         0 croak "can't have Seek and SeekBack at the same time";
91             }
92             }
93             elsif (exists $params{Seek}) {
94 0         0 $seek = $params{Seek};
95             }
96             else {
97 99         566 $seek = -4096;
98             }
99              
100 99         660 my $self = bless [
101             $handle, # SELF_HANDLE
102             $filename, # SELF_FILENAME
103             $driver, # SELF_DRIVER
104             $filter, # SELF_FILTER
105             $poll_interval, # SELF_INTERVAL
106             delete $params{InputEvent}, # SELF_EVENT_INPUT
107             delete $params{ErrorEvent}, # SELF_EVENT_ERROR
108             delete $params{ResetEvent}, # SELF_EVENT_RESET
109             &POE::Wheel::allocate_wheel_id(), # SELF_UNIQUE_ID
110             undef, # SELF_STATE_READ
111             [ (-1) x 8 ], # SELF_LAST_STAT
112             undef, # SELF_FOLLOW_MODE
113             delete $params{IdleEvent}, # SELF_EVENT_IDLE
114             ], $type;
115              
116 99 100       511 if (defined $filename) {
    50          
117 7         33 $handle = $self->[SELF_HANDLE] = _open_file($filename);
118 7 100       89 $self->[SELF_LAST_STAT] = [ (stat $filename)[0..7] ] if $handle;
119             }
120             elsif (defined $handle) {
121 92         2051 $self->[SELF_LAST_STAT] = [ (stat $handle)[0..7] ];
122             }
123              
124             # Honor SeekBack and discard partial input if we have a plain file
125             # that is successfully open at this point.
126             #
127             # SeekBack attempts to position the file pointer somewhere before
128             # the end of the file. If it's specified, we assume the user knows
129             # where a record begins. Otherwise we just seek back and discard
130             # everything to EOF so we can frame the input record.
131              
132 99 100       381 if (defined $handle) {
133              
134             # Handle is a plain file. Honor SeekBack and PollInterval.
135              
136 96 100       662 if (-f $handle) {
137 93         522 my $end = sysseek($self->[SELF_HANDLE], 0, SEEK_END);
138              
139             # Seeking back from EOF.
140 93 50       305 if ($seek < 0) {
    0          
    0          
    0          
141 93 50 33     1112 if (defined($end) and ($end < -$seek)) {
142 93         370 sysseek($self->[SELF_HANDLE], 0, SEEK_SET);
143             }
144             else {
145 0         0 sysseek($self->[SELF_HANDLE], $seek, SEEK_END);
146             }
147             }
148              
149             # Seeking forward from the beginning of the file.
150             elsif ($seek > 0) {
151 0 0       0 if ($seek > $end) {
152 0         0 sysseek($self->[SELF_HANDLE], 0, SEEK_END);
153             }
154             else {
155 0         0 sysseek($self->[SELF_HANDLE], $seek, SEEK_SET);
156             }
157             }
158              
159             # If they set Seek to 0, we start at the beginning of the file.
160             # If it was SeekBack, we start at the end.
161             elsif (exists $params{Seek}) {
162 0         0 sysseek($self->[SELF_HANDLE], 0, SEEK_SET);
163             }
164             elsif (exists $params{SeekBack}) {
165 0         0 sysseek($self->[SELF_HANDLE], 0, SEEK_END);
166             }
167             else {
168 0         0 die; # Should never happen.
169             }
170              
171             # Discard partial input chunks unless a SeekBack was specified.
172 93 50 33     845 unless (defined $params{SeekBack} or defined $params{Seek}) {
173 93         549 while (defined(my $raw_input = $driver->get($self->[SELF_HANDLE]))) {
174             # Skip out if there's no more input.
175 1 50       2 last unless @$raw_input;
176 1         9 $filter->get($raw_input);
177             }
178             }
179              
180             # Start the timer loop.
181 93         224 $self->[SELF_FOLLOW_MODE] = MODE_TIMER;
182 93         565 $self->_define_timer_states();
183              
184 93         749 return $self;
185             }
186              
187             # Strange things that ought not be tailed? Directories...
188              
189 3 50       11 if (-d $self->[SELF_HANDLE]) {
190 0         0 croak "FollowTail does not tail directories";
191             }
192              
193             # Handle is not a plain file.
194             # Can only honor SeekBack if it's zero.
195              
196 3 50       8 carp "POE::Wheel::FollowTail can't SeekBack special files"
197             if $params{SeekBack};
198              
199             # The handle isn't legal to multiplex on this platform.
200 3 50 33     138 if (POE::Kernel::RUNNING_IN_HELL and not -S $handle) {
201 0         0 $self->[SELF_FOLLOW_MODE] = MODE_TIMER;
202 0         0 $self->_define_timer_states();
203 0         0 return $self;
204             }
205              
206             # Multiplexing should be more efficient where it's supported.
207              
208 3 50       8 carp "FollowTail does not need PollInterval for special files"
209             if defined $params{PollInterval};
210              
211 3         6 $self->[SELF_FOLLOW_MODE] = MODE_SELECT;
212 3         9 $self->_define_select_states();
213 3         15 return $self;
214             }
215              
216             # We don't have an open filehandle yet. We can't tell whether
217             # multiplexing is legal, and we can't seek back yet. Don't honor
218             # either.
219              
220 3         7 $self->[SELF_FOLLOW_MODE] = MODE_TIMER;
221 3         13 $self->_define_timer_states();
222 3         20 return $self;
223             }
224              
225             ### Define the select based polling loop. This relies on stupid
226             ### closure tricks to keep references to $self out of anonymous
227             ### coderefs. Otherwise a circular reference would occur, and the
228             ### wheel would never self-destruct.
229              
230             sub _define_select_states {
231 3     3   4 my $self = shift;
232              
233 3         4 my $filter = $self->[SELF_FILTER];
234 3         5 my $driver = $self->[SELF_DRIVER];
235 3         5 my $handle = \$self->[SELF_HANDLE];
236 3         4 my $unique_id = $self->[SELF_UNIQUE_ID];
237 3         5 my $event_input = \$self->[SELF_EVENT_INPUT];
238 3         3 my $event_error = \$self->[SELF_EVENT_ERROR];
239 3         6 my $event_reset = \$self->[SELF_EVENT_RESET];
240 3         7 my $event_idle = \$self->[SELF_EVENT_IDLE];
241              
242 3         3 TRACE_POLL and warn " defining select state";
243              
244             $poe_kernel->state(
245             $self->[SELF_STATE_READ] = ref($self) . "($unique_id) -> select read",
246             sub {
247              
248             # Protects against coredump on older perls.
249 23     23   29 0 && CRIMSON_SCOPE_HACK('<');
250              
251             # The actual code starts here.
252 23         49 my ($k, $ses) = @_[KERNEL, SESSION];
253              
254             # Reset position.
255 23         30 eval { sysseek($$handle, 0, SEEK_CUR) };
  23         87  
256 23         37 $! = 0;
257              
258 23         23 TRACE_POLL and warn " " . time . " read ok";
259              
260             # Read the next chunk, and return its data. Go around again.
261 23 100       120 if (defined(my $raw_input = $driver->get($$handle))) {
262 21         22 TRACE_POLL and warn " " . time . " raw input";
263 21         73 $filter->get_one_start($raw_input);
264 21         20 my $cooked_array;
265 21         25 while (@{$cooked_array = $filter->get_one()}) {
  45         118  
266 24         48 foreach my $cooked_input (@$cooked_array) {
267 24         24 TRACE_POLL and warn " " . time . " cooked input";
268 24         71 $k->call($ses, $$event_input, $cooked_input, $unique_id);
269             }
270             }
271              
272             # Clear the filehandle's EOF status, if any.
273 21         86 IO::Handle::clearerr($$handle);
274              
275 21         59 return;
276             }
277              
278             # Error reading. Report the error if it's not EOF, or if it's
279             # EOF on a socket or TTY. Shut down the select, too.
280             else {
281 2 50 33     27 if ($! or (-S $$handle) or (-t $$handle)) {
    0 33        
282 2         2 TRACE_POLL and warn " " . time . " error: $!";
283 2 50       15 $$event_error and
284             $k->call($ses, $$event_error, 'read', ($!+0), $!, $unique_id);
285             }
286             elsif (defined $$event_idle) {
287 0         0 $k->call($ses, $$event_idle, $unique_id);
288             }
289              
290 2         16 $k->select_read($$handle => undef);
291 2         4 eval { IO::Handle::clearerr($$handle) }; # could be a globref
  2         15  
292             }
293             }
294 3         34 );
295              
296 3         12 $poe_kernel->select_read($$handle, $self->[SELF_STATE_READ]);
297             }
298              
299             ### Define the timer based polling loop. This also relies on stupid
300             ### closure tricks.
301              
302             sub _define_timer_states {
303 96     96   206 my $self = shift;
304              
305             # Tail by filename.
306 96 100       325 if (defined $self->[SELF_FILENAME]) {
307 6         6 TRACE_POLL and warn " defining timer state for filename tail";
308 6         26 $self->_generate_filename_timer();
309             }
310             else {
311 90         111 TRACE_POLL and warn " defining timer state for handle tail";
312 90         3973 $self->_generate_filehandle_timer();
313             }
314              
315             # Fire up the loop. The delay() aspect of the loop will prevent
316             # duplicate events from being significant for long.
317 96         447 $poe_kernel->delay($self->[SELF_STATE_READ], 0);
318             }
319              
320             sub _generate_filehandle_timer {
321 90     90   192 my $self = shift;
322              
323 90         182 my $filter = $self->[SELF_FILTER];
324 90         212 my $driver = $self->[SELF_DRIVER];
325 90         243 my $unique_id = $self->[SELF_UNIQUE_ID];
326 90         517 my $poll_interval = $self->[SELF_INTERVAL];
327 90         169 my $last_stat = $self->[SELF_LAST_STAT];
328              
329 90         174 my $filename = \$self->[SELF_FILENAME];
330 90         212 my $handle = \$self->[SELF_HANDLE];
331 90         303 my $event_input = \$self->[SELF_EVENT_INPUT];
332 90         177 my $event_error = \$self->[SELF_EVENT_ERROR];
333 90         143 my $event_reset = \$self->[SELF_EVENT_RESET];
334 90         327 my $event_idle = \$self->[SELF_EVENT_IDLE];
335              
336 90         473 $self->[SELF_STATE_READ] = ref($self) . "($unique_id) -> handle timer read";
337 90         197 my $state_read = \$self->[SELF_STATE_READ];
338              
339             $poe_kernel->state(
340             $$state_read,
341             sub {
342              
343             # Protects against coredump on older perls.
344 572     572   871 0 && CRIMSON_SCOPE_HACK('<');
345              
346             # The actual code starts here.
347 572         1722 my ($k, $ses) = @_[KERNEL, SESSION];
348              
349             # File isn't open? We're done.
350 572 50 33     5098 unless (defined $$handle and fileno $$handle) {
351 0         0 TRACE_POLL and warn " ", time, " $$handle closed";
352 0 0       0 $$event_error and
353             $k->call($ses, $$event_error, 'read', 0, "", $unique_id);
354 0         0 return;
355             }
356              
357             # Reset position.
358 572         937 eval { sysseek($$handle, 0, SEEK_CUR) };
  572         3565  
359 572         2205 $! = 0;
360              
361             # Read the next chunk, and return its data. Go around again.
362 572 100       3830 if (defined(my $raw_input = $driver->get($$handle))) {
363 162         303 TRACE_POLL and warn " " . time . " raw input";
364 162         1097 $filter->get_one_start($raw_input);
365 162         337 while (1) {
366 2179         6692 my $next_rec = $filter->get_one();
367 2179 100       4792 last unless @$next_rec;
368 2028         3029 foreach my $cooked_input (@$next_rec) {
369 2028         1691 TRACE_POLL and warn " " . time . " cooked input";
370 2028         5114 $k->call($ses, $$event_input, $cooked_input, $unique_id);
371             }
372             }
373              
374             # Clear the filehandle's EOF status, if any.
375 151         1173 IO::Handle::clearerr($$handle);
376              
377             # Must use a timer so that it can be cleared in DESTROY.
378 151 100       785 $k->delay($$state_read, 0) if defined $$state_read;
379 151         5212 return;
380             }
381              
382             # Some kind of important error?
383 410 50       1871 if ($!) {
384 0         0 TRACE_POLL and warn " ", time, " $$handle error: $!";
385 0 0       0 $$event_error and
386             $k->call($ses, $$event_error, 'read', ($!+0), "$!", $unique_id);
387 0         0 return;
388             }
389              
390             # Merely EOF. Check for file rotation.
391              
392 410 50       10841 my @new_stat = (
393             (defined $$filename)
394             ? ((stat $$filename)[0..7])
395             : ((stat $$handle)[0..7])
396             );
397              
398 410 50       1304 unless (@new_stat) {
399 0         0 TRACE_POLL and warn " ", time, " $$handle stat error";
400 0 0       0 $$event_error and
401             $k->call($ses, $$event_error, 'stat', ($!+0), "$!", $unique_id);
402 0         0 return;
403             }
404              
405 410         580 TRACE_STAT_VERBOSE and do {
406             my @test_new = @new_stat;
407             my @test_old = @$last_stat;
408             warn " from: @test_old\n to : @test_new" if (
409             "@test_new" ne "@test_old"
410             );
411             };
412              
413             # Ignore rdev changes for non-device files
414 410         616 eval {
415 410 50 33     3951 if (!S_ISBLK($new_stat[2]) and !S_ISCHR($new_stat[2])) {
416 410         1132 $last_stat->[6] = $new_stat[6];
417             }
418             };
419              
420             # Something fundamental about the file changed.
421             # Consider it a reset, and try to rewind to the top of the file.
422 410 50 33     7778 if (
    50 33        
      33        
      33        
423             $new_stat[1] != $last_stat->[1] or # inode's number
424             $new_stat[0] != $last_stat->[0] or # inode's device
425             $new_stat[6] != $last_stat->[6] or # device type
426             $new_stat[3] != $last_stat->[3] or # number of links
427             $new_stat[7] < $last_stat->[7] # size reduced
428             ) {
429 0         0 TRACE_STAT and do {
430             warn " inode $new_stat[1] != old $last_stat->[1]"
431             if $new_stat[1] != $last_stat->[1];
432             warn " inode device $new_stat[0] != old $last_stat->[0]"
433             if $new_stat[0] != $last_stat->[0];
434             warn " device type $new_stat[6] != old $last_stat->[6]"
435             if $new_stat[6] != $last_stat->[6];
436             warn " link count $new_stat[3] != old $last_stat->[3]"
437             if $new_stat[3] != $last_stat->[3];
438             warn " file size $new_stat[7] < old $last_stat->[7]"
439             if $new_stat[7] < $last_stat->[7];
440             };
441              
442             # File has reset.
443 0         0 TRACE_RESET and warn " filehandle has reset";
444 0 0       0 $$event_reset and $k->call($ses, $$event_reset, $unique_id);
445              
446 0         0 sysseek($$handle, 0, SEEK_SET);
447             }
448             elsif (defined $$event_idle) {
449 0         0 $k->call($ses, $$event_idle, $unique_id);
450             }
451              
452             # The file didn't roll. Try again shortly.
453 410         1531 @$last_stat = @new_stat;
454 410         2065 IO::Handle::clearerr($$handle);
455 410 50       2768 $k->delay($$state_read, $poll_interval) if defined $$state_read;
456 410         1721 return;
457             }
458 90         2290 );
459             }
460              
461             sub _generate_filename_timer {
462 6     6   10 my $self = shift;
463              
464 6         11 my $filter = $self->[SELF_FILTER];
465 6         18 my $driver = $self->[SELF_DRIVER];
466 6         12 my $unique_id = $self->[SELF_UNIQUE_ID];
467 6         14 my $poll_interval = $self->[SELF_INTERVAL];
468 6         13 my $filename = $self->[SELF_FILENAME];
469 6         20 my $last_stat = $self->[SELF_LAST_STAT];
470              
471 6         22 my $handle = \$self->[SELF_HANDLE];
472 6         13 my $event_input = \$self->[SELF_EVENT_INPUT];
473 6         14 my $event_error = \$self->[SELF_EVENT_ERROR];
474 6         13 my $event_reset = \$self->[SELF_EVENT_RESET];
475 6         13 my $event_idle = \$self->[SELF_EVENT_IDLE];
476              
477 6         29 $self->[SELF_STATE_READ] = ref($self) . "($unique_id) -> name timer read";
478 6         33 my $state_read = \$self->[SELF_STATE_READ];
479              
480             $poe_kernel->state(
481             $$state_read,
482             sub {
483              
484             # Protects against coredump on older perls.
485 33     33   48 0 && CRIMSON_SCOPE_HACK('<');
486              
487             # The actual code starts here.
488 33         82 my ($k, $ses) = @_[KERNEL, SESSION];
489              
490             # File isn't open? Try to open it.
491 33 100       90 unless ($$handle) {
492 11         37 $$handle = _open_file($filename);
493              
494             # Couldn't open yet.
495 11 100       44 unless ($$handle) {
496 5 50       30 $k->call($ses, $$event_idle, $unique_id) if defined $$event_idle;
497 5 50       31 $k->delay($$state_read, $poll_interval) if defined $$state_read;
498 5         15 return;
499             }
500              
501             # File has reset.
502 6         10 TRACE_RESET and warn " file name has reset";
503 6 50       48 $$event_reset and $k->call($ses, $$event_reset, $unique_id);
504              
505 6         94 @$last_stat = (stat $filename)[0..7];
506             }
507             else {
508             # Reset position.
509 22         45 eval { sysseek($$handle, 0, SEEK_CUR) };
  22         114  
510 22         68 $! = 0;
511             }
512              
513             # Read the next chunk, and return its data. Go around again.
514 28 100       147 if (defined(my $raw_input = $driver->get($$handle))) {
515 17         24 TRACE_POLL and warn " " . time . " raw input";
516 17         93 $filter->get_one_start($raw_input);
517 17         21 my $cooked_array;
518 17         30 while (@{$cooked_array = $filter->get_one()}) {
  38         136  
519 21         51 foreach my $cooked_input (@$cooked_array) {
520 21         25 TRACE_POLL and warn " " . time . " cooked input";
521 21         110 $k->call($ses, $$event_input, $cooked_input, $unique_id);
522             }
523             }
524              
525             # Clear the filehandle's EOF status, if any.
526 17         95 IO::Handle::clearerr($$handle);
527              
528             # Must use a timer so that it can be cleared in DESTROY.
529 17 100       182 $k->delay($$state_read, 0) if defined $$state_read;
530 17         859 return;
531             }
532              
533             # Some kind of important error?
534 11 50       51 if ($!) {
535 0         0 TRACE_POLL and warn " ", time, " $$handle error: $!";
536 0 0       0 $$event_error and
537             $k->call($ses, $$event_error, 'read', ($!+0), "$!", $unique_id);
538 0         0 return;
539             }
540              
541             # Merely EOF. Check for file rotation.
542 11         381 my @new_stat = (stat $filename)[0..7];
543 11 100       42 unless (@new_stat) {
544 2         2 TRACE_POLL and warn " ", time, " $filename stat error: $!";
545 2 50       16 if ($! != ENOENT) {
546 0 0       0 $$event_error and
547             $k->call($ses, $$event_error, 'stat', ($!+0), "$!", $unique_id);
548 0         0 return;
549             }
550 2         8 @new_stat = (-1) x 8;
551             }
552              
553 11         14 TRACE_STAT_VERBOSE and do {
554             my @test_new = @new_stat;
555             my @test_old = @$last_stat;
556             warn " from: @test_old\n to : @test_new" if (
557             "@test_new" ne "@test_old"
558             );
559             };
560              
561             # Ignore rdev changes for non-device files
562 11         18 eval {
563 11 50 33     125 if (!S_ISBLK($new_stat[2]) and !S_ISCHR($new_stat[2])) {
564 11         30 $last_stat->[6] = $new_stat[6];
565             }
566             };
567              
568             # Something fundamental about the file changed.
569             # Consider it a reset, and close the file.
570 11 100 66     203 if (
    100 66        
      33        
      33        
571             $new_stat[1] != $last_stat->[1] or # inode's number
572             $new_stat[0] != $last_stat->[0] or # inode's device
573             $new_stat[6] != $last_stat->[6] or # device type
574             $new_stat[3] != $last_stat->[3] or # number of links
575             $new_stat[7] < $last_stat->[7] # size reduced
576             ) {
577 3         6 TRACE_STAT and do {
578             warn " inode $new_stat[1] != old $last_stat->[1]"
579             if $new_stat[1] != $last_stat->[1];
580             warn " inode device $new_stat[0] != old $last_stat->[0]"
581             if $new_stat[0] != $last_stat->[0];
582             warn " device type $new_stat[6] != old $last_stat->[6]"
583             if $new_stat[6] != $last_stat->[6];
584             warn " link count $new_stat[3] != old $last_stat->[3]"
585             if $new_stat[3] != $last_stat->[3];
586             warn " file size $new_stat[7] < old $last_stat->[7]"
587             if $new_stat[7] < $last_stat->[7];
588             };
589              
590 3         8 $$handle = undef;
591 3         313 @$last_stat = @new_stat;
592              
593             # Must use a timer so that it can be cleared in DESTROY.
594 3 50       27 $k->delay($$state_read, 0) if defined $$state_read;
595 3         10 return;
596             }
597             elsif (defined $$event_idle) {
598 2         9 $k->call($ses, $$event_idle, $unique_id);
599             }
600              
601             # The file didn't roll. Try again shortly.
602 8         31 @$last_stat = @new_stat;
603 8         27 IO::Handle::clearerr($$handle);
604 8 50       50 $k->delay($$state_read, $poll_interval) if defined $$state_read;
605 8         32 return;
606             }
607 6         92 );
608             }
609              
610             #------------------------------------------------------------------------------
611              
612             sub event {
613 8     8 1 723 my $self = shift;
614 8 50       25 push(@_, undef) if (scalar(@_) & 1);
615              
616 8         22 while (@_) {
617 10         20 my ($name, $event) = splice(@_, 0, 2);
618              
619 10 100       46 if ($name eq 'InputEvent') {
    100          
    50          
    50          
620 2 50       5 if (defined $event) {
621 2         7 $self->[SELF_EVENT_INPUT] = $event;
622             }
623             else {
624 0         0 carp "InputEvent requires an event name. ignoring undef";
625             }
626             }
627             elsif ($name eq 'ErrorEvent') {
628 2         8 $self->[SELF_EVENT_ERROR] = $event;
629             }
630             elsif ($name eq 'ResetEvent') {
631 0         0 $self->[SELF_EVENT_RESET] = $event;
632             }
633             elsif ($name eq 'IdleEvent') {
634 6         32 $self->[SELF_EVENT_IDLE] = $event;
635             }
636             else {
637 0         0 carp "ignoring unknown FollowTail parameter '$name'";
638             }
639             }
640             }
641              
642             #------------------------------------------------------------------------------
643              
644             sub DESTROY {
645 87     87   74670 my $self = shift;
646              
647             # Remove our tentacles from our owner.
648 87 50       808 $poe_kernel->select_read($self->[SELF_HANDLE] => undef) if (
649             defined $self->[SELF_HANDLE]
650             );
651              
652 87 50       351 if ($self->[SELF_STATE_READ]) {
653 87         487 $poe_kernel->delay($self->[SELF_STATE_READ]);
654 87         421 $poe_kernel->state($self->[SELF_STATE_READ]);
655 87         208 undef $self->[SELF_STATE_READ];
656             }
657              
658 87         521 &POE::Wheel::free_wheel_id($self->[SELF_UNIQUE_ID]);
659             }
660              
661             #------------------------------------------------------------------------------
662              
663             sub ID {
664 2     2 1 15 return $_[0]->[SELF_UNIQUE_ID];
665             }
666              
667             sub tell {
668 0     0 1 0 my $self = shift;
669 0         0 return sysseek($self->[SELF_HANDLE], 0, SEEK_CUR);
670             }
671              
672             sub _open_file {
673 18     18   31 my $filename = shift;
674              
675 18         83 my $handle = gensym();
676              
677             # FIFOs (named pipes) are opened R/W so they don't report EOF.
678             # Everything else is opened read-only.
679 18 100       615 if (-p $filename) {
680 1 50       30 return $handle if open $handle, "+<", $filename;
681 0         0 return;
682             }
683              
684 17 100       576 return $handle if open $handle, "<", $filename;
685 8         57 return;
686             }
687              
688             1;
689              
690             __END__