File Coverage

CGI/AppBuilder/Log.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

package CGI::AppBuilder::Log;

use warnings;
use Carp;
use IO::File;
use POSIX qw(strftime);

use CGI::AppBuilder;

# require Exporter;
@ISA = qw(Exporter CGI::AppBuilder);
our @EXPORT = qw();
our @EXPORT_OK = qw(start_log end_log
    );
our %EXPORT_TAGS = (
  all      => [@EXPORT_OK],
  log      => [qw(start_log end_log)],
);
$CGI::AppBuilder::Log::VERSION = 0.12;

=head1 NAME

CGI::AppBuilder::Log - Gather and write log entries for CGI applications

=head1 SYNOPSIS

    my $self = bless {}, "main";
    use CGI::AppBuilder::Log /:log/;

=head1 DESCRIPTION

The package contains the methods for gathering and creating log file.

=head3 new (ifn => 'file.cfg', opt => 'hvS:')

This is a inherited method from CGI::AppBuilder. See the same method
in CGI::AppBuilder for more details.

=cut

sub new {
  my ($s, %args) = @_;
  return $s->SUPER::new(%args);
}

=head2 start_log($dtl, $brf, $cns, $arg, $lvl)

Input variables:

  $dtl - file name for detailed log
  $brf - file name for brief log
  $cns - a list of fields which are stored in brief log
  $arg - command line arguments
  $lvl - log levle
         1 - default:start_time,end_time,elapsed_time,user,args,result
         2 - 1 plus: remote_addr,http_user_agent,http_accept_language,
                     http_accept_charset

Variables used or routines called:

  echoMSG - print debug messages

How to use:

  use CGI::AppBuilder::Log qw(:log);
  my $self= bless {}, "main";
  my $ar = $self->start_log('details.log','brief.log',
    'start_time,end_time,elapsed_time,file_tranferred,status');

Return: a hash array containing the fields in $cns.

This method creates log files if they do not exist and prepare a
hash array to store needed fields for end_log. The hash array has
the following elements:

  cns    - a list of field names separated by commas
  fld    - a hash array containing the field defined in cns.
  fn_brf - file name for brief log
  fh_brf - file handler for brief log
  fn_dtl - file name for detail log
  fh_dtl - file handler for detail log

If the I is not specifed, then it defaults to
start_time,end_time,elapsed_time,user,args,result.

=cut

sub start_log {
    my $s = shift;
    my ($dtl,$brf,$cns,$arg,$lvl) = @_;
    my $ar = bless {}, ref($s);
    return $ar if ! $dtl;

    $lvl = 1 if !$lvl;
    $s->echoMSG(" -- start logging in $dtl...",1);
    my ($cn1,$cn2) = ("","");
    if (!$cns) {
        $cn1='start_time,end_time,elapsed_time,user,args,result';
        $cns = $cn1;
        if ($lvl>1) {
            $cn2  = "REMOTE_ADDR,HTTP_USER_AGENT,HTTP_ACCEPT_LANGUAGE,";
            $cn2 .= "HTTP_ACCEPT_CHARSET";
        }
    }
    foreach my $k (split /,/, $cns) {
        $k = lc $k; ${$ar}{fld}{$k} = "";
    }
    if ($cn2) {
        foreach my $k (split /,/, $cn2) {
            my $i = lc $k;
            ${$ar}{fld}{$i} = $ENV{$k} if  exists $ENV{$k};
            ${$ar}{fld}{$i} = ""       if !exists $ENV{$k};
        }
        $cns .= lc ",$cn2";
    }
    $ar->{user} = ($^O =~ /(linux|solaris)/i) ? `/usr/ucb/whoami` : "";
    $ar->{args} = (exists $ENV{QUERY_STRING})?
                   $ENV{QUERY_STRING}:$arg;
    my ($tx1, $txt);
    my $fh_dtl = new IO::File ">> $dtl";
    croak "ERR: could not write to $dtl: $!\n" if !defined($fh_dtl);
    ${$ar}{fld}{start_time} = time;
    $ENV{FH_DEBUG_LOG} = $fh_dtl;
    ${$ar}{cns}    = $cns;
    ${$ar}{fn_dtl} = $dtl;
    ${$ar}{fh_dtl} = $fh_dtl;
    my $stm = strftime "%a %b %e %H:%M:%S %Y",
        localtime(${$ar}{fld}{start_time});
    $tx1 = "# File Name: $dtl\n# Start at $stm\n";
    print $fh_dtl $tx1;
    return $ar if ! $brf;

    my ($pkg, $fn, $line, $subroutine, $hasargs, $wantarray,
       $evaltext, $is_require, $hints, $bitmask) = caller(3);
    $subroutine = 'start_log' if ! $subroutine;
    $tx1  = "# File Name: $brf\n# Generated By: $subroutine\n";
    $tx1 .= "# Fields: (elapsed times are in seconds)\n";
    $cn1 = $cns; $cn1 =~ s/,/\|/g;
    $tx1 .= "# $cn1\n";
    $txt = $tx1 if ! -f $brf;
    my $dbg = $s->debug;
    $s->debug(1)  if !$dbg;   # we at least log message at level 1
    my $fh_brf = new IO::File ">> $brf";
    print $fh_brf "$txt"     if $txt;
    $ar->{fn_brf} = $brf;
    $ar->{fh_brf} = $fh_brf;
    return $ar;
}

=head2 end_log($ar)

Input variables:

  $ar  - array ref returned from start_log. The elements can
         be populated in before end_log.

Variables used or routines called:

  strftime - time formater from POSIX
  disp_param - display parameters

How to use:

  use CGI::AppBuilder::Log qw(:log);
  my $self= bless {}, "main";
  my $ar = $self->start_log('details.log','brief.log');
  $self->end_log($ar);

Return: none.

=cut

sub end_log {
    my $s = shift;
    my ($ar) = @_;
    $s->echoMSG(" -- end logging ...",1);
    my %b   = %{${$ar}{fld}};
    # my $f   = "%a %b %e %H:%M:%S %Y";
    my $f   = "%Y%m%d.%H%M%S";
    my $fh1 = ${$ar}{fh_brf};
    my $fh2 = ${$ar}{fh_dtl};
    my $cns = ${$ar}{cns};
    $b{end_time}     = time;
    $b{elapsed_time} = $b{end_time} - $b{start_time};
    $b{start_time}   = strftime $f, localtime($b{start_time});
    $b{end_time}     = strftime $f, localtime($b{end_time});
    $b{result}       = 'OK';

    my ($txt) = ("");
    foreach my $k (split /,/, $cns) { $txt .= "$b{$k}|"; }
    $txt =~ s/\|$//;

    $s->disp_param(\%b);
    print $fh1 "$txt\n";
    print $fh2 "# End at $b{end_time} $b{result}\n";
    undef $fh1;   # close breif  file hanlder
    undef $fh2;   # close detail file handler
}

1;

=head1 CODING HISTORY

=over 4

=item * Version 0.10

Extract start_log and end_log from Debug::EchoMessage.

=item * Version 0.11

=back

=head1 FUTURE IMPLEMENTATION

=over 4

=item * no plan yet

=back

=head1 AUTHOR

Copyright (c) 2004 Hanming Tu.  All rights reserved.

This package is free software and is provided "as is" without express
or implied warranty.  It may be used, redistributed and/or modified
under the terms of the Perl Artistic License (see
http://www.perl.com/perl/misc/Artistic.html)

=cut