File Coverage

blib/lib/File/SmartTail.pm
Criterion Covered Total %
statement 203 650 31.2
branch 56 318 17.6
condition 15 93 16.1
subroutine 22 49 44.9
pod 17 33 51.5
total 313 1143 27.3


line stmt bran cond sub pod time code
1             #
2             # $Id: SmartTail.pm,v 4.66 2008/07/09 20:40:20 mprewitt Exp $
3             #
4             # -----
5              
6             =head1 NAME
7              
8             B Routines to smartly tail a file
9              
10             =head1 SYNOPSIS
11              
12             Special tail routines to tail a file, remember where you were, and
13             pick up from there again if necessary.
14              
15             Called as:
16              
17             use File::SmartTail;
18             $tail = new File::SmartTail(file1, file2, ...);
19             while ($line = $tail->Tail()) {
20             print $line;
21             }
22              
23             Or:
24              
25             $tail = new File::SmartTail;
26             $tail->WatchFile(-file=>"file1",
27             -type=>"UNIX-REMOTE",
28             -host=>"lamachine",
29             -user=>"bozo",
30             -rmtopts=>"-type UNIX -prefix appname",
31             -rmtenv=>"PERL5LIB=/lib/foo FOO=bar",
32             -date=>"parsed", -yrfmt=>4, -monthdir=>"../..",
33             -timeout=>999,
34             -request_timeout=>999,
35             -prefix=>appname,
36             -reset=>1);
37             while ($line = GetLine(-doitfn=>\&YourFn)) {
38             print $line;
39             }
40              
41             The format of the result is:
42              
43             hostname:filename:line-of-data
44              
45             See WatchFile for detailed description of options.
46              
47             =head1 DESCRIPTION
48              
49             The File::SmartTail module provides functionality modeled on the UNIX tail
50             command, but enhanced with a variety of options, and the capability to
51             "remember" how far it has processed a file, between invocations. rtail.pl is
52             not normally used directly, but is invoked by a File::SmartTail object when
53             monitoring a file on a remote host. When monitoring files on a remote machine,
54             rtail.pl must be in the path of the owner of the process, on the remote machine.
55             Normally it is installed in /usr/local/bin.
56              
57             =head1 AUTHOR
58              
59             DMJA, Inc
60              
61             =head1 COPYRIGHT
62              
63             Copyright (C) 2003-2015 DMJA, Inc, File::SmartTail comes with
64             ABSOLUTELY NO WARRANTY. This is free software, and you are welcome to
65             redistribute it and/or modify it under the same terms as Perl itself.
66             See the "The Artistic License" L for more details.
67              
68             =cut
69              
70             package File::SmartTail;
71              
72 5     5   44717 use strict;
  5         9  
  5         141  
73 5     5   24 use vars qw( $VERSION );
  5         10  
  5         222  
74 5     5   31 use Fcntl;
  5         7  
  5         1647  
75 5     5   25 use File::Basename;
  5         9  
  5         389  
76 5     5   3920 use IO::Seekable;
  5         41717  
  5         274  
77 5     5   3908 use IO::File;
  5         4740  
  5         960  
78 5     5   3892 use IO::Socket;
  5         87561  
  5         84  
79 5     5   6948 use Time::Local;
  5         8456  
  5         309  
80 5     5   3632 use Sys::Hostname;
  5         5496  
  5         258  
81 5     5   3638 use File::SmartTail::Logger;
  5         12  
  5         150  
82 5     5   2551 use File::SmartTail::DB;
  5         11  
  5         234  
83              
84             $VERSION = (qw$Revision: 4.66 $)[1];
85              
86 5     5   29 use vars qw( $BATCHLIM $BEAT $BEATOUT $COUNT $DIRTY $MAX_RETRIES $SLEEP $TODAY $TOMORROW );
  5         10  
  5         41161  
