PBS::Logs - general parser for PBS log files

  use PBS::Logs;

	http://www.gnu.org/copyleft/lesser.html
or	http://www.opensource.org/licenses/lgpl-license.php

 my $pl = new PBS::Logs('/var/spool/PBS/server_logs/20050512');

 open PL, '/var/spool/PBS/server_logs/20050512' 
   || die "can not open log";
 my @pl = <PL>;
 my $pl = new PBS::Logs(\@pl);

 my $pl = new PBS::Logs(\*STDIN);

 $a = $pl->get();      # returns array reference
 @a = $pl->get();      # returns array

 $dt = '02/01/2005 18:48:10';
 $a = $pl->datetime($dt);      # returns seconds since January 1, 1970 UTC
 @a = $pl->datetime($dt);      # returns array

package PBS::Logs;

use 5.006;
use strict;
use warnings;
use Carp;
use Time::Local;

our @ISA = qw();

our $VERSION = '0.05';

my $debug = 0;

my $datetime_regex = '(\d{2})/(\d{2})/(\d{4}) (\d{2}):(\d{2}):(\d{2})';

BEGIN {
	my @fields = qw{input type};
	# construct read-only accessor functions here - no need for AUTOLOAD
	foreach my $f (@fields) {
		my $code = "package ".__PACKAGE__.";\n"
.qq{sub $f {
		my \$self = shift;
		carp __PACKAGE__."->$f \$self (".join(',',\@_).")\n"
				if (\$debug || \$self->{'-debug'});
		\$self->{'$f'};
		}
};
	eval $code;
	}
}

# Preloaded methods go here.

sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;
	my $self = {
		'-debug'	=> 0,
		'-lastline'	=> undef,
		'-start'	=> undef,
		'-end'		=> undef,
		'input'		=> undef,
		'line'		=> 0,
		'type'		=> undef,
	};
	carp __PACKAGE__.": creating $self\n"
		if ($debug || $self->{'-debug'});
	my $x = shift;
	if (ref $x eq "ARRAY") {	# slurped ARRAY
		$self->{'input'} = $x;
		$self->{'type'} = 'ARRAY';
	} elsif (ref $x eq "GLOB") {	# FILEHANDLE
		$self->{'input'} = $x;
		$self->{'type'} = 'FILTER';
	} elsif (! ref $x) {		# filename
		open PBSIN, $x
			or croak __PACKAGE__.": new - can not open '$x'";
		$self->{'input'} = \*PBSIN;
		$self->{'type'} = 'FILE';
	} else {
		croak __PACKAGE__
		.": new - must pass either filename, array reference, "
		."or filehandle glob ... not ".ref($x)." '$x'";
	}
	bless ($self, $class);
	return $self;
}

sub DESTROY {
	my $self = shift;
	carp __PACKAGE__.": destroying $self\n"
		if ($debug || $self->{'-debug'});
	close $self->{'input'} if ref $self->{'input'} eq "GLOB";
}

sub END {
	carp __PACKAGE__.": ending\n"
		if ($debug);
}

sub debug {
	my $self = shift;
	if (index(ref($self), __PACKAGE__) == 0) {	# just myself
		@_	? $self->{'-debug'} = shift
			: $self->{'-debug'};
	} else {				# whole class
		defined($self)	? $debug = $self
				: $debug;
	}
}

sub line {
	my $self = shift;
	carp __PACKAGE__." : line $self (".join(',',@_).")\n"
		if ($debug || $self->{'-debug'});
	return undef if ! defined $self->{'line'};
	# the line count is always high by one since we must pre-read a line
	$self->{'line'} > 0 ? $self->{'line'} - 1 : $self->{'line'};
}

sub current {
	my $self = shift;
	carp __PACKAGE__." : current $self (".join(',',@_).")\n"
		if ($debug || $self->{'-debug'});
	return undef if ! defined $self->{'current'};
	$self->{'current'};
}

sub start {
	my $self = shift;
	carp __PACKAGE__.": start $self(".join(',',@_).")\n"
		if ($debug || $self->{'-debug'});
	if ($self->{'type'} eq "FILE") {
		seek $self->{'input'}, 0, 0
		or croak __PACKAGE__.": start - can not seek on file";
	}
	$self->{'-lastline'}	= undef;
	$self->{'line'} = 0 if ($self->{'type'} ne 'FILTER');
	$self->{'current'}	= undef;
}

sub end {
	my $self = shift;
	carp __PACKAGE__.": end $self(".join(',',@_).")\n"
		if ($debug || $self->{'-debug'});
	if ($self->{'type'} eq "FILE") {
		close $self->{'input'};
	}
	$self->{'-lastline'}	= undef;
	$self->{'-start'}	= undef;
	$self->{'-end'}		= undef;
	$self->{'input'}	= undef;
	$self->{'line'}		= undef;
	$self->{'current'}	= undef;
	$self->{'type'}		= undef;
}

