package TKL::Log;

## $Id: Log.pm,v 1.3 2003/09/29 08:09:34 sondberg Exp $

use IO::File;
use IO::Handle;
use Carp;
use Exporter;
use strict;

## Define module's interface to the world

my @log_levels = qw(tkl_log_debug tkl_log_log tkl_log_warn
		    tkl_log_fatal tkl_log_level_all tkl_log_level_norm);

our @ISA = qw(Exporter);
our @EXPORT_OK = @log_levels;
our %EXPORT_TAGS = (
			log_levels => [@log_levels]
		   );


## Logging groups 

sub tkl_log_fatal	{ 1 }
sub tkl_log_warn	{ 2 }
sub tkl_log_log		{ 4 }
sub tkl_log_debug	{ 8 }

## Logging levels

sub tkl_log_level_all	{ 15 }
sub tkl_log_level_norm	{ 7 }

my $default_log_level = tkl_log_level_norm;

my $log_level_names = {
    			&tkl_log_fatal	=>	'fatal',
			&tkl_log_warn	=>	'warn',
			&tkl_log_log	=>	'log',
			&tkl_log_debug	=>	'debug'
		      };

## File locks

sub lock_sh		{ 1 }	## Shared file lock
sub lock_ex		{ 2 }	## Exclusive lock
sub lock_nb		{ 4 }	## Non-blocking request
sub lock_un		{ 8 }	## Unlock



sub new {
    my ($class, @args) = @_;
    my $self  = {
			logfile		=> "/var/log/tkl/tkl.log",
			level		=> $default_log_level,
			@args };
		
    my $fh = new IO::File('>>' . $self->{logfile}) or
    	     croak "$0: Unable to open file '" . $self->{logfile} . "' for appending: $!";
    
    bless $self, $class;
    
    $fh->autoflush(1);
    $self->{fh} = $fh;
    $self->log(tkl_log_debug, "Logging initialized.");

    return $self;
}


sub log {
    my ($self, $level, @msg) = @_;
    my $fh = $self->{fh};
    my $log_level = $self->{level};
    my ($day, $month, $year, $sec, $min, $hour) = (localtime)[3, 4, 5, 0, 1, 2];
    my $text = $log_level_names->{$level};
    my ($script) = ($0 =~ /([^\/]*)$/);
    my $tm = sprintf("%02d:%02d:%02d-%02d/%02d/%d",
    		     $hour, $min, $sec, $day, $month + 1, $year + 1900);

    if ($level & $log_level) {
	unless (flock($fh, lock_ex | lock_nb)) {
	    unless (flock($fh, lock_ex)) {
		print STDERR "$0: Can't get exclusive log on logfile ($!)";
		return;
	    }
	}
	
	print $fh $tm, " [$text] ", $script, "($$): ", @msg, "\n";
	flock($fh, lock_un);
    }
}


1;

__END__

=head1 NAME

TKL::Log - Perl package implementing simple methods logging.

=head1 SYNOPSIS

  use TKL::Log qw(:log_levels);

  my $logger = new TKL::Log(logfile => 'my.log');

  $logger->log(tkl_log_log, "Hello world");

=head1 DESCRIPTION

Generic logging package for the TKL portal toolkit. 4 log levels are supported

  - fatal
  - warning
  - log
  - debug

The logging system respects advisory file locks enabling multiple processes to
log to the same file simultaniously.

These are the supported methods:

=head2 Methods

=head3 new
The object constructor. Should be called this way,

  my $logger = new TKL::Log(logfile => 'my.log', level => tkl_log_level_all);

where the logfile arguments is mandatory, and where the level parameter sets
the log level. If not specified, logging level is set to normal, i.e. ignoring
debug log entries.

=head3 log
This method sends a logging entry to the logfile:

  $logger->log($level, "Hello world");

where $level can be one of the following symbols:

  tkl_log_fatal
  tkl_log_warn
  tkl_log_log
  tkl_log_debug

Please, remember to import these symbols to your client script with

  use TKL::Log qw(:log_levels);

=head1 AUTHOR

Anders Sønderberg Mortensen <sondberg@indexdata.dk>
Indexdata
2003/09/25

=head1 SEE-ALSO

perl(1).

=cut