Commit v0.91 - liblog-report-perl

+20

-0

ChangeLog less more

0	0
1	1	==== version history of Log::Report
	2
	3	version 0.91: Wed Jan 26 16:24:25 CET 2011
	4
	5	Fixes:
	6
	7	- enabling and disabling dispatchers did not work
	8	[Patrick Powell]
	9
	10	Improvements:
	11
	12	- produce nice error when __x received even length list.
	13
	14	- added Log::Report::Dispatcher::Callback
	15
	16	- typos in new Callback.pm [Patrick Powell]
	17
	18	- disable test which fails on bug in confess on Windows
	19	http://rt.perl.org/rt3/Ticket/Display.html?id=81586
	20
	21	- improved output with new OODoc
2	22
3	23	version 0.90: Wed Dec 22 16:29:51 CET 2010
4	24

+1

-0

MANIFEST less more

5	5	lib/Log/Report.pm
6	6	lib/Log/Report/Die.pm
7	7	lib/Log/Report/Dispatcher.pm
	8	lib/Log/Report/Dispatcher/Callback.pm
8	9	lib/Log/Report/Dispatcher/File.pm
9	10	lib/Log/Report/Dispatcher/Log4perl.pm
10	11	lib/Log/Report/Dispatcher/LogDispatch.pm

+1

-1

Makefile.PL less more

1	1
2	2	use 5.008;
3	3
4		my $version = '0.90';
	4	my $version = '0.91';
5	5
6	6	my %prereq =
7	7	( Test::More => 0.86

+83

-0

lib/Log/Report/Dispatcher/Callback.pm less more

	0	use warnings;
	1	use strict;
	2
	3	package Log::Report::Dispatcher::Callback;
	4	use base 'Log::Report::Dispatcher';
	5
	6	use Log::Report 'log-report';
	7
	8	=chapter NAME
	9	Log::Report::Dispatcher::Callback - call a code-ref for each log-line
	10
	11	=chapter SYNOPSIS
	12	sub cb($$$)
	13	{ my ($options, $reason, $message) = @_;
	14	...
	15	}
	16
	17	dispatcher Log::Report::Dispatcher::Callback => 'cb'
	18	, callback => \&cb;
	19
	20	dispatcher CALLBACK => 'cb' # same
	21	, callback => \&cb;
	22
	23	=chapter DESCRIPTION
	24	This basic file logger accepts a callback, which is called for each
	25	message which is to be logged. When you need complex things, you
	26	may best make your own extension to M<Log::Report::Dispatcher>, but
	27	for simple things this will do.
	28
	29	=example
	30	sub send_mail($$$)
	31	{ my ($disp, $options, $reason, $message) = @_;
	32	my $msg = Mail::Send->new(Subject => $reason
	33	, To => 'admin@localhost');
	34	my $fh = $msg->open('sendmail');
	35	print $fh $disp->translate($reason, $message);
	36	close $fh;
	37	}
	38
	39	dispatcher CALLBACK => 'mail', callback => \&send_mail;
	40
	41	=chapter METHODS
	42
	43	=section Constructors
	44
	45	=c_method new TYPE, NAME, OPTIONS
	46
	47	=requires callback CODE
	48	Your C<callback> is called with four parameters: this dispatcher object,
	49	the options, a reason and a message. The C<options> are the first
	50	parameter of M<Log::Report::report()> (read over there). The C<reason>
	51	is a capitized string like C<ERROR>. Finally, the C<message> is a
	52	M<Log::Report::Message>.
	53
	54	=cut
	55
	56	sub init($)
	57	{ my ($self, $args) = @_;
	58	$self->SUPER::init($args);
	59
	60	$self->{callback} = $args->{callback}
	61	or error __x"dispatcher {name} needs a 'callback'", name => $self->name;
	62
	63	$self;
	64	}
	65
	66	=section Accessors
	67
	68	=method callback
	69	Returns the code reference which will handle each logged message.
	70	=cut
	71
	72	sub callback() {shift->{callback}}
	73
	74	=section Logging
	75	=cut
	76
	77	sub log($$$)
	78	{ my $self = shift;
	79	$self->{callback}->($self, @_);
	80	}
	81
	82	1;

+2

-2

lib/Log/Report/Dispatcher.pm less more

21	21	my @default_accept = ('NOTICE-', 'INFO-', 'ASSERT-', 'ALL');
22	22
23	23	my %predef_dispatchers = map { (uc($_) => __PACKAGE__.'::'.$_) }
24		qw/File Perl Syslog Try/;
	24	qw/File Perl Syslog Try Callback/;
25	25
26	26	=chapter NAME
27	27	Log::Report::Dispatcher - manage dispatching

219	219
220	220	# only to be called from Log::Report::dispatcher()!!
221	221	# because requires re-investigating needs
222		sub _disable($)
	222	sub _disabled($)
223	223	{ my $self = shift;
224	224	@_ ? ($self->{disabled} = shift) : $self->{disabled};
225	225	}

+1

-4

lib/Log/Report/Message.pm less more

100	100	Alternative for C<_class>, which cannot be used at the same time.
101	101	=cut
102	102
103		sub new($@)
104		{ my ($class, %args) = @_;
105		bless \%args, $class;
106		}
	103	sub new($@) { my $class = shift; bless {@_}, $class }
107	104
108	105	=method clone OPTIONS, VARIABLES
109	106	Returns a new object which copies info from original, and updates it

+5

-2

lib/Log/Report.pm less more

434	434
435	435	# _whats_needed
436	436	# Investigate from all dispatchers which reasons will need to be
437		# passed on. After dispatchers are added, enabled, or disabled,
	437	# passed on. After dispatchers are added, enabled, or disabled,
438	438	# this method shall be called to re-investigate the back-ends.
439	439
440	440	sub _whats_needed()

632	632
633	633	# label "msgid" added before first argument
634	634	sub __x($@)
635		{ Log::Report::Message->new
	635	{ @_%2 or error __x"even length parameter list for __x at {where}",
	636	where => join(' line ', (caller)[1,2]);
	637
	638	Log::Report::Message->new
636	639	( _msgid => @_
637	640	, _expand => 1
638	641	, _domain => _default_domain(caller)

+2

-1

t/00use.t less more

2	2	use strict;
3	3	use lib 'lib', '../lib';
4	4
5		use Test::More tests => 15;
	5	use Test::More tests => 16;
6	6
7	7	# The versions of the following packages are reported to help understanding
8	8	# the environment in which the tests are run. This is certainly not a

34	34	use_ok('Log::Report::Dispatcher::File');
35	35	use_ok('Log::Report::Dispatcher::Try');
36	36	use_ok('Log::Report::Dispatcher::Perl');
	37	use_ok('Log::Report::Dispatcher::Callback');
37	38	use_ok('Log::Report::Exception');
38	39	use_ok('Log::Report::Lexicon::Index');
39	40	use_ok('Log::Report::Lexicon::PO');

+10

-0

t/DieTests.pm less more

144	144	main::simple_wrapper()#t/41die.t#XX
145	145	__OUT
146	146
	147
	148	if($^O eq 'Win32')
	149	{ # perl bug http://rt.perl.org/rt3/Ticket/Display.html?id=81586
	150	pass 'Win32/confess bug #81586';
	151	}
	152	else
	153	{
	154
147	155	eval { $! = $errno; confess "ouch $!\n" };
148	156	my $confess_text4 = $@;
149	157	is(process($confess_text4), <<__OUT, "confess");

157	165
158	166	}
159	167
	168	} # run_tests()
	169
160	170	1;