File Coverage

blib/lib/Log/Dispatch/WarnDie.pm

Criterion	Covered	Total	%
statement	10	15	66.6
branch	1	10	10.0
condition			n/a
subroutine	3	4	75.0
pod	0	1	0.0
total	14	30	46.6

package Log::Dispatch::WarnDie;

# Make sure we have version info for this module
# Be strict from now on

$VERSION = '0.04';
use strict;

# The logging dispatcher that should be used

my $DISPATCHER;

# Old settings of standard Perl logging mechanisms

my $WARN;
my $DIE;

# At compile time
#  Save current __WARN__ setting
#  Replace it with a sub that
#   Dispatches a warning message if there is a dispatcher
#   Executes the standard system warn() or whatever was there before

BEGIN {
    $WARN = $SIG{__WARN__};
    $SIG{__WARN__} = sub {
        $DISPATCHER->warning( $_[0] ) if $DISPATCHER;
        $WARN ? $WARN->( $_[0] ) : CORE::warn( $_[0] );
    };

#  Save current __DIE__ setting
#  Replace it with a sub that
#   Dispatches an error message if there is a dispatcher
#   Executes the standard system die() or whatever was there before

    $DIE = $SIG{__DIE__};
    $SIG{__DIE__} = sub {
        $DISPATCHER->error( $_[0] ) if $DISPATCHER;
        $DIE ? $DIE->( $_[0] ) : CORE::die( $_[0] );
    };

#  Make sure we won't be listed ourselves by Carp::

    $Carp::Internal{$_} = 1
     foreach 'Log::Dispatch','Log::Dispatch::Output',__PACKAGE__;
} #BEGIN

# Satisfy require

1;

#---------------------------------------------------------------------------

# Class methods

#---------------------------------------------------------------------------
# dispatcher
#
# Set and/or return the current dispatcher
#
#  IN: 1 class (ignored)
#      2 new dispatcher (optional)
# OUT: 1 current dispatcher

sub dispatcher {

# Set the new dispatcher if there is any
# Return the current dispatcher

    $DISPATCHER = $_[1] if @_ > 1;
    $DISPATCHER;
} #dispatcher

#---------------------------------------------------------------------------

# Perl standard features

#---------------------------------------------------------------------------
# import
#
# Called whenever a -use- is done.
#
#  IN: 1 class (ignored)
#      2 new dispatcher (optional)

*import = \&dispatcher;

#---------------------------------------------------------------------------
# unimport
#
# Called whenever a -use- is done.
#
#  IN: 1 class (ignored)

sub unimport { import( undef ) } #unimport

#---------------------------------------------------------------------------

__END__