87              
88             #
89             # Heartbeat frequency (seconds), heartbeat timeout interval (seconds),
90             # maximum attempts to restart remote process ("your results may vary"),
91             #
92              
93             $BEAT = 30;
94             $BEATOUT = 120;
95             $MAX_RETRIES = 6;
96             $SLEEP = 2;
97              
98             $BATCHLIM = 100; # Chunk of records before running DoIt() if present.
99             $COUNT = 0;
100              
101             #$BINDIR="/usr/local/bin";
102              
103             $TODAY = fmtime(time, 4);
104             $TOMORROW = rolldate($TODAY, 4);
105              
106             =head2 new
107              
108             $tail = new File::SmartTail($filename1, $filename2, ...)
109              
110             or
111              
112             $tail = new File::SmartTail(-tietype=>$type, -statuskey=>$programname, -bindir=>$rtail_script_location, $filename1, $filename2, ...)
113              
114             B can be any class that can be tied to a hash like NDBM_File DB_File
115             SDBM_File.
116              
117             Default statuskey is name of invoking program.
118              
119             =cut
120              
121             sub new {
122 1     1 1 480988 my $type = shift;
123              
124 1   33     17 my $self = bless {}, ref $type || $type;
125              
126             #
127             # due to funny API, we do a funny thing here....
128             # it's a hash; it's a list; what is it?
129             #
130 1         3 my $STATUSKEY;
131             my $TIETYPE;
132 0         0 my %args;
133 1         8 @args{ @_ } = ();
134 1         6 my %h = @_;
135 1 50       9 if ( exists $h{-tietype} ) {
136 1 50       10 if ($h{-tietype} =~ /NDBM/) {
137 0         0 $TIETYPE = 'NDBM_File';
138             } else {
139 1         5 $TIETYPE = $h{-tietype};
140             }
141 1         7 delete @args{ '-tietype', $h{-tietype} };
142             }
143 1 50       8 if ( exists $h{-statuskey} ) {
144 0 0       0 $h{-statuskey} and $STATUSKEY = $h{-statuskey};
145 0         0 delete @args{ '-statuskey', $h{-statuskey} };
146             }
147 1 50       6 if ( exists $h{-bindir} ) {
148 0         0 $self->{BINDIR} = $h{-bindir};
149 0         0 delete @args{ '-bindir', $h{-bindir} };
150             }
151             #
152             # remaining args in original order, in case order matters
153             #
154 1         9 my @parms = grep exists $args{$_}, @_;
155              
156             #
157             # Use a key to record where we are in the file.
158             #
159 1 50       11 $STATUSKEY or $STATUSKEY = $0;
160 1         83 $STATUSKEY = basename($STATUSKEY);
161 1         10 $STATUSKEY =~ s/\W/_/g;
162 1         6 $STATUSKEY .= ":$>";
163              
164 1         15 $self->{DB} = File::SmartTail::DB->new( statuskey => $STATUSKEY, tietype => $TIETYPE );
165             ###
166            
167             #
168             # Go ahead and open all the files.
169             #
170 1         5 foreach my $file ( @parms ) {
171 0 0       0 $self->OpenFile( $file ) ||
172             die "Unable to tail file \"$file\" [$!].";
173             }
174              
175 1         13 return $self;
176             }
177            
178             =head2 Tail
179              
180             $tail->Tail()
181              
182             or
183              
184             $tail->Tail( @files ) (doesn't seem to be supported)
185              
186             Format of the returned line is:
187              
188             $file1: line of file here.
189              
190             As a degenerate case, $tail->Tail( $file ) will simply return the next
191             line without a need to manage or massage.
192              
193             =cut
194             sub Tail {
195              
196 0     0 1 0 my $self = shift;
197              
198             #
199             # Now, read through the files. If the file has stuff in its array,
200             # then start by returning stuff from there. If it does not, then
201             # read some more into the file, parse it, and then return it.
202             # Otherwise, go on to the next file.
203             #
204 0         0 for ( ; ; ) {
205 0 0 0     0 if ( $DIRTY && ! ( $COUNT++ % 10 ) ) {
206 0         0 $DIRTY = 0;
207 0         0 $self->{DB}->sync;
208             }
209              
210 0         0 FILE: foreach my $file ( keys %{ $self->{file_data} } ) {
  0         0  
211 0         0 my $line;
212 0 0       0 if ( ! @{$self->{file_data}->{$file}->{array}} ) {
  0         0  
213             #
214             # If there's nothing left on the array, then read something new in.
215             # This should never fail, I think.
216             #
217 0         0 my $length;
218             SYSREAD: {
219 0         0 $length = $self->{file_data}->{$file}->{FILE}->sysread($line, 1024);
  0         0  
220 0 0       0 unless ( defined $length ) {
221 0 0       0 next SYSREAD if $! =~ /^Interrupted/;
222 0         0 die "sysread of $file failed [$!].\n";
223             }
224             };
225              
226 0 0       0 if ( ! $length ) {
227             #
228             # Hmmm...zero length here, perhaps we've been aged out?
229             #
230 0         0 my ( $inode, $size ) = (stat($file))[1,7];
231 0 0 0     0 if ( $self->{file_data}->{$file}->{inode} != $inode ||
232             $self->{file_data}->{$file}->{seek} > $size ) {
233             #
234             # We've been aged (inode diff) or we've been truncated
235             # (our checkpoint is larger than the file.)
236             #
237 0 0       0 $self->OpenFile( $file ) ||
238             die "Unable to tail file \"$file\" [$!]\n";
239             }
240             #
241             # In any case, we didn't read anything, so go to the next file.
242             #
243 0         0 next FILE;
244             }
245              
246             #
247             # We read something! But don't forget to add on anything we may have
248             # read before. Build our array by splitting our latest read plus whatever
249             # is saved.
250             #
251 0         0 $self->{file_data}->{$file}->{array} = [ split( /^/m, $self->{file_data}->{$file}->{line} . $line) ];
252              
253             #
254             # If there's a leftover piece, then save it in the "line". Otherwise,
255             # clear it out.
256             #
257 0 0       0 if ( substr($self->{file_data}->{$file}->{array}->[$#{$self->{file_data}->{$file}->{array}}],
  0         0  
258             -1, 1) ne "\n" ) {
259 0         0 $self->{file_data}->{$file}->{line} = pop @{$self->{file_data}->{$file}->{array}};
  0         0  
260 0 0       0 next unless @{$self->{file_data}->{$file}->{array}};
  0         0  
261             } else {
262 0         0 undef $self->{file_data}->{$file}->{line};
263             }
264             }
265            
266             #
267             # If we make it here, then we have something on our array to return.
268             # Increment our counter and sync up our disk file.
269             #
270 0         0 my $return = shift @{$self->{file_data}->{$file}->{"array"}};
  0         0  
271 0         0 $self->{file_data}->{$file}->{seek} += length($return);
272 0 0       0 if ($self->{DB}->{STATFILE}) {
273 0         0 $self->{DB}->{STATUS}->{$file} = "$self->{file_data}->{$file}->{inode}:$self->{file_data}->{$file}->{seek}";
274             }
275 0         0 $DIRTY++;
276 0         0 return "$file:$return";
277             }
278             #
279             # Still here? That means we redo the loop.
280             #
281            
282 0         0 sleep $SLEEP;
283             }
284             }
285              
286             sub OpenFile {
287 0     0 0 0 my( $self, $file ) = @_;
288             #
289             # Give the file a moment to reappear if it's not there.
290             #
291 0 0       0 unless ( -r $file ) {
292 0         0 sleep 10;
293 0 0       0 unless ( -r $file ) {
294 0         0 $! = 2;
295 0         0 return undef;
296             }
297             }
298              
299             #
300             # Stat it, and see if it's the file we were last tailing if this
301             # is the first time we're trying to open the file.
302             #
303 0         0 my $foundfile = $file;
304 0 0       0 if ($self->{DB}->{STATFILE}) {
305 0 0       0 if ( ! $self->{file_data}->{$file}->{done} ) {
306 0         0 ( $self->{file_data}->{$file}->{inode}, $self->{file_data}->{$file}->{seek} ) = split(/:/, $self->{DB}->{STATUS}->{$file} );
307 0         0 my $inode = (stat($file))[1];
308 0 0 0     0 if ( $self->{file_data}->{$file}->{inode} &&
309             $inode != $self->{file_data}->{$file}->{inode} ) {
310            
311             #
312             # It's not where we left off. Uh-oh - see if we can find the
313             # last inode we were on when we quit.
314             #
315 0         0 my ( $findfile, $dir, $item );
316 0         0 $findfile = basename($file);
317 0         0 $dir = dirname($file);
318 0 0       0 opendir(DIR, $dir) ||
319             die "Unable to read directory $dir to search for previous file [$!].\n";
320 0         0 foreach $item ( grep(/^$findfile\.\d+/, readdir DIR ) ) {
321 0 0       0 next unless (stat("$dir/$item"))[1] == $self->{file_data}->{$file}->{inode};
322 0         0 $foundfile = "$dir/$item";
323 0         0 last;
324             }
325             }
326             }
327             }
328             #
329             # Now, open the file.
330             #
331 0         0 $self->{file_data}->{$file}->{FILE} = new IO::File;
332              
333             #
334             # Did we find a temporary old ratty file to tail from? Either
335             # way, get our current $inode and size.
336             #
337 0 0       0 $self->{file_data}->{$file}->{FILE}->open("< $foundfile") ||
338             die "Failed to open $file [$!].\n";
339 0         0 my ( $inode, $size ) = (stat($foundfile))[1,7];
340              
341 0         0 $self->{file_data}->{$file}->{done}++;
342              
343             #
344             # Clear our array.
345             #
346 0         0 $self->{file_data}->{$file}->{array} = [ ];
347              
348 0 0       0 if ($self->{DB}->{STATFILE}) {
349 0 0       0 if ( $inode == $self->{file_data}->{$file}->{inode} ) {
350             #
351             # We've reopened the same file. Skip ahead to count.
352             #
353 0 0 0     0 if ( $size >= $self->{file_data}->{$file}->{seek} &&
354             sysseek($self->{file_data}->{$file}->{FILE}, $self->{file_data}->{$file}->{seek}, 0 ) ) {
355             #
356             # Successful read. Let's return and be done.
357             #
358 0         0 return 1;
359             }
360             }
361            
362             #
363             # We've opened a new file OR the above if failed and it's a truncated
364             # file, so we start as if we reopened the file anyway.
365             #
366 0         0 $self->{DB}->{STATUS}->{$file} = "$inode:0";
367 0         0 $self->{DB}->sync;
368             }
369 0         0 $self->{file_data}->{$file}->{inode} = $inode;
370 0         0 $self->{file_data}->{$file}->{seek} = 0;
371            
372 0         0 return 1;
373             }
374              
375             sub OpenFileWithOpts {
376 1     1 0 4 my( $self, $key ) = @_;
377             #
378             # Give the file a moment to reappear if it's not there.
379             #
380 1         7 my $filename = $self->{file_data}->{$key}->{opts}->{-current};
381 1         5 LOG()->debug( "filename: $filename" );
382 1 50       81 unless ( -r $filename ) {
383 0         0 sleep 10;
384 0 0       0 unless ( -r $filename ) {
385 0         0 $! = 2;
386 0         0 return undef;
387             }
388             }
389            
390 1         8 my $hostname = $self->{file_data}->{$key}->{opts}->{-host};
391 1         5 my $prefix = $self->{file_data}->{$key}->{opts}->{-prefix};
392             #
393             # Stat it, and see if it's the file we were last tailing if this
394             # is the first time we're trying to open the file.
395             #
396 1         3 my $foundfile = $filename;
397 1 50       7 if ($self->{DB}->{STATFILE}) {
398 0 0       0 if ( ! $self->{file_data}->{$key}->{done} ) {
399             LOG()->debug( sub {
400 0     0   0 my $db_key = "$prefix:$hostname:$filename";
401 0         0 my $db_val = $self->{DB}->{STATUS}->{$db_key};
402 0         0 "$db_key => $db_val";
403 0         0 } );
404 0         0 ( $self->{file_data}->{$key}->{inode}, $self->{file_data}->{$key}->{seek} ) = split(/:/, $self->{DB}->{STATUS}->{"$prefix:$hostname:$filename"} );
405 0         0 my $inode = (stat($filename))[1];
406 0         0 LOG()->debug( "filename: $filename; inode: $inode" );
407 0 0 0     0 if ( $self->{file_data}->{$key}->{inode} &&
408             $inode != $self->{file_data}->{$key}->{inode} ) {
409            
410             #
411             # It's not where we left off. Uh-oh - see if we can find the
412             # last inode we were on when we quit.
413             #
414 0         0 LOG()->debug( "filename: $filename; inode: $inode; self->{file_data}->{$key}->{inode}:$self->{file_data}->{$key}->{inode} " );
415 0         0 my ( $findfile, $dir, $item );
416 0         0 $findfile = basename($filename);
417 0         0 $dir = dirname($filename);
418 0 0       0 opendir(DIR, $dir) ||
419             die "Unable to read directory $dir to search for previous file [$!].\n";
420 0         0 foreach $item ( grep(/^$findfile\.\d+/, readdir DIR ) ) {
421 0 0       0 next unless (stat("$dir/$item"))[1] == $self->{file_data}->{$key}->{inode};
422 0         0 $foundfile = "$dir/$item";
423 0         0 last;
424             }
425             }
426             }
427            
428             }
429             #
430             # Now, open the file.
431             #
432 1 50       6 if (defined $self->{file_data}->{$key}->{FILE}) {
433 0         0 undef $self->{file_data}->{$key}->{FILE};
434             }
435 1         13 $self->{file_data}->{$key}->{FILE} = new IO::File;
436              
437             #
438             # Did we find a temporary old ratty file to tail from? Either
439             # way, get our current $inode and size.
440             #
441 1         65 LOG()->debug( qq( open("< $foundfile") ) );
442 1 50       10 $self->{file_data}->{$key}->{FILE}->open("< $foundfile") ||
443             die "Failed to open $foundfile [$!].\n";
444 1         82 my ( $inode, $size ) = (stat($foundfile))[1,7];
445              
446 1         5 LOG()->debug( "foundfile: $foundfile; inode: $inode; size: $size" );
447 1         4 LOG()->debug( "key: $key; inode: $self->{file_data}->{$key}->{inode}; seek: $self->{file_data}->{$key}->{seek}" );
448              
449 1         5 $self->{file_data}->{$key}->{done}++;
450              
451             #
452             # Clear our array.
453             #
454 1         5 $self->{file_data}->{$key}->{array} = [ ];
455 1 50       6 if ($self->{DB}->{STATFILE}) {
456            
457 0 0       0 if ( $inode == $self->{file_data}->{$key}->{inode} ) {
458             #
459             # We've reopened the same file. Skip ahead to count.
460             #
461 0         0 LOG()->debug( "We've reopened the same file. Skip ahead to count." );
462 0 0 0     0 if ( $size >= $self->{file_data}->{$key}->{seek} &&
463             sysseek($self->{file_data}->{$key}->{FILE}, $self->{file_data}->{$key}->{seek}, 0 ) ) {
464             #
465             # Successful read. Let's return and be done.
466             #
467 0         0 LOG()->debug( "Successful seek. Let's return and be done." );
468 0         0 return 1;
469             }
470             }
471            
472             #
473             # We've opened a new file OR the above if failed and it's a truncated
474             # file, so we start as if we reopened the file anyway.
475             #
476 0         0 LOG()->debug( "We've opened a new file OR same file, but it has been truncated. Start as if we reopened the file anyway." );
477 0         0 $self->{DB}->{STATUS}->{"$prefix:$hostname:$filename"} = "$inode:0";
478 0         0 $self->{DB}->sync;
479             }
480 1         6 $self->{file_data}->{$key}->{inode} = $inode;
481 1         4 $self->{file_data}->{$key}->{seek} = 0;
482            
483 1     0   4 LOG()->debug( sub { $self->{DB}->DumpStatus } );
  0         0  
484              
485 1         12 return 1;
486             }
487              
488             =head2 Watchfile
489              
490             WatchFile(-option1=>"value1", -option2=>"value2", ...)
491              
492             =over 4
493              
494             B
495              
496             =over 4
497              
498             =item -file=>"filename"
499            
500             The name of a file to watch.
501              
502             =back
503              
504             B
505              
506             =over 4
507              
508             =item -type=>"UNIX" (default, i.e. if omitted) or "UNIX-REMOTE"
509              
510             =item -rmtsh=>"ssh" (default) valid values are "rsh" or "ssh"
511              
512             =item -host=>"host"
513              
514             Required for type "UNIX-REMOTE" unless file name is of the form host:filename (similar to rcp).
515              
516             =item -rmtopts=>"-opt1 val1 -opt2 val2"
517              
518             Any flags that should be passed to the remote process. Since these become command-line args, they should have the form "-opt1 val1 -opt2 val2 ...".
519              
520             =item -rmtenv=>"ENV1=val1 ENV1=val2"
521              
522             Any environment variables that should be set on the remote before runnign the
523             remote process.
524              
525             =item -date=>'parsed' or 'gz'
526            
527             indicates special date-related file
528             processing. B is used with files having dates in their
529             name. B is used for files which are archived so that a new
530             open call is needed to continue monitoring. Other archive
531             file extensions can be used in theory, but the file name is
532             assumed to be of the format name.date.extension
533            
534             =item -yrfmt=>2 or 4
535              
536             For files having dates in their name, how
537             many digits are used to represent the year. The default
538             is 2, but a value of 4 may be set with this option.
539            
540             =item -monthdir=>$relative_path
541              
542             for files having dates in their
543             name, to indicate, where applicable, the relative position
544             in the path of the month's directory. E.g. ".."
545            
546             =item -timeout=>$secs
547              
548             Used for an application-specific timeout. If the file does not grow during
549             the specified interval, a message of the form
550             host1:file1:_timeout_999999999 is returned, where 999999999 is
551             secs-in-epoch (UNIX timestamp).
552            
553             =item -request_timeout=>$secs
554              
555             Used for an application-specific timeout. If no data is available within the
556             specified interval from the time the request was made (GetLine() was called), a
557             message of the form host1:file1:_timeout_999999999 is returned, where 999999999
558             is secs-in-epoch (UNIX timestamp).
559            
560             =back
561              
562             B
563              
564             =over 4
565              
566             =item -heartbeat=>"send"
567              
568             Set on the child process for a "UNIX-REMOTE" file. Similarly, flags will
569             be set in the parent process to listen for the heartbeat.
570              
571             When processing a UNIX-REMOTE file, the child process is set to send an
572             internal heartbeat message, and the local process is set to receive them.
573             The heartbeat messages are of the form host1:file1:_heartbeat_999999999
574             where 999999999 is secs-in-epoch (UNIX timestamp).
575              
576             =item -current
577              
578             Holds the current file name. This is used when
579             files with date-suffixed names roll, since the hash entry is
580             still keyed by the original file name.
581            
582             =item -prefix
583              
584             a prefix for the filestatus file, which is used to
585             keep track of the seek pointer between invocations. The default
586             is the path of the calling application.
587            
588             =item -reset=>1
589              
590             will ignore the status file that normally keeps
591             track of Tail's progress through the file, including between
592             invocations
593              
594             =item -clear=>1
595              
596             like -reset, but will remove the file.
597              
598             =back
599              
600             =back
601              
602             =cut
603             sub WatchFile {
604 1     1 0 18 my ($self, %opts) = @_;
605            
606 1         2 %opts = %{$self->ResolveOpts(%opts)};
  1         10  
607 1         12 my $key = $opts{-file};
608 1         9 $self->{file_data}->{$key}->{opts} = \%opts;
609              
610 1 50       9 if ($opts{-type} eq "UNIX"){
    0          
611 1 50       10 $self->OpenFileWithOpts( $key ) ||
612             die "Unable to tail \"$key\" [$!]\n";
613             }
614             elsif ($opts{-type} eq "UNIX-REMOTE") {
615 0 0       0 $self->OpenRemote( %opts ) ||
616             die "Unable to tail \"$key\" [$!]\n";
617             }
618             else {
619 0         0 die "Unknown file type \"$opts{-type}\".\n";
620             }
621             }
622              
623             sub OpenRemote {
624 0     0 0 0 my ($self, %opts) = @_;
625 0         0 my $userflag = "";
626 0         0 my $key = $opts{-file};
627 0         0 my $filename = $opts{-current};
628 0         0 my $hostname = $opts{-host};
629 0         0 my $prefix = $opts{-prefix};
630 0         0 my $rmtenv;
631 0   0     0 my $ssh = $opts{-rmtsh} || $self->{file_data}->{$key}->{opts}->{-rmtsh} || "ssh";
632 0         0 my ($conn_try, $port, $port_try, $ssh_try, $sock, $tmpfile);
633              
634 0 0       0 if ($opts{-user}) {
635 0         0 $userflag = "-l $opts{-user}";
636             }
637 0   0     0 my $rmtopts = $opts{-rmtopts} || "";
638             #
639             # Must have a file type for the remotely tailed file.
640             #
641 0 0       0 if (!$rmtopts =~ /\B-type\s+\w/) {
642 0         0 return undef;
643             }
644              
645              
646 0 0       0 if ($opts{-rmtenv}) {
647 0         0 $rmtenv = "/usr/bin/env $opts{-rmtenv}";
648             }
649             #
650             # Set the filestatus file prefix for the remote process
651             # (if it isn't set already).
652             #
653 0 0       0 $rmtopts = $rmtopts . " -prefix $prefix"
654             unless $rmtopts =~ /\B-prefix\s+\S+/;
655              
656             #
657             # Set the hostname for the remote process (if it isn't set already).
658             #
659 0 0       0 $rmtopts = $rmtopts . " -host $hostname "
660             unless $rmtopts =~ /\B-host\s+\w/;
661              
662             #
663             # Send a heartbeat from the remote process and receive it here.
664             #
665 0 0       0 $rmtopts = $rmtopts . " -heartbeat send "
666             unless $rmtopts =~ /\B-heartbeat\s+send\b/;
667              
668             #
669             # Set the statuskey for the remote process (if it isn't set already).
670             #
671 0         0 ( my $statuskey_base = $self->{DB}->{STATUSKEY} ) =~ s/:.*$//;
672 0 0       0 $rmtopts = $rmtopts . " -statuskey rtail_$statuskey_base "
673             unless $rmtopts =~ /\B-statuskey\s+\w/;
674              
675             $opts{-heartbeat} = "recv"
676 0 0 0     0 unless $opts{-heartbeat} && $opts{-heartbeat} eq "recv";
677            
678             # Kill child process if necessary.
679 0         0 $self->Kill($key);
680              
681 0         0 $ssh_try = 1;
682 0         0 $port_try = 1;
683 0         0 my $fallback_ssh = 0;
684             RSHELL: {
685 0         0 $tmpfile = new IO::File;
  0         0  
686 0         0 my $cmd = "$ssh $hostname -n $userflag $rmtenv $self->{BINDIR}rtail.pl -file $filename $rmtopts < /dev/null |";
687 0         0 LOG()->debug( qq( Preparing to open "$cmd") );
688 0 0       0 unless ($self->{file_data}->{$key}->{child} = $tmpfile->open($cmd)) {
689 0         0 warn "Attempt $ssh_try to open of $ssh pipe for $key failed [$!] , child status [$?]\n";
690 0 0 0     0 if ( ($! =~ /^Interrupted|^Resource|^Bad file/) and ++$ssh_try < 7) {
691 0         0 $self->Kill($key);
692 0         0 undef $tmpfile;
693 0         0 sleep 2;
694 0         0 redo RSHELL;
695             } else {
696 0 0       0 if ($fallback_ssh) {
697 0         0 die "Failure opening $ssh pipe for $key [$!] after $ssh_try attempts [ERR_SSH].\n";
698             } else {
699 0         0 my $old_ssh = $ssh;
700 0 0       0 if ($ssh eq "ssh") {
701 0         0 $ssh = "rsh";
702             } else {
703 0         0 $ssh = "ssh";
704             }
705 0         0 warn "Failure opening $old_ssh pipe for $key [$!] after $ssh_try attempts [ERR_SSH]. Trying to $ssh.\n";
706 0         0 $ssh_try = 0;
707 0         0 $fallback_ssh = 1;
708 0         0 redo RSHELL;
709             }
710             }
711             }
712            
713 0 0       0 unless (fcntl( $tmpfile, F_SETFL, fcntl($tmpfile, F_GETFL, 0) | O_NONBLOCK )) {
714 0         0 die "fcntl of $ssh pipe for $key failed [$!] [ERR_FCNTL].\n";
715             }
716              
717             PORT: {
718 0         0 $port = <$tmpfile>;
  0         0  
719 0         0 $port_try++;
720 0 0       0 if (not defined $port) {
    0          
    0          
721 0 0 0     0 if ($! =~ /^Interrupted/ and $port_try < 20) {
    0 0        
722 0         0 redo PORT;
723             } elsif ($! =~ /^Resource/ and $port_try < 20) {
724 0         0 sleep 2;
725 0         0 redo PORT;
726             } else {
727 0 0       0 if ($fallback_ssh) {
728 0         0 die "Failure reading port from $ssh [$!] after $port_try attempts [ERR_RETRIES].\n";
729             } else {
730 0         0 my $old_ssh = $ssh;
731 0 0       0 if ($ssh eq "ssh") {
732 0         0 $ssh = "rsh";
733             } else {
734 0         0 $ssh = "ssh";
735             }
736 0         0 warn "Failure opening $old_ssh pipe for $key [$!] after $ssh_try attempts [ERR_SSH]. Trying to $ssh.\n";
737 0         0 $ssh_try = 0;
738 0         0 $port_try = 0;
739 0         0 $fallback_ssh = 1;
740 0         0 redo RSHELL;
741             }
742             }
743             } elsif ($port == 0) {
744 0 0       0 die "Failure reading port from $ssh: 0 read after $port_try attempt(s) [ERR_EMPTY].\n" if $port_try > 20;
745 0         0 sleep 2;
746 0         0 redo RSHELL;
747             } elsif ($port =~ /^\d+$/) {
748 0         0 last RSHELL; # Success
749             } else {
750 0         0 die "$cmd failed: $port [ERR_REMOTE]\n"; # Remote error
751             }
752            
753             };
754             };
755              
756            
757 0         0 undef $tmpfile;
758              
759 0 0       0 if (defined $self->{file_data}->{$key}->{FILE}) {
760 0         0 undef $self->{file_data}->{$key}->{FILE};
761             }
762 0         0 $conn_try = 0;
763             CONNECT: {
764 0 0       0 unless ($self->{file_data}->{$key}->{FILE} =
  0         0  
765             new IO::Socket::INET(PeerAddr =>$hostname,
766             PeerPort =>$port,
767             Proto =>'tcp')) {
768 0         0 $conn_try++;
769 0         0 warn "Failed creating socket for $key [$!], after $conn_try attempts\n";
770 0 0 0     0 if ( ($! =~ /^Interrupted|^Resource|^Bad file|^Connection/) and
771             $conn_try < 6) {
772 0         0 undef ($self->{file_data}->{$key}->{FILE});
773 0         0 sleep 2;
774 0         0 redo CONNECT;
775             } else {
776 0         0 die "Failure creating socket for $key [$!], $conn_try attempt(s) [ERR_SOCKET].\n";
777             }
778             }
779             };
780              
781 0 0       0 unless ( fcntl( $self->{file_data}->{$key}->{FILE}, F_SETFL,
782             fcntl($self->{file_data}->{$key}->{FILE}, F_GETFL, 0) |
783             O_NONBLOCK ) ) {
784 0         0 die "fcntl of socket for $key failed [$!] [ERR_SOCKFCNTL].\n";
785             }
786              
787 0         0 $self->{file_data}->{$key}->{done}++;
788              
789             #
790             # Clear our array.
791             #
792 0         0 $self->{file_data}->{$key}->{array} = [ ];
793              
794             #
795             # (Re)set
796             #
797             # No inode for remote connections.
798 0         0 $self->{file_data}->{$key}->{seek} = 0;
799 0 0       0 if ($self->{DB}->{STATFILE}) {
800 0         0 $self->{DB}->{STATUS}->{"$prefix:$hostname:$filename"} = "0:0";
801 0         0 $self->{DB}->sync;
802             }
803             #
804             # (Re)set heartbeat detection.
805             #
806 0         0 $self->{file_data}->{$key}->{heartbeat} = time;
807              
808             #
809             # Add internal opts to object
810             #
811 0         0 $self->{file_data}->{$key}->{opts}->{-rmtopts} = $rmtopts;
812 0         0 $self->{file_data}->{$key}->{opts}->{-heartbeat} = $opts{-heartbeat};
813 0         0 return 1;
814             }
815              
816             =head2 GetLine
817              
818             Format of the returned line is:
819              
820             $hoste1:$file1: line of file here.
821              
822             If a remote file is being followed, heartbeat messages of the form
823             $host1:$file1:_heartbeat_999999999, where 999999999 is secs-in-epoch
824             are returned.
825              
826             If a set of file opts includes a -timeout, and there is no
827             activity on the file within the timeout interval, messages of the form
828             $host1:file1:_timeout_999999999
829             are returned.
830              
831             If a set of file opts includes a -request_timeout, and there is no data to be
832             returned within the timeout interval from the time that GetLine was called,
833             a message of the form $host1:file1:_timeout_999999999 is returned.
834              
835             =cut
836             sub GetLine {
837              
838 4     4 1 2477 my ($self, %doitfn) = @_;
839 4         10 my ($now, $donefiles);
840 0         0 my $request_mark;
841              
842             #
843             # First time through set up index array that we will permute
844             # to reduce bias toward the first files in the keys list.
845             #
846 4 100       19 unless ( defined $self->{KEYS} ) {
847 1         3 $self->{KEYS} = [ keys %{ $self->{file_data} } ];
  1         8  
848 1         3 $self->{FILECOUNT} = scalar @{ $self->{KEYS} };
  1         4  
849             } else {
850 3         8 push @{ $self->{KEYS} }, shift @{ $self->{KEYS} };
  3         11  
  3         14  
851             }
852            
853 4         12 for ( ; ; ) {
854 5   66     46 $request_mark ||= time();
855 5         14 $COUNT++;
856 5 50 66     48 if ( $DIRTY && ! ( $COUNT % 10 ) ) {
857 0         0 $DIRTY = 0;
858 0         0 $self->{DB}->sync;
859             }
860            
861 5         21 $donefiles = $self->{FILECOUNT};
862              
863             #
864             # Now, read through the files. If the file has stuff in its array,
865             # then start by returning stuff from there. If it does not, then
866             # read some more into the file, parse it, and then return it.
867             # Otherwise, go on to the next file.
868             #
869            
870 5         12 FILE: foreach my $key ( @{ $self->{KEYS} } ) {
  5         27  
871 5         10 my $line;
872 5         40 my $filename = $self->{file_data}->{$key}->{opts}->{-current};
873 5         20 my $host = $self->{file_data}->{$key}->{opts}->{-host};
874 5         23 my $prefix = $self->{file_data}->{$key}->{opts}->{-prefix};
875             # If the file has rolled, the name has changed, although it's
876             # still keyed by the original name.
877 5 50 33     70 if (exists $self->{file_data}->{$key}->{opts}->{-heartbeat} &&
    50 33        
878             $self->{file_data}->{$key}->{opts}->{-heartbeat} eq "send") {
879 0         0 my $msg = $self->Heartbeat($key);
880 0 0       0 if (defined $msg) {
881 0         0 return "$key:$msg";
882             }
883             }
884             # If heartbeat fails and the retry limit is exceeded
885             # return message.
886             # $self->{file_data}->{$key}->{heartbeat} will be undefined.
887             elsif (exists $self->{file_data}->{$key}->{opts}->{-heartbeat} &&
888             $self->{file_data}->{$key}->{opts}->{-heartbeat} eq "recv") {
889 0         0 my $msg = $self->CheckBeat($key);
890 0 0       0 if (defined $msg) {
891 0         0 return "$key:$msg";
892             }
893             }
894              
895 5 50       30 if (exists $self->{file_data}->{$key}->{opts}{-timeout}) {
896 0         0 my $msg = $self->CheckTimeout($key);
897 0 0       0 if (defined $msg) {
898 0         0 return "$key:$msg";
899             }
900              
901             }
902              
903 5 50       30 if (exists $self->{file_data}->{$key}->{opts}{-request_timeout}) {
904 5   33     37 my $msg = $self->CheckRequestTimeout($key, $request_mark || time() );
905 5 100       21 if (defined $msg) {
906 1         18 return "$key:$msg";
907             }
908              
909             }
910              
911              
912 4 100       9 if ( ! @{$self->{file_data}->{$key}->{array}} ) {
  4         20  
913             #
914             # If there's nothing left on the array, then read something new in.
915             # This should never fail, I think.
916             #
917 2         5 my $length;
918             SYSREAD: {
919 2         3 $length = $self->{file_data}->{$key}->{FILE}->sysread($line, 1024);
  2         21  
920 2 50       45 unless ( defined $length ) {
921 0 0 0     0 if ($! =~ /^Interrupted/) {
    0          
922 0         0 redo SYSREAD;
923             }
924             elsif ($self->{file_data}->{$key}->{opts}->{-type} eq
925             "UNIX-REMOTE" && $! =~ /^Resource/) {
926 0         0 $donefiles--;
927 0         0 next FILE;
928             }
929             else {
930 0         0 die "sysread of $filename failed [$!].\n";
931             }
932             }
933             };
934              
935 2 100       10 if ( ! $length ) {
936             #
937             # Hmmm...zero length here, perhaps we've been aged out?
938             #
939 1 50       9 if ($self->{file_data}->{$key}->{opts}->{-type} eq "UNIX") {
    0          
940 1         23 my ( $inode, $size ) = (stat($filename))[1,7];
941 1 50 33     27 if ( $self->{file_data}->{$key}->{inode} != $inode ||
942             $self->{file_data}->{$key}->{seek} > $size ) {
943             #
944             # We've been aged (inode diff) or we've been
945             # truncated (our checkpoint is larger than the
946             # file.) Pass the file key to OpenFileWithOpts,
947             # which may be different from the current name.
948             #
949             LOG()->debug( sub {
950 0 0   0   0 my $happened = $self->{file_data}->{$key}->{inode} != $inode ? 'aged' : 'truncated';
951 0         0 "File $filename has been $happened. OpenFileWithOpts( $key ).";
952 0         0 } );
953              
954 0 0       0 $self->OpenFileWithOpts( $key ) ||
955             die "Unable to tail file \"$filename\" [$!]\n";
956             #
957             # For a -request_timeout, don't count the time it
958             # took to OpenFileWithOpts(), or the SLEEP at the
959             # end of this loop. That is, reset $request_mark.
960             #
961             LOG()->debug( sub {
962 0     0   0 'Undefining request_mark at ' . localtime();
963 0         0 } );
964 0         0 undef $request_mark;
965             }
966              
967 1 50       8 if (exists $self->{file_data}->{$key}->{opts}->{-date}) {
968             # We use "rollover" to refer to files whose
969             # names change daily, and the parent process
970             # wants the current file.
971             #
972             # We use "archive" to refer to files whose names
973             # are constant, but the file itself is compressed
974             # or otherwise renamed.
975             #
976 0 0       0 if ($self->{file_data}->{$key}->{opts}->{-date} eq
977             "parsed") {
978             # Need to pass original key here, not current
979             # name.
980 0         0 my $msg = $self->RollFile($key);
981             # Rollover: If a file named with the new date
982             # has appeared, the return is
983             # _rollover_999999999 where the numeric
984             # portion is seconds-in-epoch.
985             # (1) the -timeout option is deleted by a
986             # true timeout, but not by a rollover.
987             # (2) Caller can detect new file name in
988             # -current option after a rollover.
989             # (3) The timed-out counter has been reset
990             # by RollFile if the rollover succeeded.
991 0 0       0 if (defined $msg) {
992             $filename =
993 0         0 $self->{file_data}->{$key}->{opts}->{-current};
994 0         0 return "$key:$msg";
995             }
996             } else {
997 0         0 my $msg = $self->ArchFile($key);
998             # Archive: the value of -date in this case is
999             # the file extension of the archived file.
1000             # Currrently the only name format supported is
1001             # filename.99999999.extension.
1002             # The returned line is:
1003             # _archived_999999999 where
1004             # the numeric portion is seconds-in-epoch.
1005 0 0       0 if (defined $msg) {
1006 0         0 return "$key:$msg";
1007             }
1008             }
1009             }
1010             }
1011             elsif ($self->{file_data}->{$key}->{opts}->{-type} eq
1012             "UNIX-REMOTE") {
1013             # Zero length does not necessarily mean a problem
1014             # for UNIX-REMOTE files. Only reopen if the
1015             # heartbeat fails.
1016 0         0 $donefiles--;
1017 0         0 next FILE;
1018             }
1019             else {
1020 0         0 die "Bogus file type\n";
1021             }
1022            
1023             #
1024             # In any case, we didn't read anything, so go to the
1025             # next FILE;
1026             #
1027 1         4 $donefiles--;
1028 1         10 next FILE;
1029             }
1030            
1031             #
1032             # We read something! Mark the time if required.
1033             # Don't forget to add on anything we may have read before.
1034             # Build our array by splitting our latest read plus whatever
1035             # is saved.
1036             #
1037 1         2 $now = time;
1038 1 50       8 if (exists $self->{file_data}->{$key}->{opts}{-timeout}) {
1039 0         0 $self->{file_data}->{$key}->{filetime} = $now;
1040             }
1041 1 50       6 if (defined $self->{file_data}->{$key}->{heartbeat}) {
1042 0         0 $self->{file_data}->{$key}->{heartbeat} = $now;
1043             }
1044              
1045 1         10 $self->{file_data}->{$key}->{array} = [ split( /^/m, $self->{file_data}->{$key}->{line} . $line) ];
1046              
1047             #
1048             # If there's a leftover piece, then save it in the "line". Otherwise,
1049             # clear it out.
1050             #
1051 1 50       4 if ( substr($self->{file_data}->{$key}->{array}->[$#{$self->{file_data}->{$key}->{array}}],
  1         16  
1052             -1, 1) ne "\n" ) {
1053 0         0 $self->{file_data}->{$key}->{line} = pop @{$self->{file_data}->{$key}->{array}};
  0         0  
1054 0 0       0 next unless @{$self->{file_data}->{$key}->{array}};
  0         0  
1055             } else {
1056 1         5 undef $self->{file_data}->{$key}->{line};
1057             }
1058             }
1059            
1060             #
1061             # If we make it here, then we have something on our array.
1062             # If it's a heartbeat, continue (we marked it above).
1063             # Otherwise increment our counter, sync up our disk file,
1064             # and return the line.
1065             #
1066 3         8 my $return = shift @{$self->{file_data}->{$key}->{"array"}};
  3         12  
1067 3 50       15 if ($return =~ /(_heartbeat_)(\d+)/) {
1068 0         0 $donefiles--;
1069 0         0 next FILE;
1070             }
1071              
1072 3         6 $DIRTY++;
1073              
1074 3 50       17 if ($self->{file_data}->{$key}->{opts}->{-type} eq "UNIX-REMOTE") {
1075 0         0 my ($host, $file, $msg) = split(/:/, $return, 3);
1076             #
1077             # See comment at IsRollover().
1078             #
1079 0         0 my @roll = $self->IsRollover($msg);
1080 0 0       0 if ($roll[1]) {
1081 0         0 $self->{file_data}->{$key}->{opts}->{-current} = $roll[0];
1082             }
1083 0         0 $self->{file_data}->{$key}->{seek} += length($msg);
1084 0 0       0 if ($self->{DB}->{STATFILE}) {
1085 0         0 $self->{DB}->{STATUS}->{"$prefix:$host:$filename"} =
1086             "$self->{file_data}->{$key}->{inode}:$self->{file_data}->{$key}->{seek}";
1087             }
1088 0         0 return "$key:$msg";
1089             }
1090             else {
1091 3         13 $self->{file_data}->{$key}->{seek} += length($return);
1092 3 50       16 if ($self->{DB}->{STATFILE}) {
1093 0         0 $self->{DB}->{STATUS}->{"$prefix:$host:$filename"} =
1094             "$self->{file_data}->{$key}->{inode}:$self->{file_data}->{$key}->{seek}";
1095             }
1096 3         26 return "$key:$return";
1097             }
1098             }
1099             #
1100             # Still here? That means we redo the loop. But first ...
1101             #
1102             # Run the DoIt function every $BATCHLIM records.
1103             #
1104            
1105 1 50       7 if (! ($COUNT % $BATCHLIM)) {
1106 0 0       0 if (%doitfn) {
1107 0         0 $doitfn{-doitfn}->(); # run it
1108             }
1109             }
1110             #
1111             # Sleep only if all files are temporarily unavailable.
1112             #
1113 1 50       2000199 sleep ($SLEEP) unless $donefiles;
1114             }
1115             }
1116              
1117             =head2 Heartbeat
1118              
1119             =cut
1120             sub Heartbeat {
1121 0     0 1 0 my $self = shift;
1122 0         0 my $key = shift;
1123 0         0 my $now = time;
1124 0 0 0     0 if ($self->{file_data}->{$key}->{heartbeat} eq undef ||
1125             $self->{file_data}->{$key}->{heartbeat} < $now - $BEAT +$SLEEP) {
1126 0         0 my $msg = "_heartbeat_$now\n";
1127 0         0 $self->{file_data}->{$key}->{heartbeat} = $now;
1128 0         0 return $msg;
1129             }
1130             else {
1131 0         0 return undef;
1132             }
1133             }
1134              
1135             =head2 ResetHeartBeats
1136              
1137             Use e.g. if monitor has been paused. Start checking for heartfailure
1138             again now.
1139              
1140             =cut
1141             sub ResetHeartbeats {
1142 0     0 0 0 my $self = shift;
1143 0         0 my $now = time;
1144 0         0 foreach my $key ( keys %{ $self->{file_data} } ) {
  0         0  
1145 0 0       0 if ($self->{file_data}->{$key}->{opts}->{-heartbeat} eq 'recv') {
1146 0         0 $self->{file_data}->{$key}->{heartbeat} = $now;
1147             }
1148             }
1149             }
1150              
1151             =head2 CheckBeat
1152              
1153             =cut
1154             sub CheckBeat{
1155 0     0 1 0 my $self = shift;
1156 0         0 my $key = shift;
1157 0         0 my $now = time;
1158 0         0 my $return = undef;
1159              
1160 0 0 0     0 if ($self->{file_data}->{$key}->{heartbeat} &&
1161             $now - $self->{file_data}->{$key}->{heartbeat} > $BEATOUT) {
1162 0 0       0 if ($self->{file_data}->{$key}->{retries}++ > $MAX_RETRIES) {
1163 0         0 $self->{file_data}->{$key}->{FILE}->close();
1164 0         0 $self->Kill($key);
1165 0         0 undef $self->{file_data}->{$key}->{heartbeat};
1166 0         0 $return = "_heartfailure_$now\n";
1167             }
1168             else {
1169 0         0 sleep (2 ** $self->{file_data}->{$key}{retries});
1170 0         0 $self->WatchFile(%{$self->{file_data}->{$key}->{opts}});
  0         0  
1171             }
1172             }
1173 0         0 return $return;
1174             }
1175              
1176             =head2 CheckTimeout
1177              
1178             =cut
1179             sub CheckTimeout {
1180 0     0 1 0 my $self = shift;
1181 0         0 my $key = shift;
1182 0         0 my $now = time;
1183 0         0 my $return = undef;
1184             $self->{file_data}->{$key}->{filetime} = $now
1185 0 0       0 unless $self->{file_data}->{$key}->{filetime};
1186 0 0       0 if ($now - $self->{file_data}->{$key}->{filetime} >
1187             $self->{file_data}->{$key}->{opts}{-timeout} - $SLEEP) {
1188 0         0 delete $self->{file_data}->{$key}->{opts}->{-timeout};
1189 0         0 $return = "_timeout_$now\n";
1190             }
1191 0         0 return $return;
1192             }
1193              
1194             =head2 CheckRequestTimeout
1195              
1196             =cut
1197              
1198             sub CheckRequestTimeout {
1199 5     5 1 13 my $self = shift;
1200 5         12 my $key = shift;
1201 5         12 my $request_mark = shift;
1202 5         14 my $now = time();
1203 5         11 my $return = undef;
1204              
1205 5 100       37 if ($now - $request_mark > $self->{file_data}->{$key}->{opts}{-request_timeout} ) {
1206 1         16 $return = "_timeout_request_$now\n";
1207             }
1208 5         22 return $return;
1209             }
1210              
1211             =head2 Kill
1212              
1213             =cut
1214             sub Kill {
1215 0     0 1 0 my $self = shift;
1216 0         0 my $key = shift;
1217 0 0       0 if ($self->{file_data}->{$key}->{child}) {
1218 0         0 my $child = $self->{file_data}->{$key}->{child};
1219 0         0 kill 'TERM', $child;
1220 0         0 sleep 2;
1221 0   0     0 kill 0, $child &&
1222             kill 'KILL', $child;
1223             }
1224             }
1225              
1226             =head2 ArchFile
1227              
1228             =cut
1229             sub ArchFile {
1230 0     0 1 0 my $self = shift;
1231 0         0 my $key = shift;
1232 0         0 my $return = undef;
1233 0         0 my $now = time;
1234 0         0 my $fname = $self->{file_data}->{$key}->{opts}->{-current};
1235 0         0 my $ext = $self->{file_data}->{$key}->{opts}->{-date};
1236 0         0 my $archname = "$fname.$TOMORROW.$ext";
1237 0 0       0 if (-r $archname) {
1238 0         0 $TODAY = $TOMORROW;
1239 0         0 $TOMORROW = rolldate ($TODAY, 4);
1240             #
1241             # Open the new file (with the same name)
1242             #
1243 0 0       0 if ($self->OpenFileWithOpts( $key ) ) {
1244 0         0 $return = "_archived_$now\n";
1245             }
1246             }
1247 0         0 return $return;
1248             }
1249              
1250             =head2 RollFile
1251              
1252             =cut
1253             sub RollFile {
1254 0     0 1 0 my $self = shift;
1255 0         0 my $key = shift;
1256 0         0 my $return = undef;
1257 0         0 my $now = time;
1258 0         0 my ($base, $datepart, $dir, $monthdir, $name, $newdate, $newname, $pre, $yrfmt);
1259 0         0 $name = $self->{file_data}->{$key}->{opts}->{-current};
1260 0         0 $dir = dirname($name);
1261 0         0 $base = basename($name);
1262 0         0 $monthdir = $self->{file_data}->{$key}->{opts}->{-monthdir};
1263 0         0 $yrfmt = $self->{file_data}->{$key}->{opts}->{-yrfmt};
1264 0 0       0 if ($base =~ /(^[\/A-Za-z]*)([0-9]+)$/) {
1265 0         0 $pre = $1;
1266 0         0 $datepart = $2;
1267 0         0 $newdate = rolldate($datepart, $yrfmt);
1268 0 0       0 if (defined $monthdir) {
1269 0         0 my $curym = int 0.01 * $datepart;
1270 0         0 my $newym = int 0.01 * $newdate;
1271 0         0 my @arr = split (/\//, $dir);
1272 0 0       0 if ($curym ne $newym) {
1273 0         0 my $p = -1;
1274 0         0 my $i = 0;
1275 0         0 while (($p = index($monthdir, "..", $p)) > -1) {
1276 0         0 $i++;
1277 0         0 $p++;
1278             }
1279 0 0 0     0 die "RollFile cannot determine month directory.\n" if ($i < 0 or $i > $#arr);
1280 0         0 @arr[scalar(@arr) - $i] = $newym;
1281 0         0 $dir = join("\/", @arr);
1282             }
1283             }
1284 0         0 $newname = "$dir/$pre$newdate";
1285 0 0       0 if (-r $newname) {
1286 0         0 close($self->{file_data}->{$key}->{FILE});
1287 0         0 $self->{file_data}->{$key}->{opts}->{-current} = $newname;
1288             # (Re)initialize timed-out counter.
1289 0 0       0 if ($self->{file_data}->{$key}->{timedout}) {
1290 0         0 $self->{file_data}->{$key}->{timedout} = 0;
1291             }
1292             # Reset {done} flag
1293 0 0       0 if ($self->{file_data}->{$key}->{done}) {
1294 0         0 $self->{file_data}->{$key}->{done} = 0;
1295             }
1296             #
1297             # Open the new file
1298             #
1299 0 0       0 $self->OpenFileWithOpts( $key )
1300             or return undef;
1301             #
1302             #
1303             #
1304 0         0 $return = '_rollover_' . $now . '_' . $newname . '_';
1305 0         0 return "$return\n";
1306             }
1307             }
1308 0         0 return undef;
1309             }
1310              
1311             sub rolldate {
1312 5     5 0 14 my $date = shift;
1313 5         7 my $yrfmt = shift; # positions we would like for the year in the result.
1314 5         9 my ($yr, $mon, $day, $newdate);
1315 5         19 $yr = int $date * 0.0001;
1316 5         10 $day = ($date % 10000) % 100;
1317 5         12 $mon = int 0.01 * ($date % 10000);
1318             #
1319             # Arbitrary choice to treat year numbers < 50 as in 2000s.
1320             #
1321 5 50       17 if ($yr < 100) {
1322 0 0       0 if ($yr < 50) {
1323 0         0 $yr += 2000;
1324             }
1325             else {
1326 0         0 $yr += 1900;
1327             }
1328             }
1329 5         29 my $time = timelocal(0, 0, 3, $day, ($mon - 1), $yr);
1330 5         300 $newdate = fmtime($time + 86400, $yrfmt);
1331              
1332 5         16 return $newdate;
1333             }
1334              
1335              
1336             =head2 Size
1337              
1338             =cut
1339             sub Size {
1340 0     0 1 0 my $self = shift;
1341 0         0 my $key = shift;
1342 0 0       0 if (exists $self->{file_data}->{$key}->{seek}) {
1343 0         0 return $self->{file_data}->{$key}->{seek};
1344             } else {
1345 0         0 return undef;
1346             }
1347             }
1348              
1349             #
1350             # Format a seconds-in-epoch time as a date with 2 to 4 positions in the year
1351             # Called as fmtime( $unixtime, 4 );
1352             # Second parameter is optional and defaults to 2.
1353             #
1354             sub fmtime {
1355 10     10 0 16 my $time = shift;
1356 10         17 my $yrfmt = shift; # positions we would like for the year in the result.
1357 10         13 my ($fmt, $sec, $min, $hrs, $day, $mon, $yr, $newdate);
1358              
1359 10         250 ($sec, $min, $hrs, $day, $mon, $yr) = localtime ($time);
1360 10 50 33     134 $yrfmt = 2
      33        
1361             unless $yrfmt && $yrfmt ge 2 && $yrfmt lt 5;
1362 10         24 $fmt = "%".$yrfmt.".u%2.u%2.u";
1363 10         53 $newdate = sprintf($fmt, (($yr + 1900) % 10 ** $yrfmt), ($mon + 1), $day);
1364 10         19 $newdate =~ s/ /0/g;
1365 10         24 return $newdate;
1366             }
1367              
1368             =head2 Detecting Exception Notification
1369              
1370             The following functions may be used to determine if a returned line
1371             is a notification of exception conditions.
1372              
1373             Called as:
1374              
1375             $tail = new File::SmartTail;
1376             $line = $tail->GetLine();
1377             $tail->WatchFile(%options);
1378             ($host, $file, $rec) = split (/:/, $line, 3);
1379             if ($tail->IsFn($rec)) { # do what you like };
1380              
1381             where IsFn represents one of the Is-prefixed functions below.
1382             All of the IsFns return 1 if the named condition is present, else undef.
1383              
1384             =head2 IsTimeout
1385              
1386             An application timeout has been exceeded.
1387              
1388             =cut
1389             sub IsTimeout {
1390 0     0 1 0 my $self = shift;
1391 0         0 my $line = shift;
1392 0         0 my $return = undef;
1393 0 0       0 if ($line =~ /(_timeout_)(\d+)/) {
1394 0         0 $return = 1;
1395             }
1396            
1397 0         0 return $return;
1398             }
1399              
1400             =head2 IsRequestTimeout
1401              
1402             An application timeout has been exceeded.
1403              
1404             =cut
1405             sub IsRequestTimeout {
1406 0     0 1 0 my $self = shift;
1407 0         0 my $line = shift;
1408 0         0 my $return = undef;
1409 0 0       0 if ($line =~ /(_timeout_request_)(\d+)/) {
1410 0         0 $return = 1;
1411             }
1412            
1413 0         0 return $return;
1414             }
1415              
1416             =head2 IsRollover
1417              
1418             A -date=>'parsed' file has rolled to the next day. In array context,
1419             returns (newfilename, 1) if true
1420              
1421             !Note: returns 1 in scalar context, and an array with elt 0 containing
1422             the new filename in array context.
1423              
1424             =cut
1425             sub IsRollover {
1426 0     0 1 0 my $self = shift;
1427 0         0 my $line = shift;
1428 0         0 my $return = undef;
1429 0 0       0 if ($line =~ /(_rollover_)(\d+)(_)(.*)_$/) {
1430 0         0 $return = $4;
1431             }
1432            
1433 0         0 return ($return, defined($return));
1434             }
1435              
1436             =head2 IsArchived
1437              
1438             A -date=>'gz' file has been gzip'd (archived).
1439              
1440             =cut
1441             sub IsArchived {
1442 0     0 1 0 my $self = shift;
1443 0         0 my $line = shift;
1444 0         0 my $return = undef;
1445 0 0       0 if ($line =~ /(_archived_)(\d+)/) {
1446 0         0 $return = 1;
1447             }
1448            
1449 0         0 return $return;
1450             }
1451              
1452             =head2 IsHeartFailure
1453              
1454             The internal heartbeat has not been detected for longer than the
1455             prescribed interval (currently 120 seconds).
1456              
1457             =cut
1458             sub IsHeartFailure {
1459 0     0 1 0 my $self = shift;
1460 0         0 my $line = shift;
1461 0         0 my $return = undef;
1462             #
1463             # If the heartbeat is not received within the prescribed interval,
1464             # and the max retries are exhausted, a message is sent.
1465 0 0       0 if ($line =~ /(_heartfailure_)(\d+)/) {
1466 0         0 $return = 1;
1467             }
1468            
1469 0         0 return $return;
1470             }
1471              
1472             =head2 IsZipd
1473              
1474             The file options include -date=>'gz'
1475              
1476             =cut
1477             sub IsZipd {
1478 0     0 1 0 my %opts = @_;
1479 0         0 my $return = undef;
1480 0 0       0 if (%opts) {
1481 0 0 0     0 if ( ($opts{-date} eq 'gz') or
1482             $opts{-rmtopts} =~ /-date\s+gz/ ) {
1483 0         0 $return++;
1484             }
1485             }
1486 0         0 return $return;
1487             }
1488              
1489             # Nonmember functions:
1490              
1491             # From given opts (minimum: -file=>filename) supply defaults as
1492             # necessary to fill in key, filename, host, and type.
1493              
1494             sub ResolveOpts {
1495 1     1 0 2 my $self = shift;
1496 1         6 my %opts = @_;
1497             # If we have hostname:filename, that's the key.
1498             # If we have -host and it's different, complain.
1499             # If no host is given use Sys::Hostname
1500             #
1501             # If no explicit -prefix, use the path name of the executing file.
1502 1         7 my ($tmpa, $tmpb) = split (/:/, $opts{-file}, 2);
1503 1         3 my ($key, $host, $filename);
1504 1 50       6 if (defined $tmpb) {
1505 0         0 $key = $opts{-file};
1506 0         0 $filename = $tmpb;
1507 0 0       0 if (exists $opts{-host}) {
1508 0 0       0 if ($opts{-host} ne $tmpa) {
1509 0         0 die "Ambiguous host: -file => $opts{-file} and -host => $opts{-host}\n";
1510             }
1511             } else {
1512 0         0 $opts{-host} = $tmpa;
1513             }
1514             } else {
1515 1         3 $filename = $tmpa;
1516             $opts{-host} = hostname
1517 1 50       11 unless (exists $opts{-host});
1518 1         19 $host = $opts{-host};
1519 1         5 $key = "$host:$filename";
1520 1         4 $opts{-file} = $key;
1521             }
1522            
1523 1 50       6 unless (exists $opts{-current}) {
1524 1         5 $opts{-current} = $filename
1525             }
1526              
1527 1 50       13 unless (exists $opts{-type}) {
1528 1         10 $opts{-type} = "UNIX";
1529             }
1530              
1531 1 50       6 unless (exists $opts{-rmtsh}) {
1532 1         5 $opts{-rmtsh} = "ssh";
1533             }
1534              
1535 1         18 $opts{-prefix} = normalize_prefix( $opts{-prefix} ) ;
1536             # unless (exists $opts{-prefix}) {
1537             # my @path = fileparse($0);
1538             # if ($path[1] eq "\.\/") {
1539             # $path[1] = `pwd &2>&1`;
1540             # chomp $path[1];
1541             # $path[1] .= "\/";
1542             # }
1543             # $opts{-prefix} = $path[1] . $path[0] . $path[2];
1544             # }
1545              
1546 1 50       10 if (exists $opts{'-clear'}) {
1547 0 0       0 if (-f $self->{DB}->{STATFILE}) {
1548 0   0     0 unlink $self->{DB}->{STATFILE} || die "Cannot unlink $self->{DB}->{STATFILE}";
1549             }
1550 0         0 $self->{DB}->{STATFILE} = "";
1551             }
1552 1 50       9 if (exists $opts{'-reset'}) {
1553 1         5 $self->{DB}->{STATFILE}=""
1554             }
1555              
1556 1 50       7 if ( exists $opts{'-request_timeout'} ) {
1557 1 50       16 if ($opts{'-request_timeout'} < 1) {
1558 0         0 $opts{'-request_timeout'} = 1;
1559             }
1560             }
1561              
1562 1         25 return \%opts;
1563             }
1564              
1565             sub FileType {
1566 0     0 0 0 my %opts = @_;
1567 0         0 my $return = undef;
1568              
1569 0 0       0 if (%opts) {
1570 0         0 $return = $opts{-type};
1571             }
1572              
1573 0         0 return $return;
1574             }
1575              
1576             sub HostUser {
1577 0     0 0 0 my %opts = @_;
1578 0         0 my $return = undef;
1579              
1580 0 0       0 if (%opts) {
1581 0         0 my @array;
1582 0         0 push @array, $opts{-host};
1583 0         0 push @array, $opts{-user};
1584 0         0 $return = \@array;
1585             }
1586 0         0 return $return;
1587             }
1588              
1589             sub Filename {
1590 0     0 0 0 my %opts = @_;
1591 0         0 my $return = undef;
1592              
1593 0 0       0 if (%opts){
1594 0         0 $return = $opts{-current};
1595             }
1596              
1597 0         0 return $return;
1598             }
1599              
1600             sub Key {
1601 0     0 0 0 my %opts = @_;
1602 0         0 my $return = undef;
1603              
1604 0 0       0 if (%opts){
1605 0         0 $return = $opts{-file};
1606             }
1607              
1608 0         0 return $return;
1609             }
1610              
1611             sub DateOpt {
1612 0     0 0 0 my %opts = @_;
1613 0         0 my $return = undef;
1614              
1615 0 0       0 if (%opts){
1616 0         0 $return = $opts{-date};
1617             }
1618              
1619 0         0 return $return;
1620             }
1621              
1622             sub RmtOpts {
1623 0     0 0 0 my %opts = @_;
1624 0         0 my $return = undef;
1625 0 0       0 if (%opts) {
1626 0         0 $return = $opts{-rmtopts};
1627             }
1628 0         0 return $return;
1629             }
1630              
1631             {
1632             my $v;
1633             sub LOG {
1634 5   33 5 0 73 $v ||= require File::SmartTail::Logger && File::SmartTail::Logger::LOG();
      66        
1635             }
1636             }
1637              
1638             #
1639             # Attempt to normalize path of prefix.
1640             #
1641             # If an arbitrary string (not the name of an existing file) is passed as -prefix,
1642             # return input untouched, for backwards compatibility.
1643             # If an existing filename is passed as -prefix (and for default of $0),
1644             # resolve any symlinks in path.
1645             #
1646             sub normalize_prefix {
1647 1   33 1 0 9 my $prefix = shift || $0;
1648              
1649 1 50       26 -e $prefix or
1650             return $prefix;
1651 1         9 require File::Basename;
1652 1         26 my ($name,$path,$suffix) = File::Basename::fileparse( $prefix );
1653 1 50       5 $name = '' unless $name;
1654 1 50       5 $path = '' unless $path;
1655 1 50       6 $suffix = '' unless $suffix;
1656 1         10 require Cwd;
1657 1 50       57 $path = Cwd::abs_path( $path ) or
1658             return $prefix;
1659 1 50       10 $path =~ m{/$} or $path .= '/';
1660 1         11 return $path . $name . $suffix;
1661             }
1662              
1663             =head1 Examples
1664              
1665             =head2 Regular local file
1666              
1667             use File::SmartTail;
1668              
1669             $file = "/tmp/foo"
1670             $tail = new File::SmartTail($file);
1671              
1672             while($line = $tail->Tail) {
1673             print $line;
1674             }
1675              
1676             or
1677              
1678             use File::SmartTail;
1679              
1680             $file = "/tmp/foo"
1681             $tail = new File::SmartTail();
1682             $tail->WatchFile(-file=>$file);
1683              
1684             while($line = $tail->GetLine) {
1685             print $line;
1686             }
1687              
1688             =head2 Regular remote file on two hosts
1689              
1690             use File::SmartTail;
1691              
1692             $file = "/tmp/foo";
1693              
1694             $tail = new File::SmartTail;
1695             $tail->WatchFile(-file=>$file, -type=>"UNIX-REMOTE", -host=>"guinness", -rmtopts
1696             =>"-type UNIX");
1697             $tail->WatchFile(-file=>$file, -type=>"UNIX-REMOTE", -host=>"corona", -rmtopts=>
1698             "-type UNIX");
1699              
1700             while($line = $tail->GetLine()) {
1701             print $line;
1702             }
1703              
1704             =head2 Local file, with timeout
1705              
1706             use File::SmartTail;
1707              
1708             $file = "/tmp/foo";
1709              
1710             $tail = new File::SmartTail;
1711             $tail->WatchFile(-file=>$file, -type=>"UNIX", -timeout=>70);
1712              
1713             while($line = $tail->GetLine()) {
1714             print $line;
1715             }
1716              
1717             =head2 Remote file named by date, 4-digit year, having month directory
1718              
1719             use File::SmartTail;
1720              
1721             $file = "guinness:/tmp/foo20011114";
1722              
1723             $tail = new File::SmartTail;
1724             $tail->WatchFile(-file=>$file, -type=>"UNIX-REMOTE", -rmtopts=>'-date parsed -yrfmt 4 -monthdir ".." -type UNIX');
1725              
1726             while($line = $tail->GetLine()) {
1727             print $line;
1728              
1729              
1730             =cut
1731              
1732             1;