#=head1 getline()
#
#Get the next text line from the log returning a string
# (stripped of trailing \n's).
#This method is used internally only, and should not be called directly
#
#=cut

sub getline {
	my $self = shift;
	carp __PACKAGE__.": getline $self(".join(',',@_).")\n"
		if ($debug || $self->{'-debug'});

	my $l = undef;
	if ($self->{'type'} eq 'ARRAY') {
		$l = $self->{'input'}->[$self->{'line'}]
			if scalar @{$self->{'input'}} > $self->{'line'}
			&& $self->{'line'} != -1;
	} else {
		$l = readline $self->{'input'}
			if not eof($self->{'input'});
	}

	if (defined $l) {
		chomp $l;
		$self->{'line'}++;
	} else  {		# reached EOF
		$self->{'line'} = -1;
		$self->{'current'} = undef;
	}
	$l;						# return array ref
}

#=head1 getdata()
#
#Get the next data batch from the log returning an array reference
#of elements.
#This method is used internally only, and should not be called directly
#
#=cut

sub getdata {
	my $self = shift;
	carp __PACKAGE__.": getdata $self(".join(',',@_).")\n"
		if ($debug || $self->{'-debug'});

	my ($a,$l,$line) = (undef,undef,$self->{'-lastline'});

	$line = $self->getline() if ! defined $line;

	while ($l = $self->getline()) {
		last if ! defined $l;
		if ($l =~ /^$datetime_regex/) {
			$self->{'-lastline'} = $l;
			last;
		} else {		# a continuation record
			$line .= " $l";
		}
	}
	$self->{'-lastline'} = undef if ! defined $l;

	if (defined $line) {
		$a = [split(';',$line)];
		$self->{'current'} = $line;
	} else {
		$self->{'current'} = undef;
	}

	$a;						# return array ref
}

sub get {
	my $self = shift;
	carp __PACKAGE__.": get $self(".join(',',@_).")\n"
		if ($debug || $self->{'-debug'});

	if ($self->{'line'} == -1) {	# nothing to do at EOF
		$self->{'current'} = undef;
		return () if (wantarray);
		return undef;
	}

#	my ($a,$l,$line) = (undef,undef,$self->{'-lastline'});
	my $a;
	while ($a = $self->getdata()) {
		my $dt = $self->datetime($a->[0]);
		next	if defined($self->{'-start'})
			&& ($dt < $self->{'-start'});
		next	if defined($self->{'-end'})
			&& ($dt > $self->{'-end'});
		last;
	}

	return if ! defined wantarray;			# just read log line
	return (defined $a ? @$a : ()) if (wantarray);	# return array
	$a;						# return array ref
}

sub datetime {
	my $self = shift;
	carp __PACKAGE__.": datetime $self(".join(',',@_).")\n"
		if ($debug || $self->{'-debug'});

	my $dt = shift;
	carp __PACKAGE__.": datetime : received an undefined value"
		if ! defined $dt;

	my @dt = $dt =~ /$datetime_regex/;

	if (wantarray) {
		# rewrite in proper order
		return ($dt[5],$dt[4],$dt[3],$dt[1],$dt[0]-1,$dt[2]);
	} else {
		return timegm($dt[5],$dt[4],$dt[3],$dt[1],$dt[0]-1,$dt[2]);
	}
}

sub filter_datetime {
	my $self = shift;
	carp __PACKAGE__.": filter_datetime $self(".join(',',@_).")\n"
		if ($debug || $self->{'-debug'});

	my ($st,$et) = @_;

	return ($self->{'-start'}, $self->{'-end'})
		if (! defined $st);

	if (! defined $et) {
		carp __PACKAGE__
			.": filter_datetime : received an undefined value";
		return undef;
	}

	if ($st eq 'none') {
		$self->{'-start'} = undef;
	} elsif ($st =~ /^\d+$/) {
		$self->{'-start'} = $st;
	} elsif ($st =~ /^$datetime_regex$/) {
		$self->{'-start'} = $self->datetime($st);
	} else {
		carp __PACKAGE__.": filter_datetime : bad start value = '"
			.$st."'";
		return undef;
	}

	if ($et eq 'none') {
		$self->{'-end'} = undef;
	} elsif ($et =~ /^\d+$/) {
		$self->{'-end'} = $et;
	} elsif ($et =~ /^$datetime_regex$/) {
		$self->{'-end'} = $self->datetime($et);
	} else {
		carp __PACKAGE__.": filter_datetime : bad end value = '"
			.$et."'";
		return undef;
	}
	1;
}

1;
__END__