File Coverage

blib/lib/File/Tail/Multi.pm

Criterion	Covered	Total	%
statement	346	673	51.4
branch	98	314	31.2
condition	20	102	19.6
subroutine	33	49	67.3
pod	8	32	25.0
total	505	1170	43.1

package File::Tail::Multi;
#
# Copyright (c) 2008 Arvind Tripathy.  All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# Following are other pachages needed for File::Tail::Multi
#
use Carp;
use strict;
use File::stat qw(:FIELDS);
use File::Basename;
use FileHandle;
use DirHandle;
use vars qw( $AUTOLOAD $LastScan $True $False $DEBUG $LastRun_File $DO_MD5_Check $VERSION $GMT $TC $FileAttributeChanged );
#
# Define sub
#
sub new;
sub update_attribute;
sub getparams;
sub GetParams;
sub CheckAttributes;
sub CreateFileDataStructure;
sub CreateListOfFiles;
sub OpenFileToTail;
sub readline;
sub read;
sub print;
sub printpat;
sub printexceptpat;
sub printstat;
sub getFilePos;
sub getFileSize;
sub Patterns;
sub Prefix;
sub RemoveDups;
sub CheckIfArrayOrFile;
sub ExceptPatterns;
sub OpenUpdateFiles;
sub UpdateStat;
sub Time;
sub version;
sub debug;
sub close_all_files;
sub FileState;
sub SetFileState;
sub PosFileMark;
sub printfilestates;
sub match_closure;
#
$True=1;
$False=0;
$GMT=$False;
$TC=$False;
$LastScan=time;
$DEBUG=$False;
$LastRun_File="";
$DO_MD5_Check=0;
$VERSION=0.1;
$FileAttributeChanged=$False;
my $pattern_sub;
my $exceptpattern_sub;
my %Attribute=();
my @File_Data_Structure;
my @StatArray = qw { dev ino mode nlink uid gid rdev size
         atime mtime ctime blksize blocks }; # Stat ids
