package Log;

#===============================================================================
# $Id: Log.pm,v 1.8 2006-02-22 20:05:16 radmat Exp $
# Logging package for info/warn/die/debug/trace
#===============================================================================
use strict;
use warnings;
our $VERSION = sprintf "%d.%03d", q$Revision: 1.8 $ =~ /: (\d+)\.(\d+)/;    #CVS

#__modules__
use Fcntl;
use POSIX qw[_exit strftime];

#use subs  qw[warn die];

require Exporter;
our @ISA    = 'Exporter';
our @EXPORT = qw[info debug trace];

#__globals__
our $logfile = ( caller(0) )[0] . '.log';    # Default to main.log
our ( $debug, $trace ) = ( 0, 0 );           # No logging of debug() and trace()
our ( $info,  $warn )  = ( 1, 2 );           # Log info(), Log and print warn()
our $seq = 0;                                # Session sequence

our $line_format = '%s %d.%04d %s';          # Line format (see POD)
our $time_format = '%Y-%m-%dT%H:%M:%S';      # POSIX strftime format
our $log_umask   = 0111;

#__subroutines__
#_____________________________________________________________________ import()_
sub import {

    # import - override Exporter->import
    my $me = shift;
    if ( @_ == 1 ) { $logfile = shift }
    elsif ( @_ % 2 == 0 ) {
        my %parm = @_;
        $logfile = $parm{file}   if defined $parm{file};
        $debug   = $parm{debug}  if defined $parm{debug};
        $trace   = $parm{trace}  if defined $parm{trace};
        $info    = $parm{info}   if defined $parm{info};
        $warn    = $parm{'warn'} if defined $parm{'warn'};
        
        $line_format = $parm{lineform} if defined $parm{lineform};
        $time_format = $parm{timeform} if defined $parm{timeform};
        $log_umask   = $parm{'umask'}  if defined $parm{'umask'};
    }
    else { }
    
    # TODO ? strings subs for 0/1/2
    # TODO per-package configuration
    
    umask $log_umask;
    sysopen( LOG, $logfile, O_WRONLY | O_APPEND | O_CREAT, 0777 )
      or die("Cannot log to $logfile: $!");
    select LOG;
    $| = 1;
    select STDOUT;

    $SIG{__WARN__} = sub { Log::warn(@_) };
    $SIG{__DIE__}  = sub { Log::die(@_) };

    $me->export_to_level( 1, $me, @EXPORT );
    print LOG "\n";
    info('Logging started');
}

#_______________________________________________________________________ _msg()_
sub _msg {

    # _msg ( \@msgarray )
    my @a = @{ $_[0] };
    foreach (@a) {
        unless ( defined $_ ) { $_ = ''; next; }
        s/[\r\n]+/ /g;
    }
    return join( ' ', @a );
}

#_______________________________________________________________________ _log()_
sub _log {

    # _log ( )
    my $time = strftime( $time_format, localtime );
    printf LOG $line_format."\n", $time, $$, $seq++, _msg( \@_ );
    }
    
#_______________________________________________________________________ warn()_
sub warn ($) {

    # warn ( )
    _log( 'W:', @_ ) if $warn;
    CORE::warn(@_) if $warn == 2;
}

#________________________________________________________________________ die()_
sub die ($) {

    # die ( )
    _log( 'X:', @_ );
    CORE::die(@_);
}

#_______________________________________________________________________ info()_
sub info ($) {

    # info ( )
    return undef unless $info;
    _log( 'I:', @_ );
    print STDERR _msg( \@_ ), "\n" if $info == 2;
}

#______________________________________________________________________ debug()_
sub debug ($) {

    # debug ( )
    return undef unless $debug;
    _log( 'D:', @_ );
    print STDERR '. Debug:', _msg( \@_ ), "\n" if $debug == 2;
}

#______________________________________________________________________ trace()_
sub trace ($) {

    # trace ( )
    return undef unless $trace;
    _log( 'T:', @_ );
    print STDERR '* Trace:', _msg( \@_ ), "\n" if $trace == 2;
}

1;    # modules must return a true value.

__END__