Commit v0.03 - liblog-report-perl

+16

-1

ChangeLog less more

0	0
1	1	==== version history of Log::Report
	2
	3	version 0.03: Mon May 28 20:16:26 CEST 2007
	4	- Log::Report::Message without msgid forgot _append.
	5	- Log::Report::Message must clone at concatenation.
	6	- remove translations from POT when not referenced anymore, and
	7	not translated either.
	8	- $@ after try will not show the message, because we want people
	9	to use reportAll() or reportFatal().
	10	- dispatchers now have a format_reason, defaulting to LOWERCASE
	11	which looks nicer than uppercase.
	12	- added docs to ::Try
	13	- reorganized some docs.
	14	- Log::Report::Util lacked the trailing "1;"
	15	- fall-back to no translation in case of unknown locale in ::POT
	16	- test functionality of setlocale, and hopefully fixed things
2	17
3	18	version 0.02: Mon May 28 00:49:52 CEST 2007
4	19	- added HTML documentation to http://perl.overmeer.net/log-report/

20	35	. t/50file.t failed because no -t STDERR
21	36
22	37	version 0.01: Fri May 25 12:13:13 CEST 2007
23		- initial
	38	- initial (quite complete) implementation.

+1

-0

MANIFEST less more

22	22	lib/Log/Report/messages/log-report.utf-8.po
23	23	lib/Log/Report/messages/log-report/nl_NL.po
24	24	t/00use.t
	25	t/01locale.t
25	26	t/05util.t
26	27	t/10interp.t
27	28	t/11concat.t

+1

-1

Makefile.PL less more

