package LCH::LogFile;
use strict;

our $VERSION = '0.12';

########################################### main pod documentation begin ##

=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 assumptions about
directory and file naming, as per SwapClear. See the C<new> method below.

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 application component
logs live in their own directories off this.

=item C<app>

Name of the application component to tail. The logs for this application live in a 
directory off the path (above). Application logs are of the form logFile.yyyymmdd-hhmmss
taking their time stamp from when the app was started.

If no app is specified, will use the main log file SwapClearLogFile.yyyymmdd. 

=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 not 0 by convention
(like vilog.ksh and taillog.ksh).

You can use an LCH::LogFile object to track multiple application instances. Don't
specify an instance if you want to do this - use a timestamp range with 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> parameters. 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 installment 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 the date range.
If the size of any log file has been increased, tail will return the logfile 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 was read. Other
method calls process the actual chunk. Further calls to tail will return 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 expression
b<match> is found. waitfor returns true when the expression matches. Failure
indicates either that the message timed out, or that the user interrupted
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 the 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 read from STDIN. If the user
responds with a Y, y or yes, etc. this will cause waitfor to return undef. 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 instance 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:$sec",
                '%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 value
__END__


##</code><code>##


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/itdFullRevalEnded/);

  @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 object.

=head2 append

Append to an existing LCH::AppText object

=head2 split

Return a list of LCH::AppText objects, begin a new one on each matching
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 capture 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 value
__END__