librefdb-perlmod-perl 1.2-2 / usr / share / perl5 / RefDB / Log.pm

## package RefDB:Log
## RefDB log module

## markus@mhoenicka.de 2002-12-27
## $Id: Log.pm,v 1.2 2003/09/16 21:04:04 mhoenicka Exp $

##   This program is free software; you can redistribute it and/or modify
##   it under the terms of the GNU General Public License as published by
##   the Free Software Foundation; either version 2 of the License, or
##   (at your option) any later version.
##   
##   This program is distributed in the hope that it will be useful,
##   but WITHOUT ANY WARRANTY; without even the implied warranty of
##   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
##   GNU General Public License for more details.
   
##   You should have received a copy of the GNU General Public License
##   along with this program; if not, write to the Free Software
##   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

## Package main documentation

=head1 NAME

RefDB::Log - Perl extension providing logging support for RefDB applications

=head1 SYNOPSIS

  use RefDB::Log;
  
  my $log = RefDB::Log::->new("FILE", "INFO", "/var/log/testdata.out", "myapp.pl");

  ## this message should appear
  $log->log_print("ERR", "first test message");

  ## this message should not appear
  $log->log_print("DEBUG", "second test message");

  $log->close();


 DESCRIPTION

RefDB::Log defines a class that povides logging support to RefDB applications. After creating a Log object with appropriate settings for log level, log destination, the path to a log file (if logdest is "File"), and a string that is prepended to log messages, calls to the log_print() function will send a log message to the appropriate destination if the log level permits this.

=head1 FEEDBACK

Send bug reports, questions, and comments to the refdb-users mailing list at:

refdb-users@lists.sourceforge.net

For list information and archives, please visit:

http://lists.sourceforge.net/lists/listinfo/refdb-users


=head1 AUTHOR

Markus Hoenicka, markus@mhoenicka.de

=head1 SEE ALSO

This module is part of the RefDB package, a reference manager and bibliography tool for markup languages. Please visit http://refdb.sourceforge.net for further information.

=cut
package RefDB::Log;

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

$VERSION = "1.2";

=head2 new

Title   : new

Usage   : $pm = new RefDB::Log();

Function: Creates a new Log object

Argument: log destination (0|1|2 or STDERR|SYSLOG|FILE)
          log level (0-7 or ALERT|CRIT|ERR|WARNING|NOTICE|INFO|DEBUG)
          log file (path to custom log file if destination is 2)
          prefix for log messages (denotes where the log is from)

Return  : a Log object

=cut

######################################################################
## new(): creates a new Log element
## Arguments: log destination (0|1|2)
##            log level (0-7)
##            log file
##            prefix for log messages
## Returns: new Log object
######################################################################
sub new($$$$) {
    my ($class, $logdest, $loglevel, $logfile, $prefix) = @_;
    my $self = {};

    ## the filehandle for the log file, if any
    $self->{fh} = undef;

    ## log destination (0=stderr, 1=syslog, 2=logfile)
    $self->{logdest} = &num_logdest($logdest);

    ## log level (numeric, 0-7)
    $self->{loglevel} = &num_loglevel($loglevel);

    ## name of a custom log file
    $self->{logfile} = $logfile;

    ## name of a custom log file
    $self->{prefix} = $prefix;

    ## set up logging
    if ($logdest == 1) {
	openlog($prefix, "pid", "user");
    }
    elsif ($logdest == 2) {
	$self->{fh} = eval { local *FH; open(FH, ">> $logfile") or die; *FH{IO}};
	if ($@) {
	    $self->{fh} = undef;
	    $self->{logdest} = 0;
	}
    }
    ## else: messages go to stderr

    bless $self, $class;
    return $self;
}

=head2 num_loglevel

Title   : num_loglevel

Usage   : $level = log->num_loglevel("ALERT")

Function: Calculates the numeric log level from either a numeric or
          alphanumeric value

Argument: log level (0-7 or ALERT|CRIT|ERR|WARNING|NOTICE|INFO|DEBUG)

Return  : numeric log level

=cut

##********************************************************************
## num_loglevel(): converts a numeric or alphanumeric log level to
##                 numeric
## Arguments: numeric or alphanumeric log level
## Returns: numeric log level
##********************************************************************
sub num_loglevel($) {
    my $level = shift;

    $level = uc $level;

    if ($level eq "EMERG") {
	return 0;
    }
    elsif ($level eq "ALERT") {
	return 1;
    }
    elsif ($level eq "CRIT") {
	return 2;
    }
    elsif ($level eq "ERR") {
	return 3;
    }
    elsif ($level eq "WARNING") {
	return 4;
    }
    elsif ($level eq "NOTICE") {
	return 5;
    }
    elsif ($level eq "INFO") {
	return 6;
    }
    elsif ($level eq "DEBUG") {
	return 7;
    }
    elsif ($level =~ m/^([0-7])/) {
	return $1;
    }
    
    ## switch off logging for anything else
    return -1;
}

=head2 num_logdest

Title   : num_logdest

Usage   : $dest = log->num_logdest("SYSLOG")

Function: Calculates the numeric log destination from either a numeric or
          alphanumeric value

Argument: log dest (0-2 or STDERR|SYSLOG|FILE)

Return  : numeric log dest

=cut

##********************************************************************
## num_logdest(): converts a numeric or alphanumeric log destination to
##                numeric
## Arguments: numeric or alphanumeric log destination
## Returns: numeric log destination
##********************************************************************
sub num_logdest($) {
    my $dest = shift;

    $dest = uc $dest;

    if ($dest =~ m/^[0-2]/) {
	return substr ($dest, 0, 1);
    }
    else { ## non-numeric
	if ($dest eq "STDERR") {
	    return 0;
	}
	elsif ($dest eq "SYSLOG") {
	    return 1;
	}
	elsif ($dest eq "FILE") {
	    return 2;
	}
    }
    
    ## default to stderr
    return 0;
}

=head2 log_print

Title   : log_print

Usage   : $log->log_print("ERR", "could not open file")

Function: sends a log message to the selected destination

Argument: priority (ALERT|CRIT|ERR|WARNING|NOTICE|INFO|DEBUG)
          message

=cut

##********************************************************************
## log_print(): prints a log message 
## Arguments: priority (alphanumeric)
##            message
## Return value is ignored
##********************************************************************
sub log_print($$) {
    my ($self, $priority, $msg) = @_;
    my $numpriority = &num_loglevel($priority);

    if ($numpriority <= $self->{loglevel}) {
	if ($self->{logdest} == 0) {
	    print STDERR "$self->{prefix}:$msg\n";
	}
	elsif ($self->{logdest} == 1) {
	    syslog($priority, $msg);
	}
	else { ## logfile
	    my $now = gmtime();
	    my $log = $self->{fh};

	    print $log "$numpriority:pid:$now:$msg\n";
	}
    }
}

=head2 close

Title   : close

Usage   : $log->close()

Function: closes the log destination

=cut

##********************************************************************
## close(): closes the log destination
##********************************************************************
sub close() {
    my $self = shift;

    if ($self->{logdest} == 2) {
	my $log = $self->{fh};
	close $log;
    }
    elsif ($self->{logdest} == 1) {
	closelog();
    }
}

1;
__END__