3	3
4	4	WriteMakefile
5	5	( NAME => 'Log::Report'
6		, VERSION => '0.02'
	6	, VERSION => '0.03'
7	7	, PREREQ_PM => { Test::More => 0.47 }
8	8	, AUTHOR => 'Mark Overmeer'
9	9	, ABSTRACT => 'report a problem, pluggable handlers and language support'

+7

-1

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

30	30	Log::Report::Dispatcher::Syslog - send messages to syslog
31	31
32	32	=chapter SYNOPSIS
	33	# add syslog dispatcher
33	34	dispatcher SYSLOG => 'syslog', accept => 'NOTICE-'
	35	, format_reason => 'IGNORE'
34	36	, to_prio => [ 'ALERT-' => 'err' ];
35	37
36	38	# disable default dispatcher
37		dispatcher close => 'syslog';
	39	dispatcher close => 'stderr';
38	40
39	41	=chapter DESCRIPTION
40	42	This dispatchers produces output to syslog, based on the M<Sys::Syslog>

64	66	=section Constructors
65	67
66	68	=c_method new TYPE, NAME, OPTIONS
	69	With syslog, people tend not to include the REASON of the message
	70	in the logs, because that is already used to determine the destination
	71	of the message. Use M<new(format_reason)> with C<IGNORE> to achieve
	72	that.
67	73
68	74	=option identity STRING
69	75	=default identity <basename $0>

+58

-18

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

10	10	Log::Report::Dispatcher::Try - capture all reports as exceptions
11	11
12	12	=chapter SYNOPSIS
13		try { ... }
14		print ref $@; # Log::Report::Dispatcher::Try
	13	try { ... }; # mind the ';' !!
	14	if($@) { # signals something went wrong
	15
	16	if(try {...}) { # block ended normally
	17
	18	try { ... } # no comma!!
	19	mode => 'DEBUG', accept => 'ERROR-';
	20
	21	try sub { ... }, # with comma
	22	mode => 'DEBUG', accept => 'ALL';
	23
	24	try \&myhandler, accept => 'ERROR-';
	25
	26	print ref $@; # Log::Report::Dispatcher::Try
	27
	28	$@->reportFatal; # redispatch result of try block
	29	$@->reportAll; # ... also warnings etc
	30	if($@) {...} # if errors
	31	if($@->failed) { # same # }
	32	if($@->success) { # no errors # }
	33
	34	try { report {to => 'stderr'}, FAILURE => 'no network' };
	35	$@->reportFatal(to => 'syslog'); # overrule destination
15	36
16	37	=chapter DESCRIPTION
	38	The M<Log::Report::try()> catches errors in the block (CODE
	39	reference) which is just following the function name. All
	40	dispatchers are temporarily disabled by C<try>, and messages
	41	which are reported are collected within a temporary dispatcher
	42	named C<try>. When the CODE has run, that C<try> dispatcher
	43	is returned in C<$@>, and all original dispatchers reinstated.
	44
	45	Then, after the C<try> has finished, the routine which used
	46	the "try" should decide what to do with the collected reports.
	47	These reports are collected as M<Log::Report::Exception> objects.
	48	They can be ignored, or thrown to a higher level try... causing
	49	an exit of the program if there is none.
17	50
18	51	=chapter OVERLOADING
19	52

30	63
31	64	use overload
32	65	bool => 'failed'
33		, '""' => 'printError';
	66	, '""' => 'showStatus';
34	67
35	68	=chapter METHODS
36	69

112	145	$self;
113	146	}
114	147
115		=method reportAll
	148	=method reportAll OPTIONS
116	149	Re-cast the messages in all collect exceptions into the defined
117		dispatchers, which were disabled during the try block.
118		=cut
119
120		sub reportAll() { $_->throw for shift->exceptions }
	150	dispatchers, which were disabled during the try block. The OPTIONS
	151	will end-up as HASH-of-OPTIONS to M<Log::Report::report()>; see
	152	M<Log::Report::Exception::throw()> which does the job.
	153	=cut
	154
	155	sub reportAll(@) { $_->throw(@_) for shift->exceptions }
121	156
122	157	=method reportFatal
123	158	Re-cast only the fatal message to the defined dispatchers. If the
124		block was left without problems, then nothing will be done.
125		=cut
126
127		sub reportFatal() { $_->throw for shift->wasFatal }
	159	block was left without problems, then nothing will be done. The OPTIONS
	160	will end-up as HASH-of-OPTIONS to M<Log::Report::report()>; see
	161	M<Log::Report::Exception::throw()> which does the job.
	162	=cut
	163
	164	sub reportFatal(@) { $_->throw(@_) for shift->wasFatal }
128	165
129	166	=section Status
130	167

148	185	$self->{died} ? $self->{exceptions}[-1] : ();
149	186	}
150	187
151		=method printError
	188	=method showStatus
152	189	If this object is kept in C<$@>, and someone uses this as string, we
153	190	want to show the fatal error message.
154		=cut
155
156		sub printError()
	191
	192	The message is not very informative for the good cause: we do not want
	193	people to simply print the C<$@>, but wish for a re-cast of the message
	194	using M<reportAll()> or M<reportFatal()>.
	195	=cut
	196
	197	sub showStatus()
157	198	{ my $fatal = shift->wasFatal or return '';
158		# don't use '.', because it is overloaded for message
159		join('', $fatal->reason, ': ', $fatal->message, "\n");
	199	__x"try-block stopped with {reason}", reason => $fatal->reason;
160	200	}
161	201
162	202	1;

+26

-7

lib/Log/Report/Dispatcher.pm less more

86	86	You are adviced to use the symbolic mode names when the mode is
87	87	changed within your program: the numerical values are available
88	88	for smooth M<Getopt::Long> integration.
	89
	90	=option format_reason 'UPPERCASE'\|'LOWERCASE'\|'UCFIRST'\|'IGNORE'\|CODE
	91	=default format_reason 'LOWERCASE'
	92	How to show the reason text which is printed before the message. When
	93	a CODE is specified, it will be called with a translated text and the
	94	returned text is used.
	95
89	96	=cut
90	97
91	98	sub new(@)
92	99	{ my ($class, $type, $name, %args) = @_;
93	100
94	101	my $backend
95		= $predef_dispatchers{$type} ? $predef_dispatchers{$type}
96		: $type->isa('Log::Dispatch::Output')
97		? __PACKAGE__.'::LogDispatch' # wrapper initializer
98		: $type->isa('Log::Log4perl')
99		? __PACKAGE__.'::Log4perl' # wrapper initializer
	102	= $predef_dispatchers{$type} ? $predef_dispatchers{$type}
	103	: $type->isa('Log::Dispatch::Output') ? __PACKAGE__.'::LogDispatch'
	104	: $type->isa('Log::Log4perl') ? __PACKAGE__.'::Log4perl'
100	105	: $type;
101	106
102	107	eval "require $backend";

106	111	->init(\%args);
107	112	}
108	113
	114	my %format_reason =
	115	( LOWERCASE => sub { (lc $_[0]) . ': ' }
	116	, UPPERCASE => sub { (uc $_[0]) . ': ' }
	117	, UCFIRST => sub { (ucfirst lc $_[0]) . ': '}
	118	, IGNORE => sub { '' }
	119	);
	120
109	121	sub init($)
110	122	{ my ($self, $args) = @_;
111	123	my $mode = $self->_set_mode(delete $args->{mode} \|\| 'NORMAL');

114	126
115	127	my $accept = delete $args->{accept} \|\| $default_accept[$mode];
116	128	$self->{needs} = [ expand_reasons $accept ];
	129
	130	my $f = delete $args->{format_reason} \|\| 'LOWERCASE';
	131	$self->{format_reason} = ref $f eq 'CODE' ? $f : $format_reason{$f}
	132	or error __x"illegal format_reason '{format}' for dispatcher",
	133	format => $f;
	134
117	135	$self;
118	136	}
119	137

224	242
225	243	my $text;
226	244	if($translate)
227		{ $text = (__$reason)->toString. ': '. $message->toString;
	245	{ $text = $self->{format_reason}->((__$reason)->toString)
	246	. $message->toString;
228	247	$text .= ': ' . strerror($opts->{errno}) if $opts->{errno};
229	248	$text .= "\n";
230	249	}
231	250	else
232		{ $text = $reason . ': ' . $message->untranslated;
	251	{ $text = $self->{format_reason}->($reason) . $message->untranslated;
233	252	$text .= ': '. strerror($opts->{errno}) if $opts->{errno};
234	253	$text .= "\n";
235	254	}

+9

-1

lib/Log/Report/Exception.pm less more

59	59	Insert the message contained in the exception into the currently
60	60	defined dispatchers. The C<throw> name is commonly known
61	61	exception related terminology for C<report>.
	62
	63	The OPTIONS overrule the captured options to M<Log::Report::report()>.
	64	This can be used to overrule a destination.
	65
	66	=example overrule defaults to report
	67	try { print {to => 'stderr'}, ERROR => 'oops!' };
	68	$@->reportFatal(to => 'syslog');
62	69	=cut
63	70
64	71	# if we would used "report" here, we get a naming conflict with
65	72	# function Log::Report::report.
66	73	sub throw(@)
67	74	{ my $self = shift;
68		report $self->{report_opts}, $self->reason, $self->message;
	75	my $opts = @_ ? { %{$self->{report_opts}}, @_ } : $self->{report_opts};
	76	report $opts, $self->reason, $self->message;
69	77	}
70	78
71	79	1;

+10

-0

lib/Log/Report/Lexicon/PO.pm less more

374	374
375	375	=method toString OPTIONS
376	376	Format the object into a multi-lined string.
	377
377	378	=option nr_plurals INTEGER
378	379	=default nr_plurals C<undef>
379	380	If the number of plurals is specified, then the plural translation

452	453	join '', @text;
453	454	}
454	455
	456	=method unused
	457	The message-id has no references anymore and no translations.
	458	=cut
	459
	460	sub unused()
	461	{ my $self = shift;
	462	! $self->references && ! $self->msgstr(0);
	463	}
	464
455	465	1;

+7

-3

lib/Log/Report/Lexicon/POT.pm less more

201	201	my $index = $self->index;
202	202	foreach my $msgid (sort keys %$index)
203	203	{ next if $msgid eq '';
204		$fh->print("\n", $index->{$msgid}->toString(@opt));
	204
	205	my $po = $index->{$msgid};
	206	next if $po->unused;
	207
	208	$fh->print("\n", $po->toString(@opt));
205	209	}
206	210
207	211	$fh->close

404	408	foreach my $po ($self->translations)
405	409	{ next if $po->msgid eq '';
406	410	$stats{msgids}++;
407		$po->fuzzy and $stats{fuzzy}++;
408		$po->isActive or $stats{inactive}++;
	411	$stats{fuzzy}++ if $po->fuzzy;
	412	$stats{inactive}++ if !$po->isActive && !$po->unused;
409	413	}
410	414	\%stats;
411	415	}

+7

-8

lib/Log/Report/Message.pm less more

135	135	my $count = $self->{_count} \|\| 0;
136	136
137	137	$self->{_msgid} # no translation, constant string
138		or return $self->{_prepend};
	138	or return (defined $self->{_prepend} ? $self->{_prepend} : '')
	139	. (defined $self->{_append} ? $self->{_append} : '');
139	140
140	141	# create a translation
141	142	my $text = Log::Report->translator($self->{_domain})->translate($self);

208	209	sub concat($;$)
209	210	{ my ($self, $what, $reversed) = @_;
210	211	if($reversed)
211		{ $self->{_prepend}
212		= defined $self->{_prepend} ? $what . $self->{_prepend} : $what;
	212	{ $what .= $self->{_prepend} if defined $self->{_prepend};
	213	return ref($self)->new(%$self, _prepend => $what);
213	214	}
214		else
215		{ $self->{_append}
216		= defined $self->{_append} ? $self->{_append} . $what : $what;
217		}
218		$self;
	215
	216	$what = $self->{_append} . $what if defined $self->{_append};
	217	ref($self)->new(%$self, _append => $what);
219	218	}
220	219
221	220	=chapter DETAILS

+0

-1

lib/Log/Report/Translator/Gettext.pm less more

4	4	use base 'Log::Report::Translator';
5	5
6	6	use Locale::gettext;
7		use POSIX qw/setlocale/;
8	7
9	8	use Log::Report 'log-report';
10	9

+5

-2

lib/Log/Report/Translator/POT.pm less more

5	5
6	6	use Log::Report 'log-report', syntax => 'SHORT';
7	7	use Log::Report::Lexicon::Index;
	8	use Log::Report::Lexicon::POTcompact;
8	9
9		use POSIX qw/locale_h/;
	10	use POSIX qw/:locale_h/;
10	11
11	12	my %indices;
12	13

41	42	{ my ($self, $msg) = @_;
42	43
43	44	my $domain = $msg->{_domain};
44		my $locale = setlocale(LC_MESSAGES, '');
	45	my $locale = setlocale(LC_MESSAGES)
	46	or return $self->SUPER::translate($msg);
	47
45	48	my $pot = exists $self->{pots}{$locale} ? $self->{pots}{$locale}
46	49	: $self->load($domain, $locale);
47	50

+12

-6

lib/Log/Report/Util.pm less more

28	28	my @take = expand_reasons 'INFO-ERROR,PANIC';
29	29
30	30	=chapter DESCRIPTION
	31	This module collects a few functions and definitions which are
	32	shared between different components in the M<Log::Report>
	33	infrastructure.
31	34
32	35	=chapter FUNCTIONS
33	36

76	79	{ my $begin = $reason_code{$1 \|\| 'TRACE'};
77	80	my $end = $reason_code{$2 \|\| 'PANIC'};
78	81	$begin && $end
79		or error __x"unknown reason {which} in '{reasons}'"
80		, which => ($begin ? $2 : $1), reasons => $reasons;
	82	or error __x "unknown reason {which} in '{reasons}'"
	83	, which => ($begin ? $2 : $1), reasons => $reasons;
81	84
82	85	error __x"reason '{begin}' more serious than '{end}' in '{reasons}"
83		, begin => $1, end => $2, reasons => $reasons
84		if $begin >= $end;
	86	, begin => $1, end => $2, reasons => $reasons
	87	if $begin >= $end;
85	88
86	89	$r{$_}++ for $begin..$end;
87	90	}

99	102	}
100	103
101	104	=function escape_chars STRING
102		Replace all escape characters into their readible counterpart.
	105	Replace all escape characters into their readible counterpart. For
	106	instance, a new-line is replaced by backslash-n.
103	107
104	108	=function unescape_chars STRING
105		Replace all C<\.> by their escape character.
	109	Replace all backslash-something escapes by their escape character.
	110	For instance, backslash-t is replaced by a tab character.
106	111	=cut
107	112
108	113	my %unescape

124	129	$str;
125	130	}
126	131
	132	1;

+14

-10

lib/Log/Report/messages/log-report/nl_NL.po less more

3	3	"Project-Id-Version: log-report 0.01\n"
4	4	"Report-Msgid-Bugs-To:\n"
5	5	"POT-Creation-Date: 2007-05-14 17:14+0200\n"
6		"PO-Revision-Date: 2007-05-28 00:48+0200\n"
	6	"PO-Revision-Date: 2007-05-28 11:38+0200\n"
7	7	"Last-Translator: Mark Overmeer <mark@overmeer.net>\n"
8	8	"Language-Team:\n"
9	9	"MIME-Version: 1.0\n"

85	85	msgid "WARNING"
86	86	msgstr "WAARSCHUWING"
87	87
88		#: lib/Log/Report/Dispatcher.pm:244 lib/Log/Report/Dispatcher.pm:255
	88	#: lib/Log/Report/Dispatcher.pm:242 lib/Log/Report/Dispatcher.pm:253
89	89	msgid "at {filename} line {line}"
90	90	msgstr "in {filename} regel {line}"
91	91

155	155	msgid "no filename or file-handle specified for PO"
156	156	msgstr "geen bestandsnaam of -handle meegegeven voor PO"
157	157
158		#: lib/Log/Report/Lexicon/POT.pm:323
	158	#: lib/Log/Report/Lexicon/POT.pm:327
159	159	msgid "no header defined in POT for file {fn}"
160	160	msgstr "geen kop opgegeven in POT in bestand {fn}"
161	161

163	163	msgid "no msgid in block {where}"
164	164	msgstr "geen msgid in blok {where}"
165	165
166		#: lib/Log/Report/Lexicon/PO.pm:445
	166	#: lib/Log/Report/Lexicon/PO.pm:446
167	167	msgid "no plurals for '{msgid}'"
168	168	msgstr "geen meervoudsvormen voor '{msgid}'"
169	169

195	195	msgid "string '{text}' not between quotes at {location}"
196	196	msgstr "tekst '{text}' niet tussen quotes in {location}"
197	197
198		#: lib/Log/Report/Dispatcher.pm:166
	198	#: lib/Log/Report/Dispatcher.pm:164
199	199	msgid "switching to run mode {mode}"
200	200	msgstr "overschakeling naar verwerkingsmode {mode}"
201	201

227	227	msgid "the 'needs' sub-command parameter '{reason}' is not a reason"
228	228	msgstr "het 'needs' sub-commando argument '{reason}' is geen reden"
229	229
230		#: lib/Log/Report/Lexicon/POT.pm:283
	230	#: lib/Log/Report/Lexicon/POT.pm:287
231	231	msgid "the only acceptable parameter is 'ACTIVE', not '{p}'"
232	232	msgstr "het enige geaccepteerde argument is 'ACTIVE', niet '{p}'"
233	233
234		#: lib/Log/Report/Lexicon/PO.pm:434
	234	#: lib/Log/Report/Lexicon/PO.pm:435
235	235	msgid "too many plurals for '{msgid}'"
236	236	msgstr "te veel meervouden voor '{msgid}'"
237	237
238		#: lib/Log/Report/Lexicon/POT.pm:266
	238	#: lib/Log/Report/Lexicon/POT.pm:270
239	239	msgid "translation already exists for '{msgid}'"
240	240	msgstr "er bestaat al een vertaling voor '{msgid}'"
241	241

243	243	msgid "translator must be a Log::Report::Translator object"
244	244	msgstr "vertaler moet een Log::Report::Translator object zijn"
245	245
	246	#: lib/Log/Report/Dispatcher/Try.pm:193
	247	msgid "try-block stopped with {reason}"
	248	msgstr "try-blok gestopt met {reason}"
	249
246	250	#: lib/Log/Report/Lexicon/PO.pm:326
247	251	msgid "unknown comment type '{cmd}' at {where}"
248	252	msgstr "onbekend commentaar type '{cmd}' in {where}"

255	259	msgid "unknown reason {which} in '{reasons}'"
256	260	msgstr "onbekende reden {which} is '{reasons}'"
257	261
258		#: lib/Log/Report/Dispatcher.pm:164
	262	#: lib/Log/Report/Dispatcher.pm:162
259	263	msgid "unknown run mode '{mode}'"
260	264	msgstr "onbekende verwerkingsmode '{mode}'"
261	265

263	267	msgid "unnamed file"
264	268	msgstr ""
265	269
266		#: lib/Log/Report/Lexicon/POT.pm:209
	270	#: lib/Log/Report/Lexicon/POT.pm:213
267	271	msgid "write errors for file {fn}"
268	272	msgstr "schrijfproblemen bij bestand {fn}"
269	273

+15

-38

lib/Log/Report/messages/log-report.utf-8.po less more

3	3	"Project-Id-Version: log-report 0.01\n"
4	4	"Report-Msgid-Bugs-To:\n"
5	5	"POT-Creation-Date: 2007-05-14 17:14+0200\n"
6		"PO-Revision-Date: 2007-05-28 00:48+0200\n"
	6	"PO-Revision-Date: 2007-05-28 11:38+0200\n"
7	7	"Last-Translator:\n"
8	8	"Language-Team:\n"
9	9	"MIME-Version: 1.0\n"

53	53	msgid "Log::Log4perl back-end {name} requires a 'config' parameter"
54	54	msgstr ""
55	55
56		#, fuzzy
57		#~ msgid "Log::Log4perl back-end {name} requires a config argument"
58		#~ msgstr ""
59
60	56	#: lib/Log/Report/Dispatcher/Log4perl.pm:111
61	57	#, fuzzy
62	58	msgid "Log::Log4perl level '{level}' must be in 0-5"

109	105	msgid "WARNING"
110	106	msgstr ""
111	107
112		#: lib/Log/Report/Dispatcher.pm:244 lib/Log/Report/Dispatcher.pm:255
	108	#: lib/Log/Report/Dispatcher.pm:242 lib/Log/Report/Dispatcher.pm:253
113	109	#, fuzzy
114	110	msgid "at {filename} line {line}"
115	111	msgstr ""

196	192	msgid "no filename or file-handle specified for PO"
197	193	msgstr ""
198	194
199		#: lib/Log/Report/Lexicon/POT.pm:323
	195	#: lib/Log/Report/Lexicon/POT.pm:327
200	196	#, fuzzy
201	197	msgid "no header defined in POT for file {fn}"
202	198	msgstr ""

206	202	msgid "no msgid in block {where}"
207	203	msgstr ""
208	204
209		#: lib/Log/Report/Lexicon/PO.pm:445
	205	#: lib/Log/Report/Lexicon/PO.pm:446
210	206	#, fuzzy
211	207	msgid "no plurals for '{msgid}'"
212	208	msgstr ""
213	209
214		#, fuzzy
215		#~ msgid "no reason found in report parameters"
216		#~ msgstr ""
217
218	210	#: lib/Log/Report/Extract/PerlPPI.pm:155
219	211	#, fuzzy
220	212	msgid "no textdomain for translatable at {fn} line {line}"
221	213	msgstr ""
222	214
223		#, fuzzy
224		#~ msgid "not a CODE reference: {param}"
225		#~ msgstr ""
226
227	215	#: lib/Log/Report/Extract/PerlPPI.pm:109
228	216	#, fuzzy
229	217	msgid "processing file {fn} in {charset}"

254	242	msgid "string '{text}' not between quotes at {location}"
255	243	msgstr ""
256	244
257		#, fuzzy
258		#~ msgid "sub-command 'mode' expects name and setting"
259		#~ msgstr ""
260
261		#: lib/Log/Report/Dispatcher.pm:166
	245	#: lib/Log/Report/Dispatcher.pm:164
262	246	#, fuzzy
263	247	msgid "switching to run mode {mode}"
264	248	msgstr ""
265	249
266		#, fuzzy
267		#~ msgid "syslog level '$level' not understood"
268		#~ msgstr ""
269
270	250	#: lib/Log/Report/Dispatcher/Syslog.pm:105
271	251	#, fuzzy
272	252	msgid "syslog level '{level}' not understood"

297	277	msgid "the 'list' sub-command doesn't expect additional parameters"
298	278	msgstr ""
299	279
300		#, fuzzy
301		#~ msgid "the 'needs' sub-command parameter '{reason} is not a reason"
302		#~ msgstr ""
303
304	280	#: lib/Log/Report.pm:334
305	281	#, fuzzy
306	282	msgid "the 'needs' sub-command parameter '{reason}' is not a reason"
307	283	msgstr ""
308	284
309		#: lib/Log/Report/Lexicon/POT.pm:283
	285	#: lib/Log/Report/Lexicon/POT.pm:287
310	286	#, fuzzy
311	287	msgid "the only acceptable parameter is 'ACTIVE', not '{p}'"
312	288	msgstr ""
313	289
314		#: lib/Log/Report/Lexicon/PO.pm:434
	290	#: lib/Log/Report/Lexicon/PO.pm:435
315	291	#, fuzzy
316	292	msgid "too many plurals for '{msgid}'"
317	293	msgstr ""
318	294
319		#: lib/Log/Report/Lexicon/POT.pm:266
	295	#: lib/Log/Report/Lexicon/POT.pm:270
320	296	#, fuzzy
321	297	msgid "translation already exists for '{msgid}'"
322	298	msgstr ""

326	302	msgid "translator must be a Log::Report::Translator object"
327	303	msgstr ""
328	304
	305	#: lib/Log/Report/Dispatcher/Try.pm:193
	306	#, fuzzy
	307	msgid "try-block stopped with {reason}"
	308	msgstr ""
	309
329	310	#: lib/Log/Report/Lexicon/PO.pm:326
330	311	#, fuzzy
331	312	msgid "unknown comment type '{cmd}' at {where}"
332	313	msgstr ""
333	314
334		#, fuzzy
335		#~ msgid "unknown dispatcher {type}"
336		#~ msgstr ""
337
338	315	#: lib/Log/Report/Lexicon/PO.pm:294
339	316	#, fuzzy
340	317	msgid "unknown flag {flag} ignored"

345	322	msgid "unknown reason {which} in '{reasons}'"
346	323	msgstr ""
347	324
348		#: lib/Log/Report/Dispatcher.pm:164
	325	#: lib/Log/Report/Dispatcher.pm:162
349	326	#, fuzzy
350	327	msgid "unknown run mode '{mode}'"
351	328	msgstr ""

355	332	msgid "unnamed file"
356	333	msgstr ""
357	334
358		#: lib/Log/Report/Lexicon/POT.pm:209
	335	#: lib/Log/Report/Lexicon/POT.pm:213
359	336	#, fuzzy
360	337	msgid "write errors for file {fn}"
361	338	msgstr ""

+106

-94

lib/Log/Report.pm less more

6	6
7	7	# domain 'log-report' via work-arounds:
8	8	# Log::Report cannot do "use Log::Report"
9
10		use POSIX qw/setlocale LC_ALL/;
11	9
12	10	my @make_msg = qw/__ __x __n __nx __xn N__ N__n N__w/;
13	11	my @functions = qw/report dispatcher try/;

88	86
89	87	print __xn("found one file", "found {_count} files", @files), "\n";
90	88
91		try { error };
92		if($@) {...}
	89	try { error }; # catch errors with hidden eval/die
	90	if($@) {...} # $@ isa Log::Report::Dispatcher::Try
	91
	92	use POSIX ':locale_h';
	93	setlocale(LC_ALL, 'nl_NL');
	94	info __"Hello World!"; # in Dutch, if translation table found
93	95
94	96	=chapter DESCRIPTION
95	97	Handling messages to users can be a hassle, certainly when the same

120	122	Multiple dispatchers in parallel can be active. M<Log::Report::Dispatcher>
121	123	takes care that the back-end gets the messages of the severity it needs,
122	124	translated and in the right character-set.
	125
	126	=item . Exception handling
	127	A simple exception system is implemented via M<try()> and
	128	M<Log::Report::Dispatcher::Try>.
123	129
124	130	=back
125	131

961	967	croak 7,emergency,emerg fatal failure
962	968	confess 7,emergency,emerg fatal panic
963	969
964		A typical perl5 program can look like this
965
966		my $dir = '/etc';
967
968		File::Spec->file_name is_absolute($dir)
969		or die "ERROR: directory name must be absolute.\n";
970
971		-d $dir
972		or die "ERROR: what platform are you on?";
973
974		until(opendir DIR, $dir)
975		{ warn "ERROR: cannot read system directory $dir: $!";
976		sleep 60;
977		}
978
979		print "Processing directory $dir\n"
980		if $verbose;
981
982		while(defined(my $file = readdir DIR))
983		{ if($file =~ m/\.bak$/)
984		{ warn "WARNING: found backup file $dir/$f\n";
985		next;
986		}
987
988		die "ERROR: file $dir/$file is binary"
989		if $debug && -B "$dir/$file";
990
991		print "DEBUG: processing file $dir/$file\n"
992		if $debug;
993
994		open FILE, "<", "$dir/$file"
995		or die "ERROR: cannot read from $dir/$f: $!";
996
997		close FILE
998		or croak "ERROR: read errors in $dir/$file: $!";
999		}
1000
1001		Where C<die>, C<warn>, and C<print> are used for various tasks. With
1002		C<Log::Report>, you would write
1003
1004		use Log::Report syntax => 'SHORT';
1005		dispatcher stderr => 'FILE', mode => 'DEBUG', to => \*STDERR;
1006
1007		my $dir = '/etc';
1008
1009		File::Spec->file_name is_absolute($dir)
1010		or mistake "directory name must be absolute";
1011
1012		-d $dir
1013		or panic "what platform are you on?";
1014
1015		until(opendir DIR, $dir)
1016		{ alert "cannot read system directory $dir";
1017		sleep 60;
1018		}
1019
1020		info "Processing directory $dir";
1021
1022		while(defined(my $file = readdir DIR))
1023		{ if($file =~ m/\.bak$/)
1024		{ notice "found backup file $dir/$f";
1025		next;
1026		}
1027
1028		assert "file $dir/$file is binary"
1029		if -B "$dir/$file";
1030
1031		trace "processing file $dir/$file";
1032
1033		unless(open FILE, "<", "$dir/$file")
1034		{ error "no permission to read from $dir/$f"
1035		if $!==ENOPERM;
1036		fault "unable to read from $dir/$f";
1037		}
1038
1039		close FILE
1040		or failure "read errors in $dir/$file";
1041		}
1042
1043		A lot of things are quite visibly different, and there are a few smaller
1044		changes. There is no need for a new-line after the text of the message.
1045		When applicable (error about system problem), then the C<$!> is added
1046		automatically.
1047
1048		The distinction between C<error> and C<fault> is a bit artificial her, just
1049		to demonstrate the difference between the two. In this case, I want to
1050		express very explicitly that the user made an error by passing the name
1051		of a directory in which a file is not readible. In the common case,
1052		the user is not to blame and we can use C<fault>.
1053
1054	970	=subsection Run modes
1055	971	The run-mode change which messages are passed to a dispatcher, but
1056	972	from a different angle than the dispatch filters; the mode changes

1136	1052
1137	1053	=section Comparison
1138	1054
	1055	=subsection die/warn/Carp
	1056
	1057	A typical perl5 program can look like this
	1058
	1059	my $dir = '/etc';
	1060
	1061	File::Spec->file_name is_absolute($dir)
	1062	or die "ERROR: directory name must be absolute.\n";
	1063
	1064	-d $dir
	1065	or die "ERROR: what platform are you on?";
	1066
	1067	until(opendir DIR, $dir)
	1068	{ warn "ERROR: cannot read system directory $dir: $!";
	1069	sleep 60;
	1070	}
	1071
	1072	print "Processing directory $dir\n"
	1073	if $verbose;
	1074
	1075	while(defined(my $file = readdir DIR))
	1076	{ if($file =~ m/\.bak$/)
	1077	{ warn "WARNING: found backup file $dir/$f\n";
	1078	next;
	1079	}
	1080
	1081	die "ERROR: file $dir/$file is binary"
	1082	if $debug && -B "$dir/$file";
	1083
	1084	print "DEBUG: processing file $dir/$file\n"
	1085	if $debug;
	1086
	1087	open FILE, "<", "$dir/$file"
	1088	or die "ERROR: cannot read from $dir/$f: $!";
	1089
	1090	close FILE
	1091	or croak "ERROR: read errors in $dir/$file: $!";
	1092	}
	1093
	1094	Where C<die>, C<warn>, and C<print> are used for various tasks. With
	1095	C<Log::Report>, you would write
	1096
	1097	use Log::Report syntax => 'SHORT';
	1098	dispatcher stderr => 'FILE', mode => 'DEBUG', to => \*STDERR;
	1099
	1100	my $dir = '/etc';
	1101
	1102	File::Spec->file_name is_absolute($dir)
	1103	or mistake "directory name must be absolute";
	1104
	1105	-d $dir
	1106	or panic "what platform are you on?";
	1107
	1108	until(opendir DIR, $dir)
	1109	{ alert "cannot read system directory $dir";
	1110	sleep 60;
	1111	}
	1112
	1113	info "Processing directory $dir";
	1114
	1115	while(defined(my $file = readdir DIR))
	1116	{ if($file =~ m/\.bak$/)
	1117	{ notice "found backup file $dir/$f";
	1118	next;
	1119	}
	1120
	1121	assert "file $dir/$file is binary"
	1122	if -B "$dir/$file";
	1123
	1124	trace "processing file $dir/$file";
	1125
	1126	unless(open FILE, "<", "$dir/$file")
	1127	{ error "no permission to read from $dir/$f"
	1128	if $!==ENOPERM;
	1129	fault "unable to read from $dir/$f";
	1130	}
	1131
	1132	close FILE
	1133	or failure "read errors in $dir/$file";
	1134	}
	1135
	1136	A lot of things are quite visibly different, and there are a few smaller
	1137	changes. There is no need for a new-line after the text of the message.
	1138	When applicable (error about system problem), then the C<$!> is added
	1139	automatically.
	1140
	1141	The distinction between C<error> and C<fault> is a bit artificial her, just
	1142	to demonstrate the difference between the two. In this case, I want to
	1143	express very explicitly that the user made an error by passing the name
	1144	of a directory in which a file is not readible. In the common case,
	1145	the user is not to blame and we can use C<fault>.
	1146
	1147	A module like M<Log::Message> is an object oriented version of the
	1148	standard Perl functions, and as such not really contributing tp
	1149	abstaction.
	1150
1139	1151	=subsection Log::Dispatch and Log::Log4perl
1140	1152	The two major logging frameworks for Perl are M<Log::Dispatch> and
1141	1153	M<Log::Log4perl>; both provide a pluggable logging interface.

+29

-0

t/01locale.t less more

	0	#!/usr/bin/perl
	1	# test locale
	2
	3	use Test::More tests => 9;
	4
	5	BEGIN {
	6	use_ok('POSIX', ':locale_h', 'setlocale');
	7	}
	8
	9	my $default = setlocale(LC_MESSAGES, 'en_US');
	10	ok(defined $default, 'has default locale');
	11
	12	$! = 2;
	13	my $err_en = "$!";
	14	ok(defined $err_en, $err_en); # platform dependent
	15	my $try = setlocale LC_MESSAGES, 'nl_NL';
	16	ok(defined $try, 'defined return');
	17	is($try, 'nl_NL');
	18
	19	is(setlocale(LC_MESSAGES), 'nl_NL');
	20	$! = 2;
	21	my $err_nl = "$!";
	22	ok(defined $err_nl, $err_nl);
	23	isnt($err_en, $err_nl);
	24
	25	setlocale(LC_MESSAGES, 'en_US');
	26	$! = 2;
	27	my $err_en2 = "$!";
	28	is($err_en, $err_en2, $err_en2);

+1

-1

t/11concat.t less more

15	15	isa_ok($a, 'Log::Report::Message');
16	16	my $b = $a . " World!\n";
17	17	isa_ok($b, 'Log::Report::Message');
18		cmp_ok(refaddr $a, '==', refaddr $b);
	18	cmp_ok(refaddr $a, '!=', refaddr $b); # must clone
19	19	is("$b", "Hello World!\n");
20	20
21	21	my $c = 'a' . 'b' . __("c") . __("d") . "e" . __("f");

+4

-4

t/50file.t less more

19	19
20	20	my $file1 = '';
21	21	open my($fh1), ">", \$file1 or die $!;
22		my $d = dispatcher FILE => 'file1'
23		, to => $fh1;
	22	my $d = dispatcher FILE => 'file1', to => $fh1;
24	23
25	24	@disp = dispatcher 'list';
26	25	cmp_ok(scalar(@disp), '==', 1 + $disp_stderr);

42	41	my $file2 = '';
43	42	open my($fh2), ">", \$file2 or die $!;
44	43	my $e = dispatcher FILE => 'file2'
	44	, format_reason => 'UPPERCASE'
45	45	, to => $fh2, accept => '-INFO';
46	46	ok(defined $e, 'created second disp');
47	47	isa_ok($e, 'Log::Report::Dispatcher::File');

90	90	notice "note this!";
91	91	my $s = length $file1;
92	92	cmp_ok($s, '>', 0, 'disp1 take notice');
93		is($file1, "NOTICE: note this!\n");
	93	is($file1, "notice: note this!\n"); # format_reason LOWERCASE
94	94	my $t4 = length $file2;
95	95	cmp_ok($t4, '==', $t3, 'disp2 ignores notice');
96	96
97	97	warning "oops, be warned!";
98	98	my $s2 = length $file1;
99	99	cmp_ok($s2, '>', $s, 'disp1 take warning');
100		like(substr($file1, $s), qr/^WARNING: oops, be warned!/);
	100	like(substr($file1, $s), qr/^warning: oops, be warned!/);
101	101	my $t5 = length $file2;
102	102	cmp_ok($t5, '==', $t4, 'disp2 ignores warnings');
103	103

+5

-3

t/54try.t less more

8	8	use Test::More tests => 23;
9	9
10	10	use Log::Report undef, syntax => 'SHORT';
	11
	12	use POSIX ':locale_h'; # avoid user's environment
11	13
12	14	# start a new logger
13	15	my $text = '';

64	66	my $text_l3 = length $text;
65	67	cmp_ok($text_l3, '>', $text_l2, 'passed on loggings');
66	68	is(substr($text, $text_l2), <<__EXTRA);
67		INFO: nothing wrong
68		TRACE: trace more
	69	info: nothing wrong
	70	trace: trace more
69	71	__EXTRA
70	72
71	73	eval {

74	76	};
75	77	$@->reportAll;
76	78	};
77		is($@, "FAILURE: oops! no network\n");
	79	is($@, "try-block stopped with FAILURE");