LCH::LogFile
package LCH::LogFile;
use strict;
our $VERSION = '0.12';
########################################### main pod documentation beg
+in ##
=head1 NAME
LCH::LogFile - Class for Log file objects
=head1 SYNOPSIS
use LCH::LogFile;
my $logf = LCH::LogFile->new( app => 'AppSRSOtcValuation',
instance => 2 );
while (1) {
$logf->tail;
print $logf->contents->text;
sleep 10;
}
=head1 DESCRIPTION
This module provides OO access to SwapClear log files. There are assum
+ptions about
directory and file naming, as per SwapClear. See the C<new> method bel
+ow.
This module provides a number of method calls to perform operations on
+ a given
log file.
=head2 new
Takes named parameters (all optional)
=over 4
=item C<path>
Path to the application logs directory tree. Defaults to $ENV{SC_LOGS}
+ or failing this
~/var/logs. The main SwapClearLogFile is in this directory, but applic
+ation component
logs live in their own directories off this.
=item C<app>
Name of the application component to tail. The logs for this applicati
+on live in a
directory off the path (above). Application logs are of the form logFi
+le.yyyymmdd-hhmmss
taking their time stamp from when the app was started.
If no app is specified, will use the main log file SwapClearLogFile.yy
+yymmdd.
=item C<instance>
The instance indexes backwards through the logs, hence instance 1 (the
+ default) is
the latest, 2 the next latest, etc. Instance numbering starts from 1 n
+ot 0 by convention
(like vilog.ksh and taillog.ksh).
You can use an LCH::LogFile object to track multiple application insta
+nces. Don't
specify an instance if you want to do this - use a timestamp range wit
+h from and to.
=item C<from>
If C<from> is specified, the object will operate on all log files from
+ a point
in time. This will cater for a failing application that gets restarted
+ by a keepAlive
process, and creates a new log file.
=item C<to>
This specifies the end time for which to operate on logs.
=item C<format>
Specify a date (and time) format to use for the C<from> and C<to> para
+meters. See
L<Time::Piece> and man strptime for more on date/time formats.
=back
=head2 tail
if you call this method periodically, it will retrieve the next instal
+lment of the
log, i.e. what has been written since the last call to tail.
A call to tail results in a poll of all the individual log files in th
+e date range.
If the size of any log file has been increased, tail will return the l
+ogfile name.
Should a new process be started up and create a new logfile, this will
+ be visible to
tail.
Note that tail returns the name of the log file from which the chunk w
+as read. Other
method calls process the actual chunk. Further calls to tail will retu
+rn other logs with
new chunks, and eventually return undef.
=head2 waitfor
my $rv = $object->waitfor(
match=>qr/First message/,
sleep => 5,
text => 'initial message',
timeout => 60
);
This method causes successive calls to tail until the regular expressi
+on
b<match> is found. waitfor returns true when the expression matches. F
+ailure
indicates either that the message timed out, or that the user interrup
+ted
the wait with Ctrl/C.
waitfor will wait forever if no timeout is specified.
waitfor generates output to STDERR. When called, it outputs the string
+ "Waiting for $text "
where $text is the text parameter passed in. Each time waitfor polls t
+he log, it outputs
a '.' to STDERR then sleeps.
The user can cancel the wait by hitting Ctrl/C (or sending a SIGINT to
+ the process). This will cause
the message "Skip waiting for $text?" to be printed on STDERR, and a r
+ead from STDIN. If the user
responds with a Y, y or yes, etc. this will cause waitfor to return un
+def. If the user says anything
else, the waitfor will carry on polling the log file. If the user hits
+ Ctrl/C again, the process will
exit.
=head2 contents
Returns an L<LCH::AppText> object holding the text since the last call
+ to tail, or the whole file
contents if tail was not called.
The method calls C<match>, C<range> and C<split> are delegated to the
+contents object.
=head2 match, range, split
See the documentation for L<LCH::AppText>.
=head2 flush
This is used to delete the contents of the LCH::LogFile object - if we
+ are tailing future output.
=head2 file
Returns the filename for this log instance if you specified an instanc
+e to new. Returns undef if
you specified a date range.
=head1 AUTHOR
I. P. Williams 2004/5
=head1 SEE ALSO
L<LCH::AppText>, L<Time::Piece>.
=cut
use LCH::AppText;
use Time::Piece;
use Time::Seconds;
use Params::Validate qw(:types :DEFAULT);
use File::Glob qw(bsd_glob);
sub new {
my $class = shift;
my %par = validate(
@_,
{
app => {
type => SCALAR,
optional => 1,
},
instance => {
type => SCALAR,
regex => qr/^\d+$/,
default => 1,
},
path => {
type => SCALAR,
default => exists $ENV{SC_LOGS}
? $ENV{SC_LOGS}
: $ENV{HOME} . '/var/logs',
},
from => {
type => SCALAR | OBJECT,
optional => 1,
},
to => {
type => SCALAR | OBJECT,
optional => 1,
},
format => {
type => SCALAR,
default => "%d-%b-%Y"
},
}
);
my $log_glob =
exists( $par{app} )
? $par{path} . '/' . $par{app} . '/logFile.*-??????'
: $par{path} . '/SwapClearLogFile.*';
my $self = bless { glob => $log_glob }, $class;
my @all_files = bsd_glob $log_glob or return undef;
if ( exists $par{from} ) {
my $fromtim =
ref( $par{from} )
? $par{from}
: Time::Piece->strptime( $par{from}, $par{format} );
my $to_tim =
!exists( $par{to} ) ? localtime
: ref( $par{to} ) ? $par{to}
: Time::Piece->strptime( $par{to}, $par{format} );
for my $file ( @all_files, 'logFile.20091231-235959' ) {
my ( $year, $month, $day, $hour, $min, $sec ) =
$file =~ /logFile\.
(\d{4}) # Year
(\d{2}) # Month
(\d{2})- # Day
(\d{2}) # Hour
(\d{2}) # Minute
(\d{2}) # Second
/x;
my $begint =
Time::Piece->strptime( "$year-$month-$day $hour:$min:$se
+c",
'%Y-%m-%d %H:%M:%S' );
my $endt = _last_timestamp($file) || $begint;
if (
(
( $fromtim->datetime lt $endt->datetime )
&& ( $begint->datetime lt $to_tim->datetime )
) .. ( $begint->datetime gt $to_tim->datetime )
)
{
$self->_slurp( $file, 0, 'append' );
}
}
}
else {
my $file = $all_files[ -$par{instance} ];
$self->{file} = $file;
$self->{instance} = $par{instance};
$self->_slurp( $file, 0 );
}
$self->{size} = { map { $_, ( stat $_ )[7] } @all_files };
$self;
}
sub _last_timestamp {
my $fil = shift;
open (my $tmpf, '<', $fil) or return undef;
my $stamp;
while (<$tmpf>) {
my ($month,$day,$time,$year) = /
^\w{3}\s # day of week (ignore)
(\w{3})\s+ # Month => $1
(\d\d?)\s+ # day of month => $2
(\d\d\:\d\d\:\d\d) # time => $3
\s+(\d{4}) # year => $4
/x;
($day,$month,$year,$time) = /
^MonPerf # performanceMonitor entry
[^#]+\# # skip to hash
\s+(\d\d?)\- # day of month => $1
(\w{3})\- # Month => $2
(\d{4})\s+ # year => $3
(\d\d\:\d\d\:\d\d) # time => $4
/x unless $month;
$stamp = Time::Piece->strptime( "$year-$month-$day $time",
'%Y-%b-%d %H:%M:%S' )
if $month;
}
$stamp;
}
sub tail {
my $self = shift;
for my $file ( bsd_glob $self->{glob} ) {
if ( !exists $self->{size}{$file} ) {
$self->_slurp( $file, 0, @_ );
return $file;
}
next if $self->{size}{$file} eq ( stat $file )[7];
$self->_slurp( $file, $self->{size}{$file}, @_ );
return $file;
}
my $file = $self->{file};
$self->_slurp( $file, $self->{size}{$file}, @_ );
undef;
}
sub waitfor {
my $self = shift;
my %par = validate(
@_,
{
match => { type => SCALARREF },
sleep => { type => SCALAR, regexp => qr/^\d+$/, default
+=> 5 },
text => { type => SCALAR },
timeout => { type => SCALAR, regexp => qr/^\d+$/, optional
+ => 1 },
}
);
my $start = localtime;
my $interrupted = 0;
local $SIG{INT} = sub { $interrupted++ };
local $| = 1;
print STDERR "Waiting for $par{text} ";
while ( !$self->match( $par{match} ) ) {
if ($interrupted) {
$SIG{INT} = 'DEFAULT';
$interrupted = 0;
print STDERR "\nSkip waiting for $par{text} ?";
return 0 if <STDIN> =~ /y(es)?/i;
$SIG{INT} = sub { $interrupted++ };
}
my $now = localtime;
return 0 if $par{timeout} and $now - $start > $par{timeout};
$self->tail;
print STDERR '.';
sleep $par{sleep};
}
1;
}
sub _slurp {
my ( $self, $file, $pos, $mode ) = @_;
$mode ||= '';
my $fh;
open $fh, '<', $file or return undef;
if ($pos) {
seek $fh, $pos, 0;
}
my $firstlin = <$fh>;
if ( defined($firstlin) && ($firstlin =~ /^\=+$/m )) {
my ($tim) = $file =~ /\.(\d{8}\-\d{6})/;
local $_ = '';
my %env;
while ( !/^\=+$/ ) {
$_ = <$fh>;
$_ .= <$fh> while tr/'/'/ & 1;
chomp;
my ( $var, $rhs ) = /^(\w+)\=('.*'|.*)$/s;
next unless $var;
$env{$var} = $rhs;
}
$self->{env}{$tim} = \%env;
undef $firstlin;
}
local $/ = undef;
my $cont = <$fh>;
if (!defined $cont) {
$cont = '';
}
if (defined($firstlin)) {
$cont = $firstlin . $cont;
}
if ( ( $mode eq 'append' ) && $self->contents ) {
$self->contents->append($cont);
}
else {
$self->{contents} = LCH::AppText->new($cont);
}
$self->{file} = $file;
$self->{size}{$file} = tell $fh;
}
sub file {
my $self = shift;
return undef unless exists $self->{file};
$self->{file};
}
sub contents {
my $self = shift;
$self->{contents};
}
sub range {
my $self = shift;
my $cont = $self->contents or return undef;
$cont->range(@_);
}
sub split {
my $self = shift;
my $cont = $self->contents or return undef;
$cont->split(@_);
}
sub match {
my $self = shift;
my $cont = $self->contents or return undef;
$cont->match(@_);
}
sub flush {
my $self = shift;
$self->{contents} = '';
}
1; #this line is important and will help the module return a true v
+alue
__END__
LCH::AppText
package LCH::AppText;
use strict;
our $VERSION = 0.04;
=head1 NAME
LCH::AppText - Class for parsing application text (e.g. logfiles)
=head1 SYNOPSIS
use LCH::AppText
local $/ = undef;
my $apt = LCH::AppText->new(<>);
my @revals = $apt->range(qr/itdFullRevalStarted/,qr/itdFullRevalEnde
+d/);
@flows = $revals[$i]->match(qr/read (\d+) cashflows/);
=head1 DESCRIPTION
This module allows application text to be parsed in suitable ways for
analysis.
=head2 new
Pass in a string from an LCH application to create an LCH::AppText obj
+ect.
=head2 append
Append to an existing LCH::AppText object
=head2 split
Return a list of LCH::AppText objects, begin a new one on each matchin
+g
line.
=head2 range
Supply 2 regexs, one for the start of the range, one for the end. This
+ method outputs
a list of the ranges, as LCH::AppText objects.
=head2 match
Provide a regexp with captures. Returns a 2 dimensional array of captu
+re returns
within matching instances.
=head1 AUTHOR
Ivor Williams
=head1 SEE ALSO
perl(1).
=cut
sub new {
my ($pkg, $text) = @_;
my @self = split /^/,$text;
bless \@self, $pkg ;
}
sub append {
my ($self, $extra) = @_;
push @$self, split /^/,$extra;
}
sub range {
my ($self, $from, $to) = @_;
my @out;
my $ind = 0;
for (@$self) {
if (my $ff = /$from/ .. /$to/) {
$out[$ind] .= $_;
$ind++ if $ff =~ /E/;
}
}
map {LCH::AppText->new($_)} @out;
}
sub split {
my ($self, $match) = @_;
my @out;
my $ind = 0;
for (@$self) {
$ind++ if /$match/;
$out[$ind] .= $_;
}
map {LCH::AppText->new($_)} @out;
}
sub text {
my $self = shift;
join '',@$self;
}
sub firstline {
my $self = shift;
$self->[0];
}
sub lastline {
my $self = shift;
$self->[-1];
}
sub match {
my ($self, $re) = @_;
my @out;
for (@$self) {
my @mat = /$re/;
push @out,\@mat if @mat;
}
@out;
}
1; #this line is important and will help the module return a true valu
+e
__END__