Log::Agent::Driver::Default - default logging driver for Log::Agent

Log-Agent documentation Contained in the Log-Agent distribution.

Index

Code Index:

NAME

Top

Log::Agent::Driver::Default - default logging driver for Log::Agent

SYNOPSIS

Top

 # Implicit use
 use Log::Agent;
 logconfig(-prefix => "prefix");   # optional

 # Explicit use
 use Log::Agent;
 require Log::Agent::Driver::Default;

 my $driver = Log::Agent::Driver::Default->make("prefix");
 logconfig(-driver => $driver);

DESCRIPTION

Top

The default logging driver remaps the logxxx() operations to their default Perl counterpart. For instance, logerr() will issue a warn() and logwarn() will call warn() with a clear "WARNING: " emphasis (to distinguish between the two calls).

The only routine of interest here is the creation routine:

make($prefix)

Create a Log::Agent::Driver::Default driver whose prefix string will be $prefix. When no prefix is configured, the first letter of each logged string will be uppercased.

CHANNELS

Top

The error, output and debug channels all go to STDERR.

BUGS

Top

If logdie() is used within an eval(), the string you will get in $@ will be prefixed. It's not really a bug, simply that wrapping a code into eval() and parsing $@ is poor's man exception handling which shows its limit here: since the programmer using logdie() cannot foresee which driver will be used, the returned string cannot be determined precisely. Morality: use die() if you mean it, and document the string as an exception.

AUTHOR

Top

Raphael Manfredi <Raphael_Manfredi@pobox.com>

SEE ALSO

Top

Log::Agent::Driver(3), Log::Agent(3).

Log-Agent documentation Contained in the Log-Agent distribution. 
#
# $Id: Default.pm,v 1.1 2002/03/09 15:54:27 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: Default.pm,v $
# Revision 1.1  2002/03/09 15:54:27  wendigo
# New maintainer
#
# Revision 0.2.1.2  2001/03/31 10:00:53  ram
# patch7: fixed =over to add explicit indent level
#
# Revision 0.2.1.1  2000/11/12 14:45:51  ram
# patch1: need to reset $\ before printing
#
# 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::Default;

use vars qw(@ISA);

@ISA = qw(Log::Agent::Driver);

#
# ->make			-- defined
#
# Creation routine.
#
sub make {
	my $self = bless {}, shift;
	my ($prefix) = @_;
	$self->_init($prefix, 0);					# 0 is the skip Carp penalty
	select((select(main::STDERR), $| = 1)[0]);	# Autoflush
	return $self;
}

#
# ->prefix_msg		-- defined
#
# Prepend "prefix: " to the error string, or nothing if no prefix, in which
# case we capitalize the very first letter of the string.
#
sub prefix_msg {
	my $self = shift;
	my ($str) = @_;
	my $prefix = $self->prefix;
	return ucfirst($str) if !defined($prefix) || $prefix eq '';
	return "$prefix: " . $str;
}

#
# ->write			-- defined
#
sub write {
	my $self = shift;
	my ($channel, $priority, $logstring) = @_;
	local $\ = undef;
	print main::STDERR "$logstring\n";
}

#
# ->channel_eq		-- defined
#
# All channels equals here
#
sub channel_eq {
	my $self = shift;
	return 1;
}

#
# ->logconfess		-- redefined
#
# Fatal error, with stack trace
#
sub logconfess {
	my $self = shift;
	my ($str) = @_;
	require Carp;
	my $msg = $self->carpmess(0, $str, \&Carp::longmess);
	die $self->prefix_msg("$msg\n");
}

#
# ->logxcroak		-- redefined
#
# Fatal error, from perspective of caller
#
sub logxcroak {
	my $self = shift;
	my ($offset, $str) = @_;
	require Carp;
	my $msg = $self->carpmess($offset, $str, \&Carp::shortmess);
	die $self->prefix_msg("$msg\n");
}

#
# ->logdie			-- redefined
#
# Fatal error
#
sub logdie {
	my $self = shift;
	my ($str) = @_;
	die $self->prefix_msg("$str\n");
}

#
# ->logerr			-- redefined
#
# Signal error on stderr
#
sub logerr {
	my $self = shift;
	my ($str) = @_;
	warn $self->prefix_msg("$str\n");
}

#
# ->logwarn			-- redefined
#
# Warn, with "WARNING" clearly emphasized
#
sub logwarn {
	my $self = shift;
	my ($str) = @_;
	$str->prepend("WARNING: ");
	warn $self->prefix_msg("$str\n");
}

#
# ->logxcarp		-- redefined
#
# Warn from perspective of caller, with "WARNING" clearly emphasized.
#
sub logxcarp {
	my $self = shift;
	my ($offset, $str) = @_;
	$str->prepend("WARNING: ");
	require Carp;
	my $msg = $self->carpmess($offset, $str, \&Carp::shortmess);
	warn $self->prefix_msg("$msg\n");
}

1;	# for require
__END__