File Coverage

blib/lib/Log/Stderr.pm

Criterion	Covered	Total	%
statement	16	35	45.7
branch	0	8	0.0
condition			n/a
subroutine	6	15	40.0
pod	9	10	90.0
total	31	68	45.5

package Log::Stderr;

use 5.008000;
use strict;
use warnings;

use Carp ;

use base 'Exporter' ;

our $VERSION = '1.01';

my @LOG_CONSTANTS = qw{
			LOG_NONE   LOG_EMERG LOG_ALERT
			LOG_CRIT   LOG_ERR   LOG_WARNING
			LOG_NOTICE LOG_INFO  LOG_DEBUG
		    } ;

my @LOG_ALIASES   = qw{
			LOG_ERROR  LOG_WARN
		    } ;

my @FUNCTIONS     = qw{ logger } ;

my @TAGS          = qw{all constants aliases} ;

my @SYMBOLS       = ( @LOG_CONSTANTS, @LOG_ALIASES, @FUNCTIONS ) ;

our @EXPORT_OK    = ( @SYMBOLS, @TAGS ) ;

our %EXPORT_TAGS  = (
		     all       => \@SYMBOLS,
		     constants => \@LOG_CONSTANTS,
		     aliases   => \@LOG_ALIASES,
		    ) ;

sub LOG_NONE    { return 0 } ;
sub LOG_EMERG   { return 1 } ;
sub LOG_ALERT   { return 2 } ;
sub LOG_CRIT    { return 3 } ;
sub LOG_ERR     { return 4 } ;
sub LOG_WARNING { return 5 } ;
sub LOG_NOTICE  { return 6 } ;
sub LOG_INFO    { return 7 } ;
sub LOG_DEBUG   { return 8 } ;

# Aliases
*LOG_ERROR = \&LOG_ERR ;
*LOG_WARN  = \&LOG_WARNING ;

# Default DEBUGLEVEL = LOG_NOTICE
our $DEBUGLEVEL = LOG_NOTICE ;


sub logger {
    my ($level,$message) = @_ ;
    my $caller = (caller(1))[3] ;

    $caller = "-e" if not $caller ;

    return if $level > $DEBUGLEVEL ;

    $message .= qq{\n} if not $message =~ m{\n$} ;
    my $now   = scalar localtime ;

    my $log ;
    $log  = qq{[$now] } ;
    $log .= qq{[$caller] } if $DEBUGLEVEL >= LOG_DEBUG ;
    $log .= $message ;

    print STDERR $log ;
}


1;
__END__