#
# Code added for MSWin32
#
my $MSWin32 = ( $^O eq "MSWin32" ) ? $True : $False;
#
########################################################################
#
# Creating a new File::Tail::Multi object
#
########################################################################
#
sub new {
	my $class=shift;
	my(%argvs)=@_;
	my $args = getparams(\%argvs);
	my $self;
	my $rds;
	#
	# set default vars
	#
	my %Default=();
	$Default{'Files'}=$False;
	$Default{'MaxAge'}=10;
	$Default{'NumLines'}=10;
	$Default{'OutputPrefix'}=$False;
	$Default{'Pattern'}=$False;
	$Default{'ExceptPattern'}=$False;
	$Default{'ScanForFiles'}=$False;
	$Default{'RemoveDuplicate'}=$False;
	$Default{'Function'}=$False;
	$Default{'LastRun_File'}="";
	$Default{'DO_MD5_CHECK'}=$False;
	$Default{'Debug'}=$False;
	#
	foreach my $keys ( keys %$args ) {
		$args->{$keys}=$Default{$keys} if  ( ! exists $args->{$keys} );
	}
	#
	$DEBUG=$args->{'Debug'};
	$LastRun_File=$args->{'LastRun_File'};
	$DO_MD5_Check=$args->{'DO_MD5_Check'};
	#
	if ( $args->{'Files'} ) {
		$rds=CreateFileDataStructure( CreateListOfFiles($args->{'Files'})),
	}
	# convert hash array to constant var
	#
	%Attribute = (
		Files   => $args->{'Files'},
		MaxAge  => $args->{'MaxAge'},
		NumLines => $args->{'NumLines'},
		OutputPrefix => $args->{'OutputPrefix'},
		Pattern => $args->{'Pattern'},
		ExceptPattern => $args->{'ExceptPattern'},
		ScanForFiles => $args->{'ScanForFiles'},
		RemoveDuplicate => $args->{'RemoveDuplicate'},
		Function => $args->{'Function'},
		LastRun_File => $args->{'LastRun_File'},
		DO_MD5_CHECK => $args->{'DO_MD5_Check'},
		Debug => $args->{'Debug'} || 0,
		FileArray => $rds,
	);
	$self=\%Attribute;
	bless $self, $class;
	CheckAttributes($self);
	#
	return $self;

}
#
########################################################################
#
# Update Object Attribute
#
########################################################################
#
sub update_attribute {
	my ($rFD)=shift;
	my(%argvs)=@_;
	my $args = getparams(\%argvs);
	#
	foreach my $keys ( keys %$args ) {
		if ( $keys eq "Files" ) {
			$FileAttributeChanged=$True;
		}
		$rFD->{$keys}=$args->{$keys} if $args->{$keys};
	}
}
#
########################################################################
#
# Front end to Getparams function for File::Tail::Multi
#
########################################################################
#
sub getparams {
	my($rargvs)=@_;
	my ($MaxAge,$NumLines, $OutputPrefix,$Pattern,
		$ExceptPattern,$Debug,$ScanForFiles,$RemoveDuplicate,
		$Function,$LastRun_File,$DO_MD5_Check,$Files);
	my $args =
        GetParams $rargvs,
        {   MaxAge        => \$MaxAge,
            NumLines      => \$NumLines,
            OutputPrefix  => \$OutputPrefix,
            Pattern       => \$Pattern,
            ExceptPattern => \$ExceptPattern,
            Debug         => \$Debug,
            ScanForFiles  => \$ScanForFiles,
            RemoveDuplicate  => \$RemoveDuplicate,
            Function  	  => \$Function,
			LastRun_File  => \$LastRun_File,
			DO_MD5_CHECK	  => \$DO_MD5_Check,
            Files         => \$Files,
        },
        [qw(MaxAge NumLines OutputPrefix Pattern ExceptPattern Debug
				ScanForFiles RemoveDuplicate Function Files)];
	#
}
#
########################################################################
#
# Check each Attributes for Min and Max Values
#
# Exit Codes
#	 1001 - MaxAge is less the zero
#	 1002 - NumLines is less the zero
#	 1003 - OutputPrefix must one ( )
#	 1004 - Pattern must is not a file or ARRAY
#	 1005 - ExceptPattern is not a file or ARRAY
#	 1006 - Debug is not 0 or 1
#	 1007 - ScanForFiles is less the zero
#	 1008 - RemoveDuplicate is not 0 or 1
#	 1009 - Function is not ref to fuction
#	 1010 - File attribute not set
#	 1011 - LastRun File not found or incorrect path
#	 1012 - DO_MD5_Check is not 0 or 1
#
########################################################################
#
sub CheckAttributes {
	my($args)=shift;
	local($_);
	for ( keys %$args ) {
		/MaxAge/ and do { # /MaxAge/ must be >= zero
			if ( $args->{MaxAge} < 0 ) {
				print STDOUT "ERROR: File::Tail::Multi object MaxAge must be >= zero\n";
		  		exit 1001;
			}
			next;
		};
		/NumLines/ and do { # /NumLines/ must be >= zero
			if ( $args->{NumLines} < 0 ) {
				print STDOUT "ERROR: File::Tail::Multi object NumLines must be >= zero\n";
		 		exit 1002;
			}
			next;
		};
		/OutputPrefix/ and do { # /OutputPrefix/ must be a file or ARRAY
			unless ( $args->{OutputPrefix} =~ /^(p|f|t|tg|tc|pt|ptg|ptc|ft|ftg|ftc|tp|tpg|tpc|tf|tfg|tfc)$/){
				next if ! $args->{OutputPrefix};
				print STDOUT "ERROR: File::Tail::Multi object OutputPrefix must ARRAY of file\n";
		 		exit 1003;
			}
			next;
		};
		/Pattern/ and do { # /Pattern/ must be a file or ARRAY
			next if ! $args->{Pattern};
			no strict 'refs';
			if ( ref($args->{Pattern}) ne "ARRAY" and ! -f $args->{Pattern} ) {
				print STDOUT "ERROR: File::Tail::Multi object Pattern must ARRAY or file\n";
		 		exit 1004;
			}
			next;
		};
		/ExceptPattern/ and do { # /ExceptPattern/ must be a file or ARRAY
			next if ! $args->{ExceptPattern};
			if ( ref($args->{ExceptPattern}) ne "ARRAY" and ! -f $args->{ExceptPattern} ) {
				print STDOUT "ERROR: File::Tail::Multi object ExceptPattern must ARRAY or file\n";
		 		exit 1005;
			}
			next;
		};
		/Debug/ and do { # /Debug/ must be 0 or 1
			unless ( $args->{Debug} =~ /^[0|1]$/ ) {
				print STDOUT "ERROR: File::Tail::Multi object Debug must 0 or 1\n";
		 		exit 1006;
			}
			next;
		};
		/ScanForFiles/ and do { # /ScanForFiles/ must be 0 or 1
			if ( $args->{ScanForFiles} < 0 ) {
				print STDOUT "ERROR: File::Tail::Multi object ScanForFiles must be >= zero\n";
		 		exit 1007;
			}
			next;
		};
		/RemoveDuplicate/ and do { # /RemoveDuplicate/ must be 0 or 1
			unless ( $args->{RemoveDuplicate} =~ /^[0|1]$/ ) {
				print STDOUT "ERROR: File::Tail::Multi object RemoveDuplicate must 0 or 1\n";
		 		exit 1008;
			}
			next;
		};
		/Function/ and do { # /Function/ must be a function
			if ( ref($args->{Function}) ne "CODE" ) {
				next if ! $args->{Function};
				print STDOUT "ERROR: File::Tail::Multi object Function must be a function\n";
		 		exit 1009;
			}
			next;
		};
		/Files/ and do { # All attributes have default except for Files
			next if ! $args->{Files};
			unless ( $args->{Files} ) {
				print STDOUT "ERROR: File::Tail::Multi object must have attribute Files\n";
				exit 1010;
			}
			next;
		};
		/LastRun_File/ and do { # /LastRun_File/ must be a function
			next if ! $args->{'LastRun_File'};
			no strict 'refs';
			if ( ! -f $args->{'LastRun_File'} ) {
				print STDOUT "ERROR: File::Tail::Multi object LastRun_File must be a path to a file\n";
		 		exit 1011;
			}
			next;
		};
		/DO_MD5_Check/ and do { # /DO_MD5_Check/ must be 0 or 1
			unless ( $args->{DO_MD5_Check} =~ /^[0|1]$/ ) {
				print STDOUT "ERROR: File::Tail::Multi object DO_MD5_Check must 0 or 1\n";
		 		exit 1012;
			}
			next;
		};
	}
}
#
########################################################################
#
# Get params past to object File::Tail::Multi
#
########################################################################
#
sub GetParams {
    my $argvref = shift or croak "Missing required argument.\n";
    my $params  = shift or croak "Missing required parameters hash.\n";
    my $arglist = shift or croak "Missing required arglist array.\n";
    my %args;
    my ($param, $var);
    if (ref($argvref) eq 'HASH') {
	my $href = $argvref;
	%args = %$href;			# initialize result with input hash
	foreach $param (keys %$href) {	# for each named argument...
	    # Is this a known parameter?
	    if (exists($params->{$param})) {
		$var = $params->{$param};
		while ($var ne '' && ref($var) eq '') {	# indirect refs?
		    $var = $params->{$param = $var};
		}
		if ($var ne '') {
		    $$var = $href->{$param}; # assign the param's variable
		    $args{$param} = $$var;	# make sure canonical param gets defined
		    next;		# go to the next parameter
		}
	    }
	    if (!exists($params->{$param})) {
		croak "Unknown parameter: \"$param\"\n";
	    }
	}
    } else {			# use args in the order given for variables
	my $i;
	for ($i = 0; $i <= $#$arglist; $i++) {
	    $param = $arglist->[$i];	# get the next argument
	    $var = $params->{$param};	# get it's variable
	    next unless defined($var);
	    while ($var ne '' && ref($var) eq '') {
		$var = $params->{$param = $var};
	    }
	    if ($var ne '') {
		$$var = $i <= $#$argvref ? $argvref->[$i] : '';
		$args{$param} = $$var;	# assign to the hash
	    } elsif (!exists($params->{$param})) {
		croak "Unknown parameter: \"$param\" for argument $i.\n";
	    }
	}
    }
    # Now, make sure all variables get initialized
    foreach $param (keys %$params) {
	$var = $params->{$param};
	while ($var ne '' && ref($var) eq '') {
	    $var = $params->{$param = $var};
	}
	if ($var ne '' && !exists($args{$param})) {
	    $$var = $args{$param} = undef;
	}
    }
    \%args;			# return the HASH ref
}
#
########################################################################
#
# Will open all file and create a file data Structure
#
########################################################################
#
sub CreateFileDataStructure {
	my($File_Array)=@_;
	my $BFILE;
	my $fh;
	my $Exist;
	my $rhash;
	my $Pos=0;
	my $online=$False;
	my %FileHash=();
	#
	if ( %Attribute ) {
		$online=$True;
		foreach my $FH ( @{$Attribute{'FileArray'}} ) {
			$FileHash{$FH->{'name'}} = 1;
		}
	}
	foreach my $FILE ( @$File_Array ) {
		#
		# if not run by fuction new check if file is already being monitored
		if ( %Attribute ) {
			next if $FileHash{$FILE};
		}
		#
		# stat file
		#
		$Exist = ( stat($FILE) ? $True : $False);
		my $_md5_len = ($st_size < 42  ? $st_size : 42);
		my $_md5_chksum = 0;
		#
		$BFILE=basename($FILE);
		{
		no strict 'refs';
		%$FILE = (
			'name'		=>	$FILE,
			'basename'	=>	$BFILE,
			'fh'		=>	$fh,
			'stat'		=> {
					 'dev'     => $st_dev,
					 'ino'     => $st_ino,
					 'mode'    => $st_mode,
					 'nlink'   => $st_nlink,
					 'uid'     => $st_uid,
					 'gid'     => $st_gid,
					 'rdev'    => $st_rdev,
					 'size'    => $st_size,
					 'atime'   => $st_atime,
					 'mtime'   => $st_mtime,
					 'ctime'   => $st_ctime,
					 'blksize' => $st_blksize,
					 'blocks'  => $st_blocks
					},
			'lastrun_stat'	=> {
					 'ino'		=> $st_ino,
					 'pos'		=> $Pos,
					 'md5_len'	=> $_md5_len,
					 'md5_chksum'	=>	$_md5_chksum
					},
			'open'			=>	$False,
			'exist'			=>	$Exist,
			'read'	        =>	$False,
			'online'		=>	$online,
			'pos'			=>	$Pos,
			'md5_len'		=>	$_md5_len,
			'md5_chksum'	=>	$_md5_chksum,
			'FileState'		=>	0,
			'LastState'		=>	0,
			'LastMtime'		=>	$st_mtime,
			'OpenTime'		=>	0,
			'LineArray' 		=> 	[],
			'PatternLineArray' 	=> 	[],
			'ExceptPatternLineArray' 	=> 	[]
		);
		$rhash=\%$FILE;
		$$rhash{'LastState'} = FileState($rhash);
		$$rhash{'FileState'} = $$rhash{'LastState'};
		push(@File_Data_Structure,\%$FILE);
		}
	}
	return \@File_Data_Structure;
}
#
########################################################################
#
# Create a array of text file from dirs and filename
# Checks files for dups (links) and absolute path
#
########################################################################
#
sub CreateListOfFiles {
	my($rArrayOfFileNames)=@_;
	#
	# Check if dir and expand
	#
	my @RegFileArray=();
	my @FileArray=();
	my @ReturnFileArray=();
	my @result=();
	my $file;
	my %path_file;
	#
	# Expand all reg file names
	#
	foreach my $FILE ( @$rArrayOfFileNames ) {
		@result = glob($FILE);
		push(@RegFileArray,@result);
	}
	#
	# check for dir and expand
	#
	foreach my $FILE ( @RegFileArray ) {
		if ( -d $FILE ) {
			print STDOUT "Dir $FILE is being expanded\n" if $DEBUG;
			my $d = new DirHandle "$FILE";
			if(defined $d ) {
				while(defined($_=$d->read)) {
					$file="${FILE}/$_";
					if ( -T $file ) {
						push(@FileArray,$file);
					}
				}
     		}
		}
		else {
			push(@FileArray,$FILE);
		}
	}
	#
	# Checks files for dups (links) and absolute path
	#
	foreach my $FILE ( @FileArray ) {
		#
		# check for absolute path
		#
		unless ( $FILE =~ m#^/# || $MSWin32 ) {
			print STDOUT "File $FILE is not absolute path ... will not be used\n" if $DEBUG;
			next;
		}
		unless ( ( $FILE =~ m#^\w:# || $FILE =~ m#^//# ) || ! $MSWin32 ) {
			print STDOUT "File $FILE is not NT absolute path ... will not be used\n" if $DEBUG;
			next;
		}
		#
		# stat file
		#
		next unless stat($FILE);
		#
		# Check if any two file names point to the same file
		# Checking for links (Note: There are not links in NT)
		#
		my $key = "$st_dev $st_ino";
		if ( exists $path_file{$key} && ! $MSWin32 ) {
			print STDOUT "Warning: $FILE is linked to $path_file{$key}\n" if $DEBUG;
			print STDOUT "File $path_file{$key} ... will not be used\n" if $DEBUG;
			next;
		}
		$path_file{$key}=$FILE;
		#
		# Check if text file
		if ( -T $FILE ) {
			push(@ReturnFileArray,$FILE);
		}
		else {
			print STDOUT "$FILE is not a text file , will not be used\n" if $DEBUG;
		}
	}
	#
	return \@ReturnFileArray;
}
#
########################################################################
#
# Read one date line from file
#
########################################################################
#
sub readline {
	#
	my ($rFD)=shift;
	my @TotalArray=();		# Used with attribute Fuction
	my $PresentTime=time;
	#
	# Check if file dir should be rescanned
	# $LastScan is in sec
	# $rFD->{'ScanForFiles'} is in minutes
	#
	if (( $rFD->{'ScanForFiles'} and
            ($LastScan + ($rFD->{'ScanForFiles'}*60)) < $PresentTime) or
	     $FileAttributeChanged ) {
		print STDOUT "Scanning for new files\n" if $DEBUG;
		$rFD->{'FileArray'} =
		CreateFileDataStructure( CreateListOfFiles($rFD->{'Files'}));
		#
		$LastScan = $PresentTime;
		$FileAttributeChanged=$False;
	}
	#
	# This is for DEBUG
	if ( $DEBUG ) {
		print STDOUT "DEBUG list of file to be checked\n";
		foreach my $FH ( @{$rFD->{'FileArray'}} ) {
			print $FH->{'name'} . "\n";
		}
	}
	#
	# Check stat of files
	#
	OpenUpdateFiles($rFD);
	#
	#
	foreach my $FH ( @{$rFD->{'FileArray'}} ) {
		# reset array to remove last read data
		@{$FH->{'LineArray'}}=();
		#
		if ( $FH->{'exist'} and $FH->{'open'} ) {
			if ( defined $FH->{'fh'} ) {
				push(@{$FH->{LineArray}}, $FH->{'fh'}->getline);
				$FH->{'pos'}=$FH->{'fh'}->getpos;
				$FH->{'lastrun_stat'}{'pos'} = $FH->{'fh'}->tell;
				# Persist the Last Run state
				_set_lastrun_data( $FH ) if defined $LastRun_File;
			}
			if ($FH->{'stat'}{mtime} < ($PresentTime - ($rFD->{'MaxAge'} * 60))) {
				$FH->{'fh'}->close;
				$FH->{'open'} = $False;
				$FH->{'read'} = $False;		# required to open the file on every call to readline
				$FH->{'online'} = $False;		# required to open the file on every call to readline
			}
		}
		$FH->{'LastState'} = FileState($FH);
	}
	#
	# Run Pattern function if object Pattern attribute was set
	Patterns($rFD) if $rFD->{'Pattern'};
	#
	# Run ExceptPatterns function if object ExceptPatterns attribute was set
	ExceptPatterns($rFD) if $rFD->{'ExceptPattern'};
	#
	# Remove deplicate line from arrays
	RemoveDups($rFD) if $rFD->{'RemoveDuplicate'};
	#
	# create a Prefix Array if object OutputPrefix attribute was set
	Prefix($rFD,0) if $rFD->{'OutputPrefix'};
	#
	# Run custom function Pass complete array to custom user fuction
	if ( $rFD->{'Function'} ) {
		foreach my $FH ( @{$rFD->{'FileArray'}} ) {
			push(@TotalArray,@{$FH->{LineArray}});
		}
		&{$rFD->{'Function'}}(\@TotalArray)
	}
	#
	return($rFD);
}
#
########################################################################
#
# Read all new data from file
#
########################################################################
#
sub read {
	#
	my ($rFD)=shift;
	my @TotalArray=();		# Used with attribute Fuction
	my $PresentTime=time;
	#
	# Check if file dir should be rescanned
	# $LastScan is in sec
	# $rFD->{'ScanForFiles'} is in minutes
	#
	if (( $rFD->{'ScanForFiles'} and
            ($LastScan + ($rFD->{'ScanForFiles'}*60)) < $PresentTime) or
	     $FileAttributeChanged ) {
		print STDOUT "Scanning for new files\n" if $DEBUG;
		$rFD->{'FileArray'} =
		CreateFileDataStructure( CreateListOfFiles($rFD->{'Files'}));
		#
		$LastScan = $PresentTime;
		$FileAttributeChanged=$False;
	}
	#
	# This is for DEBUG
	if ( $DEBUG ) {
		print STDOUT "DEBUG list of file to be checked\n";
		foreach my $FH ( @{$rFD->{'FileArray'}} ) {
			print $FH->{'name'} . "\n";
		}
	}
	#
	# Check stat of files
	#
	OpenUpdateFiles($rFD);
	#
	#
	foreach my $FH ( @{$rFD->{'FileArray'}} ) {
		# reset array to remove last read data
		@{$FH->{'LineArray'}}=();
		#
		if ( $FH->{'exist'} and $FH->{'open'} ) {
			if ( defined $FH->{'fh'} ) {
				@{$FH->{'LineArray'}} = $FH->{'fh'}->getlines;
				$FH->{'pos'}=$FH->{'fh'}->getpos;
				$FH->{'lastrun_stat'}{'pos'} = $FH->{'fh'}->tell;
				# Persist the Last Run state
				_set_lastrun_data( $FH ) if defined $LastRun_File;
			}
			if ($FH->{'stat'}{mtime} < ($PresentTime - ($rFD->{'MaxAge'} * 60))) {
				$FH->{'fh'}->close;
				$FH->{'open'} = $False;
			}
		}
		$FH->{'LastState'} = FileState($FH);
	}
	#
	# Run Pattern function if object Pattern attribute was set
	Patterns($rFD) if $rFD->{'Pattern'};
	#
	# Run ExceptPatterns function if object ExceptPatterns attribute was set
	ExceptPatterns($rFD) if $rFD->{'ExceptPattern'};
	#
	# Remove deplicate line from arrays
	RemoveDups($rFD) if $rFD->{'RemoveDuplicate'};
	#
	# create a Prefix Array if object OutputPrefix attribute was set
	Prefix($rFD,0) if $rFD->{'OutputPrefix'};
	#
	# Run custom function Pass complete array to custom user fuction
	if ( $rFD->{'Function'} ) {
		foreach my $FH ( @{$rFD->{'FileArray'}} ) {
			push(@TotalArray,@{$FH->{LineArray}});
		}
		&{$rFD->{'Function'}}(\@TotalArray)
	}
	#
	return($rFD);
}
#
########################################################################
#
# print out line in from file array (Mostly for help with )
#
########################################################################
#
sub print {
	my($rFD)=shift;
	foreach my $FH ( @{$rFD->{FileArray}} ) {
		foreach my $LINE ( @{$FH->{LineArray}} ) {
			print $LINE;
		}
	}
}
#
########################################################################
#
# Gets the last run pos
#
########################################################################
#
sub getFilePos {
	my($rFD)=shift;
	my($fileName)=shift;
	my @tail_files = @{$rFD->{'Files'}};
	my $i = 0;
	foreach my $FH ( @{$rFD->{FileArray}} ) {
		my $tail_file = $tail_files[$i];
		if( $tail_file eq $fileName ) {
			my $last_pos = $FH->{'lastrun_stat'}{'pos'} || 0;
			return $last_pos;
		}
		$i++;
	}
	return -1;
}
#
########################################################################
#
# Gets the file size
#
########################################################################
sub getFileSize {
	my($rFD)=shift;
	my($fileName)=shift;
	my @tail_files = @{$rFD->{'Files'}};
	my $i = 0;
	foreach my $FH ( @{$rFD->{FileArray}} ) {
		my $tail_file = $tail_files[$i];
		if( $tail_file eq $fileName ) {
			my $size = int($FH->{'stat'}{size}) || 0;
			return $size;
		}
		$i++;
	}
	return -1;
}
#
########################################################################
#
# Print out lines from pattern file array (Mostly for help with )
#
########################################################################
#
sub printpat {
	my($rFD)=shift;
	#print STDOUT Data::Dumper->Dump($rFD) if $DEBUG;
	foreach my $FH ( @$rFD{'FileArray'} ) {
		foreach my $LINE ( @{$FH->{PatternLineArray}} ) {
			print $LINE;
		}
	}
}
#
########################################################################
#
# print out line from pattern file except array (Mostly for help with )
#
########################################################################
#
sub printexceptpat {
	my($rFD)=shift;
	#print STDOUT Data::Dumper->Dump($rFD) if $DEBUG;
	foreach my $FH ( @$rFD{'FileArray'} ) {
		foreach my $LINE ( @{$FH->{ExceptPatternLineArray}} ) {
			print $LINE;
		}
	}
}
#
########################################################################
#
# Print out stat output for each file (Mostly for help with )
#
########################################################################
#
sub printstat {
	my($rFD)=shift;
	foreach my $FH ( @$rFD{'FileArray'} ) {
		print "Stat ouput for file $FH->{name}\n";
		print "------------------------------------------------\n";
		foreach my $stat_id ( @StatArray ) {
			print "$stat_id = $FH->{'stat'}{$stat_id}\n";
		}
	}
}
#
########################################################################
#
# Print out All file states
#  (See note in File::Tail::Multi.pm for function OpenUpdateFiles)
#
########################################################################
#
sub printfilestates {
	my($FH)=@_;
	my $vector=pack("b4",0);
	my $open; my $read; my $exist;my $online;

	if ( $FH->{'FileState'} != $FH->{'LastState'} ) {
		print STDOUT "The State of file $FH->{name} has changed\n";
		print STDOUT "-Old state\n";
		vec($vector,0,4)=$FH->{'LastState'};
		($online,$read,$open,$exist) = split(//, unpack("b4", $vector));
		print STDOUT "\tExist = $exist Open = $open Read = $read Online = $online \n";
		print STDOUT "-New State\n";
		vec($vector,0,4)=$FH->{'FileState'};
		($online,$read,$open,$exist) = split(//, unpack("b4", $vector));
		print STDOUT "\tExist = $exist Open = $open Read = $read Online = $online \n";
	}
	else {
		print STDOUT "No Change in state for file $FH->{name}\n";
	}
}
########################################################################
#
# Check if arg is an arrayof pattern  or filename of patterns
# Return ref to array of patterns
#
########################################################################
sub CheckIfArrayOrFile {
	my($r_listofpatterns)=@_;
	#
	my @patterns=();
	my $patternfile;
	my $patfh;
	#
	# check if list of pattern is an array of a file
	#
	if ( ref($r_listofpatterns) eq "ARRAY" ) {
			@patterns=@$r_listofpatterns;
	}
	else {
		#
		# check if it is a file
		#
		{
		no strict 'refs';
		if ( -f $r_listofpatterns ) {
			$patternfile=$r_listofpatterns;
			#
			# open pattern file
			#
			stat($patternfile) || croak "Could not open pattern file\n";
			$patfh = new FileHandle "$patternfile", "r";
			while(<$patfh>) {
				chomp;
				next if /^#/;		# Remove line of comments
				next if /^\s*$/;	# Remove Blank lines
				push (@patterns,$_);
			}
			$patfh->close;
		}
		else {
			croak "Argv for sub Pattern was not an Array or File $patternfile was not found\n";
		}
		}
	}
	#
	return \@patterns;
}
########################################################################
#
# Add prefix define by OutputPrefix option to data array
#
# List of what is Object Options. Default is False
# GMT = Greenwich time ZONE
#
#  p   => path name of the input file
#  f   => file name of the input file
#  t   => time in HHMMSS
#  tg  => time in HHMMSS GMT
#  tc  => time in MM/DD/YYYY HH:MM:SS
#  pt  => path and time
#  ptg => path and time GMT
#  ptc => path and time complete
#  ft  => file and time
#  ftg => file and time GMT
#  ftc => file and time complete
#  tp  => time and path
#  tpg => time and path GMT
#  tpc => time complete and path
#  tf  => time and file
#  tfg => time and file GMT
#  tfc => time complete and file
#
########################################################################
sub Prefix {
	my($rFD)=shift;
	my($ArrayType)=@_;
	#
	my @TempArray=();
	my $InArray="LineArray";
	my $OutArray="LineArray";
	my $r=$rFD;
	my $TmpOutputPrefix;
	#
	# Check for GMT
	#
	$TmpOutputPrefix = $rFD->{'OutputPrefix'};
	if ( $rFD->{'OutputPrefix'} =~ /g/ ) {
		$TmpOutputPrefix =~ s/g//;
		$GMT=$True;
	}
	if ( $rFD->{'OutputPrefix'} =~ /c/ ) {
		$TmpOutputPrefix =~ s/c//;
		$TC=$True;
	}
	foreach my $FH ( @{$rFD->{'FileArray'}} ) {
		foreach my $LINE ( @{$FH->{$InArray}} ) {
			$TmpOutputPrefix eq "p" &&
			   push(@TempArray,"$FH->{'name'} : $LINE");
			$TmpOutputPrefix eq "f" &&
			   push(@TempArray,"$FH->{'basename'} : $LINE");
			$TmpOutputPrefix eq "t" &&
			   push(@TempArray,Time($r) . " : $LINE");
			$TmpOutputPrefix eq "pt" &&
			   push(@TempArray,"$FH->{'name'} " . Time($r) . " : $LINE");
			$TmpOutputPrefix eq "tp" &&
			   push(@TempArray,Time($r) . " $FH->{'name'} : $LINE");
			$TmpOutputPrefix eq "ft" &&
			   push(@TempArray,"$FH->{'basename'} " . Time($r) . " : $LINE");
			$TmpOutputPrefix eq "tf" &&
			   push(@TempArray,Time($r) . " $FH->{'basename'} : $LINE");
		}
		@{$FH->{$OutArray}} = @TempArray;
		@TempArray=();
	}
	return($rFD);
}
########################################################################
#
# open a ( file or Array ) of patterns and check for lines matching
# the pattern
#
# Returns Data Structure with
#
########################################################################
sub Patterns {
	my($rFD)=shift;
	#
  $pattern_sub = match_closure(CheckIfArrayOrFile($rFD->{'Pattern'})) unless defined($pattern_sub);
	foreach my $FH ( @{$rFD->{FileArray}} ) {
		@{$FH->{PatternLineArray}}=();
		foreach my $LINE ( @{$FH->{LineArray}} ) {
			push(@{$FH->{PatternLineArray}},$LINE) if ( $pattern_sub->($LINE) );
		}
		@{$FH->{LineArray}}=@{$FH->{PatternLineArray}};
	}
	return($rFD);
}
#
########################################################################
#
# open a ( file or Array ) of paterns and return excepticheck them against lines
# from file array
#
########################################################################
#
sub ExceptPatterns {
	my($rFD)=shift;
	#
  $exceptpattern_sub = match_closure(CheckIfArrayOrFile($rFD->{'ExceptPattern'})) unless defined($exceptpattern_sub);
	foreach my $FH ( @{$rFD->{FileArray}} ) {
		@{$FH->{ExceptPatternLineArray}}=();
		foreach my $LINE ( @{$FH->{LineArray}} ) {
				push(@{$FH->{ExceptPatternLineArray}},$LINE) unless ( $exceptpattern_sub->($LINE) );
		}
		@{$FH->{LineArray}}=@{$FH->{ExceptPatternLineArray}};
	}
	#
	return($rFD);
}
#
########################################################################
#
# create closures fuction with eval for efficiency in patterm matching
#
########################################################################
sub match_closure {
   my($array) = shift;
	my $out;
   $out = join ('|', @$array);
   eval 'sub { $_[0] =~ /($out)/o; }'
}
#
########################################################################
#
# Remove Duplicate line from file array
#
########################################################################
#
sub RemoveDups {
	my($rFD)=shift;
	my %Mark;
	#
	foreach my $FH ( @{$rFD->{FileArray}} ) {
		#
		undef(%Mark);
		grep($Mark{$_}++, @{$FH->{LineArray}});
		@{$FH->{LineArray}}=(sort keys(%Mark));
		undef(%Mark);
	}
	return($rFD);
}
########################################################################
#
# Open and Close files as needed for tailing
# Should be done before ptail->read
#
# All file are in a combination of four states.
#
# 1. Exist  = True (File exist at this time )
#           = False ( File does not exist at this time )
#
# 2. Open   = True (File is open at this time )
#           = False ( File is not open at this time )
#
# 3. Read   = True (File has been read since open )
#           = False ( File has not been read since open )
#
# 4. online = True (File exist now or existed once during this process)
#           = False (File has never existed during this process)
#
# The table below list the states that a file can be in
# and what action should be taken.
#
# BV = Binary Value
#  ____________________________________________________________________
# | BV || Exist | Open | Read | OnLine || Action
# |____||_______|______|______|________||______________________________|
# |----||-------|------|------|--------||------------------------------|
# | 0  ||  F    |  F   |  F   |   F    || 1) Skip file
# |    ||       |      |      |        ||
# |----||-------|------|------|--------||------------------------------|
# | 1  ||  F    |  F   |  F   |   T    || 1) Skip file
# |    ||       |      |      |        ||
# |----||-------|------|------|--------||------------------------------|
# | 2  ||  F    |  F   |  T   |   F    || 1) (read = False)
# |    ||       |      |      |        || 2) Skip file
# |----||-------|------|------|--------||------------------------------|
# | 3  ||  F    |  F   |  T   |   T    || 1) (read = False)
# |    ||       |      |      |        || 2) Skip file
# |----||-------|------|------|--------||------------------------------|
# | 4  ||  F    |  T   |  F   |   F    || 1) Close File (open = False)
# |    ||       |      |      |        || 2) Skip file
# |----||-------|------|------|--------||------------------------------|
# | 5  ||  F    |  T   |  F   |   T    || 1) Close File (open = False)
# |    ||       |      |      |        || 2) Skip file
# |----||-------|------|------|--------||------------------------------|
# | 6  ||  F    |  T   |  T   |   F    || 1) Check if file has changed
# |    ||       |      |      |        || 2) if file has not changed for
# |    ||       |      |      |        ||    MaxAge, close file
# |----||-------|------|------|--------||------------------------------|
# | 7  ||  F    |  T   |  T   |   T    || 1) Close File (open =False)
# |    ||       |      |      |        || 2) Take offline
# |    ||       |      |      |        ||    (online = False)
# |    ||       |      |      |        || 3) (read = False)
# |----||-------|------|------|--------||------------------------------|
# | 8  ||  T    |  F   |  F   |   F    || 1) Open File (open = True)
# |    ||       |      |      |        || 2) Put online (online = True)
# |    ||       |      |      |        || 3) Start reading from location
# |    ||       |      |      |        ||    NumLines (read = True)
# |----||-------|------|------|--------||------------------------------|
# | 9  ||  T    |  F   |  F   |   T    || 1) Open File (open = True)
# |    ||       |      |      |        || 2) Start reading from top
# |    ||       |      |      |        ||    (read = True)
# |----||-------|------|------|--------||------------------------------|
# | 10 ||  T    |  F   |  T   |   F    || 1) Open File (open = True)
# |    ||       |      |      |        || 2) Start reading from last pos
# |    ||       |      |      |        || 3) Put online (online = True)
# |----||-------|------|------|--------||------------------------------|
# | 11 ||  T    |  F   |  T   |   T    || 1) Open File (open = True)
# |    ||       |      |      |        || 2) Start reading from last pos
# |----||-------|------|------|--------||------------------------------|
# | 12 ||  T    |  T   |  F   |   F    || 1) Put online (online = True)
# |    ||       |      |      |        || 2) Start reading from top
# |----||-------|------|------|--------||------------------------------|
# | 13 ||  T    |  T   |  F   |   T    || 1) Start reading from last pos
# |    ||       |      |      |        ||    (read = True)
# |----||-------|------|------|--------||------------------------------|
# | 14 ||  T    |  T   |  T   |   F    || 1) Put online (online = True)
# |    ||       |      |      |        || 2) Start reading from top
# |----||-------|------|------|--------||------------------------------|
# | 15 ||  T    |  T   |  T   |   T    || 1) Start reading from last pos
# |    ||       |      |      |        ||
#  ---------------------------------------------------------------------
#
########################################################################
sub OpenUpdateFiles {
	#
	my($rFD)=shift;
	my $FS;
	#
	foreach my $FH ( @{$rFD->{'FileArray'}} ) {
		#
		# check if file exist and update stat
		$FS = UpdateStat($FH);
		#
		SWITCH: {
		#
			($FS==0) && do {
				last SWITCH;
			};
			($FS==2 || $FS==4 || $FS==6 ) && do {
				SetFileState($FH,0);
				last SWITCH;
			};
			($FS==1 || $FS==3 || $FS==5 || $FS==7 ) && do {
				SetFileState($FH,1);
				last SWITCH;
			};
			($FS==8 || $FS==14 ) && do {
				$FH->{'fh'} = new FileHandle "$FH->{name}", "r";
				$FH->{'OpenTime'} = time;
				if ( defined($FH->{'fh'}) ) {
					SetFileState($FH,15);
					PosFileMark($FH);
				}
				last SWITCH;
			};
			($FS==9 ) && do {
				$FH->{'fh'} = new FileHandle "$FH->{name}", "r";
				$FH->{'OpenTime'} = time;
				if ( defined($FH->{'fh'}) ) {
					SetFileState($FH,15);
				}
				last SWITCH;
			};
			($FS==12 ) && do {
				OpenFileToTail($rFD,$FH);
				if ( $FH->{'open'} ) {
					SetFileState($FH,15);
				}
				last SWITCH;
			};
			($FS==10 || $FS==11 || $FS==13 || $FS==15 ) && do {
				OpenFileToTail($rFD,$FH);
				if ( $FH->{'open'} ) {
					SetFileState($FH,15);
					$FH->{'fh'}->setpos($FH->{'pos'});
				}
				last SWITCH;
			};
		}
		# get current state of file
		$FH->{'FileState'}=FileState($FH);
		printfilestates($FH) if $DEBUG;
	}
}
#
########################################################################
#
# Open file if it exist and has been change
#
########################################################################
#
sub OpenFileToTail {
	my($rFD)=shift;
	my($FH)=@_;
	my $PresentTime=time;
	#
	# return if file is already open
	#
	#
	# check if file has been changed in last MaxAge mins
	if ( ($FH->{'LastMtime'} == $FH->{'stat'}{mtime}) &&
	     ($FH->{'stat'}{mtime} < ($PresentTime - ($rFD->{'MaxAge'} * 60))) &&
	      $FH->{'open'} ) {
		$FH->{'fh'}->close if defined($FH->{'fh'});
		$FH->{'OpenTime'} = 0;
		$FH->{'open'}=$False;
		return;
	}
	if ( $FH->{'LastMtime'} == $FH->{'stat'}{mtime} ) {
		return;
	}
	if ( ! $FH->{'open'} && $FH->{'LastMtime'} < $FH->{'stat'}{mtime} ) {
		$FH->{'fh'} = new FileHandle "$FH->{name}", "r";
		$FH->{'open'}=$True;
		$FH->{'OpenTime'} = $PresentTime;
	}
}
#
########################################################################
#
# Update stat in Data_Structure
#
########################################################################
#
sub UpdateStat {
	my($FH)=@_;
	my $tmps;
	#
	{
	no strict 'refs';
	$FH->{'LastMtime'} = $FH->{'stat'}{'mtime'};
	}
	$FH->{'exist'} = (stat($FH->{'name'}) ? $True : $False);
	$FH->{'read'} = $False unless $FH->{exist};
	#
	foreach my $stat_id ( @StatArray ) {
		$tmps="st_". $stat_id;
		{
		no strict 'refs';
		$FH->{'stat'}{$stat_id} = $$tmps;
		}
	}
	# get current state of file
	$FH->{'LastState'} = $FH->{'FileState'};
	$FH->{'FileState'} = FileState($FH);
	#
	# this will return the FileState
}
#
########################################################################
#
# Return the time as a HHMMSS string.  $opt_g decides timezone.
#
########################################################################
#
sub Time {
	my($rFD)=shift;
	return scalar localtime if $TC;
	my($sec,$min,$hour)=($GMT ? gmtime : localtime);
	sprintf("%02d%02d%02d", $hour,$min,$sec);
}
#
########################################################################
#
# Return the version number of the File::Tail::Multi Package
#
########################################################################
#
sub version {
  return $VERSION;
}
#
########################################################################
#
# Turn on  output on for File::Tail::Multi package
#
########################################################################
#
sub debug {
	my($rFD)=shift;
	if ( $rFD->{'Debug'} ) {
		$DEBUG=0;
	}
	else {
		$DEBUG=1;
	}
	$rFD->{'Debug'}=$DEBUG;
}
#
########################################################################
#
# Close all file that are being tailed
#
########################################################################
#
sub close_all_files{
	my ($rFD)=shift;
	foreach my $FH ( @{$rFD->{'FileArray'}} ) {
		next if ! defined $FH->{fh};
		print "Closing file $FH->{name} ...\n" if $DEBUG;
		$FH->{fh}->close;
	}
}
#
########################################################################
#
# Return the state of a file in Number terms
#
# Exist  = 8
# Open   = 4
# Read   = 2
# Online = 1
#
########################################################################
#
sub FileState{
	my($FH)=@_;
	my $vector=pack("b4",0);
	#
	if( defined($FH->{'online'}) ) {
		vec($vector,0,1)=$FH->{'online'};
		vec($vector,1,1)=$FH->{'read'};
		vec($vector,2,1)=$FH->{'open'};
		vec($vector,3,1)=$FH->{'exist'};
		vec($vector,0,8);
	}
}
########################################################################
#
# Set the new file state in the Data Structure
#
# Exist  = 8
# Open   = 4
# Read   = 2
# Online = 1
#
########################################################################
#
sub SetFileState{
	my($FH,$NewState)=@_;
	my $vector=pack("b4",0);
	#

	if ( $NewState > 15 ) { $NewState=15; }

	vec($vector,0,4)=$NewState;
	($FH->{'online'},$FH->{'read'},$FH->{'open'},$FH->{'exist'}) =
	split(//, unpack("b4", $vector));
	$FH->{'LastState'}= $FH->{'FileState'};
	$FH->{'FileState'}=$NewState;
}
#
########################################################################
#
# Set file seek position to number of line in opt_n
#
########################################################################
#

sub PosFileMark {
	my($FH)=@_;
	#
	my $line;
	my $pos;
	my @lines=();
	my $fh=$FH->{'fh'};
	my $CharALine=120;
	my $seekbacklines=$Attribute{'NumLines'};
	my $seekback=$CharALine * ($seekbacklines +1);
	#
	if ( $seekbacklines < 0 ) { # Move to end of file
		seek($fh,0,2);
		$FH->{'pos'}=$fh->getpos;
		return;
	}
	elsif ( $seekbacklines > 0 ) {
		seek($fh, -$seekback, 2);
	}
	else {
		# Load Last Run file if program started
		if ($FH->{'LastState'}==8 )
		{
			_get_lastrun_data($FH) if ( defined $LastRun_File );
			if ( int($FH->{'lastrun_stat'}{'pos'}) <= int($FH->{'stat'}{size}) && $FH->{'lastrun_stat'}{'pos'} ne '') {
				seek($fh, $FH->{'lastrun_stat'}{'pos'}, 0);
			}
			$FH->{'pos'}=$fh->getpos;
			return;
		} else {
			# Just let it be - Read from TOP
		}
	}
	#
	# remove line part;
	#
	$line=$fh->getline;
	#
	# get all line to end of file
	#
	@lines=$fh->getlines;
	splice(@lines,0,$#lines-$seekbacklines + 1) if ( $seekbacklines != 0 );
	foreach $line ( @lines ) {
		$pos += length $line;
	}
	#
	# seek to pos in file;
	#
	seek($fh, -$pos, 2);
	#
	$FH->{'pos'}=$fh->getpos;
	#
}
#
########################################################################
#
# Autoload sub-classes
#
########################################################################
#
sub AUTOLOAD {
	my($rFD)=shift;
	my $type = ref($rFD) || croak "$rFD is not and object";
	my $attribute = $AUTOLOAD;
	$attribute =~ s/.*://;
	unless ( exists $rFD->{$attribute} ) {
		croak "Can't access $attribute field in oject $rFD";
	}
	if ( $attribute eq "Files" ) {
		$FileAttributeChanged=$True;
	}
	CheckAttributes($rFD);
	if (@_) {
		return $rFD->{$attribute} = shift;
	} else {
		return $rFD->{$attribute};
	}
}
#
########################################################################
#
# Get Last Read data about a FILE into the File Data structure
#
########################################################################
#
sub _get_lastrun_data {
    my($FH) = @_;

    my $previous_position = 0; # start at zero if 1st time ...

    my ($logged_name, $last_pos, $logged_ino, $md5_chksum, $md5_len) = ('', 0, 0, $FH->{'md5_chksum'}, $FH->{'md5_len'} );
    if(-e "$LastRun_File") {
        open my $curat_fh, '<', $LastRun_File or croak "Could not read $LastRun_File: $!";
        my @runlines = <$curat_fh>;
        close $curat_fh;

		foreach ( @runlines ) {
			chomp;
        	($logged_name, $last_pos, $logged_ino, $md5_chksum, $md5_len) = split /
/, $_;
			if ( $logged_name eq $FH->{'name'} ) {
				last;
			} else {
        		($logged_name, $last_pos, $logged_ino ) = ('', 0, 0);
			}
		}
        $last_pos = 0 if $logged_ino ne $FH->{'stat'}{ino};
        $logged_ino = $FH->{'stat'}{ino};

        $FH->{'lastrun_stat'}{ino} = int($logged_ino);
        $FH->{'lastrun_stat'}{'pos'} = int($last_pos);

        if($DO_MD5_Check) {
        	$FH->{'lastrun_stat'}{'md5_len'} = int($md5_len) if !defined $md5_len || !$md5_len;
        	$FH->{'lastrun_stat'}{'md5_chksum'} = int($md5_chksum) if !defined $md5_chksum || !$md5_chksum;
        }
    }
}
#
########################################################################
#
# Set Last Read data about a FILE
#
########################################################################
#
sub _set_lastrun_data {
    my($FH) = shift;

    my ($logged_name, $last_pos, $logged_ino, $md5_chksum, $md5_len) = ('', 0, 0, 0, 0);
	my @runlines;
	my ($indx, $found) = (0, -1);
    if(-e "$LastRun_File") {
		open my $curat_fh, '<', $LastRun_File or croak "Could not read $LastRun_File: $!";
		@runlines = <$curat_fh>;
		close $curat_fh;

		foreach ( @runlines ) {
			chomp;
        	($logged_name, $last_pos, $logged_ino, $md5_chksum, $md5_len) = split /
/, $_;
			if ( $logged_name eq $FH->{'name'} ) {
				$found = $indx;
				last;
			}
			$indx++;
		}
	}
	$found = $#runlines + 1 if ( $found == -1 );
	$runlines[$found] = $FH->{'name'}.'
'.$FH->{'lastrun_stat'}{'pos'}.'
'.$FH->{'stat'}{ino}.'
'.$FH->{'md5_chksum'}.'
'.$FH->{'md5_len'}."\n";
	$FH->{'lastrun_stat'}{ino} = $FH->{'stat'}{ino};

    open my $curpos_fh, '>', $LastRun_File or croak "Could not write $LastRun_File: $!";
	foreach ( @runlines ) {
		chomp;
    	print {$curpos_fh} $_."\n";
	}
    close $curpos_fh;
}
#
########################################################################
#
# Get MD5 Info about last read state
#
########################################################################
#
sub _get_md5_info {
    my($FH) = shift;

    return if !$DO_MD5_Check;
    require Digest::MD5; # only do the module if needed

    my $data_to_md5 = ''; # to avoid uninitialized value warnings
    my $origpos = $FH->{'pos'};

	seek($FH->{'fh'}, 0, 0);
    sysread $FH->{'fh'}, $data_to_md5, $FH->{'md5_len'};
	seek($FH->{'fh'}, $origpos, 0);

    return Digest::MD5::md5_hex($data_to_md5);
}

#
#
########################################################################
# POD
########################################################################
1;
__END__