view release on metacpan or  search on metacpan

Log.pm  view on Meta::CPAN

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<cns> 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->echo_msg(" -- 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 $fn1 = $ar->{fn_brf}; 
    my $fn2 = $ar->{fn_dtl}; 
    my $cns = ${$ar}{cns}; 
    $s->{hf_brf} = $fh1;
    $s->{hf_dtl} = $fh2;
    $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}|"; }