File Coverage

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