http://www.perlmonks.org?node_id=358195

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__