—#
# $Id: Datum.pm,v 1.1 2002/03/09 15:53:16 wendigo Exp $
#
# Copyright (c) 1999, Raphael Manfredi
#
# You may redistribute only under the terms of the Artistic License,
# as specified in the README file that comes with the distribution.
#
# HISTORY
# $Log: Datum.pm,v $
# Revision 1.1 2002/03/09 15:53:16 wendigo
# New maintainer
#
# Revision 0.2.1.1 2001/03/31 10:00:41 ram
# patch7: massive renaming Devel::Datum -> Carp::Datum
#
# Revision 0.2 2000/11/06 19:30:32 ram
# Baseline for second Alpha release.
#
# $EndLog$
#
use
strict;
require
Log::Agent::Driver;
########################################################################
package
Log::Agent::Driver::Datum;
@ISA
=
qw(Log::Agent::Driver)
;
#
# ->make -- defined
#
# Creation routine.
#
# Attributes:
# driver the underlying driver originally configured
#
sub
make {
my
$self
=
bless
{},
shift
;
my
(
$driver
) =
@_
;
$self
->_init(
''
, 0);
# 0 is the skip Carp penalty
$self
->{driver} =
$driver
;
$driver
->add_penalty(2);
# We're intercepting the calls
return
$self
;
}
#
# Attribute access
#
sub
prefix {
$_
[0]->{driver}->prefix }
sub
driver {
$_
[0]->{driver} }
#
# Cannot-be-called routines.
#
#
# ->channel_eq -- defined
#
# Redirect comparison to driver.
#
sub
channel_eq {
my
$self
=
shift
;
my
(
$chan1
,
$chan2
) =
@_
;
return
$self
->driver->channel_eq(
$chan1
,
$chan2
);
}
#
# ->datum_trace
#
# Emit a Carp::Datum trace, which will be a logwrite() on the 'debug' channel.
#
sub
datum_trace {
my
$self
=
shift
;
my
(
$str
,
$tag
) =
@_
;
Carp::Datum::trace(
$str
,
$tag
);
}
#
# intercept
#
# Intercept call to driver by calling ->datum_trace() first, then resume
# regular operation on the driver, if the channel where message would go
# is not the same as the debug channel.
#
sub
intercept {
my
(
$aref
,
$tag
,
$op
,
$chan
,
$prepend
) =
@_
;
my
$self
=
shift
@$aref
;
#
# $aref can be [$str] or [$offset, $str]
#
my
$pstr
=
$aref
->[
$#$aref
]; # String is
last
argument
if
(
defined
$prepend
) {
$pstr
=
$pstr
->clone;
# We're prepending tag on a copy
$pstr
->prepend(
"$prepend: "
);
}
$self
->datum_trace(
$pstr
,
$tag
);
my
$driver
=
$self
->driver;
if
(
$driver
->channel_eq(
'debug'
,
$chan
)) {
die
"$pstr\n"
if
$prepend
eq
'FATAL'
;
}
else
{
$driver
->
$op
(
@$aref
);
}
}
#
# Interface interception.
#
# The string will be tagged with ">>" to make it clear it comes from Log::Agent,
# unless it's a fatal string from logconfess/logcarp/logdie, in wich case
# it is tagged with "**".
#
sub
logconfess { intercept(\
@_
,
'**'
,
'logconfess'
,
'error'
,
'FATAL'
) }
sub
logxcroak { intercept(\
@_
,
'**'
,
'logxcroak'
,
'error'
,
'FATAL'
) }
sub
logdie { intercept(\
@_
,
'**'
,
'logdie'
,
'error'
,
'FATAL'
) }
sub
logerr { intercept(\
@_
,
'>>'
,
'logerr'
,
'error'
,
'ERROR'
) }
sub
logwarn { intercept(\
@_
,
'>>'
,
'logwarn'
,
'error'
,
'WARNING'
) }
sub
logxcarp { intercept(\
@_
,
'>>'
,
'logxcarp'
,
'error'
,
'WARNING'
) }
sub
logsay { intercept(\
@_
,
'>>'
,
'logsay'
,
'output'
) }
#
# logwrite -- redefined
#
# Emit the message to the specified channel
#
sub
logwrite {
my
$self
=
shift
;
my
(
$chan
,
$prio
,
$level
,
$str
) =
@_
;
#
# Have to be careful not to recurse through ->datum_trace().
# Look at who is calling us (immediate caller is Log::Agent).
#
my
$pkg
=
caller
(1);
if
(
$pkg
=~ /^Carp::Datum\b/) {
my
$drv
=
$self
->driver;
return
unless
defined
$drv
;
# Can happen during global destruct
$drv
->logwrite(
$chan
,
$prio
,
$level
,
$str
);
return
;
}
#
# The following will recurse back to us, but the above check will
# cut the recursion.
#
intercept([
$self
,
$str
],
'>>'
,
'logwrite'
,
$chan
);
}
__END__
=head1 NAME
Log::Agent::Driver::Datum - interceptor driver to cooperate with Carp::Datum
=head1 SYNOPSIS
NONE
=head1 DESCRIPTION
The purpose of the interceptor is to cooperate with Carp::Datum by emitting
traces to the debug channel via Carp::Datum's traces facilities.
This driver is automatically installed by Log::Agent when Carp::Datum is
in use and debug was activated through it.
=head1 AUTHOR
Raphael Manfredi F<E<lt>Raphael_Manfredi@pobox.comE<gt>>
=head1 SEE ALSO
Carp::Datum(3).
=cut