Commit b18c45b235117bd625f6487bd9e47118b7108c09 - liblog-agent-perl

+2

-0

Agent/Driver/Datum.pm less more

119	119	sub logwarn { intercept(\@_, '>>', 'logwarn', 'error', 'WARNING') }
120	120	sub logxcarp { intercept(\@_, '>>', 'logxcarp', 'error', 'WARNING') }
121	121	sub logsay { intercept(\@_, '>>', 'logsay', 'output') }
	122	sub loginfo { intercept(\@_, '>>', 'loginfo', 'output') }
	123	sub logdebug { intercept(\@_, '>>', 'logdebug', 'output') }
122	124
123	125	#
124	126	# logwrite -- redefined

+28

-0

Agent/Driver/Fork.pm less more

284	284	$self->emit('output', 'notice', $str);
285	285	}
286	286
	287	#
	288	# loginfo
	289	#
	290	# Log message to "output" channel at "info" priority
	291	#
	292	sub loginfo {
	293	my($self, $str) = @_;
	294
	295	#
	296	# send message to drivers
	297	#
	298	$self->emit('output', 'info', $str);
	299	}
	300
	301	#
	302	# logdebug
	303	#
	304	# Log message to "output" channel at "debug" priority
	305	#
	306	sub logdebug {
	307	my($self, $str) = @_;
	308
	309	#
	310	# send message to drivers
	311	#
	312	$self->emit('output', 'debug', $str);
	313	}
	314
287	315	1; # for require
288	316	__END__
289	317

+5

-3

Agent/Driver/Silent.pm less more

43	43	# routines would not do anything. Let's redefine them though...
44	44	#
45	45
46		sub logerr {}
47		sub logwarn {}
	46	sub logerr {}
	47	sub logwarn {}
48	48	sub logcluck {}
49		sub logsay {}
	49	sub logsay {}
	50	sub loginfo {}
	51	sub logdebug {}
50	52	sub logwrite {}
51	53	sub logxcarp {}
52	54

+22

-0

Agent/Driver.pm less more

361	361	}
362	362
363	363	#
	364	# loginfo
	365	#
	366	# Log message at the "info" level.
	367	#
	368	sub loginfo {
	369	my $self = shift;
	370	my ($str) = @_;
	371	$self->emit('output', 'info', $str);
	372	}
	373
	374	#
	375	# logdebug
	376	#
	377	# Log message at the "debug" level.
	378	#
	379	sub logdebug {
	380	my $self = shift;
	381	my ($str) = @_;
	382	$self->emit('output', 'debug', $str);
	383	}
	384
	385	#
364	386	# logwrite
365	387	#
366	388	# Emit the message to the specified channel

+36

-1

Agent.pm less more

26	26	@EXPORT = qw(
27	27	logconfig
28	28	logconfess logcluck logcroak logcarp logxcroak logxcarp
29		logsay logerr logwarn logdie logtrc logdbg
	29	logdebug loginfo logsay logerr logwarn logdie logtrc logdbg
30	30	);
31	31	@EXPORT_OK = qw(
32	32	logwrite logtags

347	347	$Driver->logsay($str);
348	348	}
349	349
	350	# loginfo
	351	#
	352	# Log message at the "info" level.
	353	#
	354	sub loginfo {
	355	return if $Trace < INFO;
	356	my $ptag = prio_tag(priority_level(INFO)) if defined $Priorities;
	357	my $str = tag_format_args($Caller, $ptag, $Tags, \@_);
	358	&log_default unless defined $Driver;
	359	$Driver->loginfo($str);
	360	}
	361
	362	# logdebug
	363	#
	364	# Log message at the "debug" level.
	365	#
	366	sub logdebug {
	367	return if $Trace < DEBUG;
	368	my $ptag = prio_tag(priority_level(INFO)) if defined $Priorities;
	369	my $str = tag_format_args($Caller, $ptag, $Tags, \@_);
	370	&log_default unless defined $Driver;
	371	$Driver->logdebug($str);
	372	}
	373
350	374	#
351	375	# logtrc -- frozen
352	376	#

565	589	routine checks the logging level (either explicit as in C<"info:14">
566	590	or implicit as in C<"notice">) against the trace level.
567	591
	592	=item logdebug I<message>
	593
	594	Log the message at the C<debug> priority to the C<output> channel.
	595
	596	The difference with logdbg() is twofold: logging is done on the
	597	C<output> channel, not the C<debug> one, and the priority is implicit.
	598
	599	=item loginfo I<message>
	600
	601	Log the message at the C<info> priority to the C<output> channel.
	602
568	603	=item logsay I<message>
569	604
570	605	Log the message at the C<notice> priority to the C<output> channel.

+6

-2

t/default.t less more

11	11	#
12	12	##########################################################################
13	13
14		print "1..4\n";
	14	print "1..6\n";
15	15
16	16	require './t/code.pl';
17	17	sub ok;

26	26
27	27	logerr "error";
28	28	logsay "message";
	29	loginfo "info";
	30	logdebug "debugging";
29	31	logtrc 'debug', "debug";
30	32
31	33	close STDOUT;

34	36	ok 1, contains("t/default.err", '^Error$');
35	37	ok 2, contains("t/default.err", '^Message$');
36	38	ok 3, !contains("t/default.err", '^Debug$');
37		ok 4, 0 == -s "t/default.out";
	39	ok 4, !contains("t/default.err", '^Debugging$');
	40	ok 5, !contains("t/default.err", '^Info$');
	41	ok 6, 0 == -s "t/default.out";
38	42
39	43	unlink 't/default.out', 't/default.err';

+9

-2

t/file.t less more

13	13
14	14	use Test::More;
15	15	use Log::Agent;
	16	use Log::Agent::Priorities qw(:LEVELS);
16	17	require Log::Agent::Driver::File;
17	18	require './t/common.pl';
18	19
19		BEGIN { plan tests => 38 }
	20	BEGIN { plan tests => 42 }
20	21
21	22	my $driver = Log::Agent::Driver::File->make(); # take all defaults
22	23	logconfig(-driver => $driver);

54	55	},
55	56	-duperr => 1,
56	57	);
57		logconfig(-driver => $driver);
	58	logconfig(-driver => $driver, -level => DEBUG);
58	59
59	60	open(ORIGOUT, ">&STDOUT") or die "can't dup STDOUT: $!\n";
60	61	open(STDOUT, ">t/file.out") or die "can't redirect STDOUT: $!\n";

64	65	select(ORIGOUT); $\| = 1;
65	66
66	67	logerr "error";
	68	logdebug "debug";
	69	loginfo "info";
67	70	logsay "message";
68	71	logwarn "warning";
69	72	eval { logdie "die" };

79	82	ok(contains("t/file.err", '^DATE me\[\d+\]: error$'));
80	83	ok(contains("t/file.out", 'ERROR: error'));
81	84	ok(contains("t/file.out", '^DATE me\[\d+\]: message$'));
	85	ok(contains("t/file.out", '^DATE me\[\d+\]: info$'));
	86	ok(contains("t/file.out", '^DATE me\[\d+\]: debug$'));
82	87	ok(! contains("t/file.err", 'message'));
	88	ok(! contains("t/file.err", 'info'));
	89	ok(! contains("t/file.err", 'debug'));
83	90	ok(contains("t/file.err", '^DATE me\[\d+\]: warning$'));
84	91	ok(contains("t/file.out", 'WARNING: warning'));
85	92	ok(contains("t/file.err", '^DATE me\[\d+\]: die$'));

+13

-2

t/fork.t less more

15	15	use Test;
16	16	require './t/common.pl';
17	17
18		BEGIN { plan tests => 19 }
	18	BEGIN { plan tests => 27 }
19	19
20	20	use Log::Agent;
	21	use Log::Agent::Priorities qw(:LEVELS);
21	22	require Log::Agent::Driver::Fork;
22	23	require Log::Agent::Driver::Default;
23	24	require Log::Agent::Driver::File;

34	35	-duperr => 1,
35	36	)
36	37	);
37		logconfig( -driver => $driver );
	38	logconfig( -driver => $driver, -level => DEBUG );
38	39
39	40	open(ORIGOUT, ">&STDOUT") or die "can't dup STDOUT: $!\n";
40	41	open(STDOUT, ">t/fork_std.out") or die "can't redirect STDOUT: $!\n";

45	46
46	47	logerr "out of pez";
47	48	logsay "una is a growing pup";
	49	loginfo "COOLING";
	50	logdebug "COOKING";
48	51	logtrc 'debug', "HLAGHLAGHLAGH";
49	52	logwarn "do not try this at home";
50	53	eval { logdie "et tu, Chuckles?" };

61	64	ok(contains("t/fork_std.err", '^moose: out of pez$'));
62	65	ok(! contains("t/fork_std.err", '^Out of pez$'));
63	66	ok(contains("t/fork_std.err", '^moose: una is a growing pup$'));
	67	ok(contains("t/fork_std.err", '^moose: COOLING'));
	68	ok(contains("t/fork_std.err", '^moose: COOKING'));
64	69	ok(! contains("t/fork_std.err", '^Una is a growing pup$'));
	70	ok(! contains("t/fork_std.err", '^COOKING$'));
	71	ok(! contains("t/fork_std.err", '^COOLING$'));
65	72	ok(contains("t/fork_std.err", '^moose: et tu, Chuckles\?$'));
66	73	ok(! contains("t/fork_std.err", '^Et tu, Chuckles\?$'));
67	74	ok(contains("t/fork_std.err", '^moose: do not try this at home$'));

74	81	ok(contains("t/fork_file.out", 'ERROR: out of pez'));
75	82	ok(contains("t/fork_file.out", '^DATE squirrel\[\d+\]: una is a growing pup$'));
76	83	ok(! contains("t/fork_file.err", 'una is a growing pup'));
	84	ok(! contains("t/fork_file.err", 'COOKING'));
	85	ok(! contains("t/fork_file.err", 'COOLING'));
77	86	ok(contains("t/fork_file.err", '^DATE squirrel\[\d+\]: do not try this at home$'));
78	87	ok(contains("t/fork_file.out", 'WARNING: do not try this at home'));
79	88	ok(contains("t/fork_file.err", '^DATE squirrel\[\d+\]: et tu, Chuckles\?$'));
80	89	ok(contains("t/fork_file.out", 'FATAL: et tu, Chuckles\?'));
	90	ok(contains("t/fork_file.out", 'COOKING'));
	91	ok(contains("t/fork_file.out", 'COOLING'));
81	92
82	93	unlink 't/fork_std.out', 't/fork_std.err',
83	94	't/fork_file.out', 't/fork_file.err';

+4

-1

t/priority.t less more

11	11	#
12	12	##########################################################################
13	13
14		print "1..5\n";
	14	print "1..7\n";
15	15
16	16	require './t/code.pl';
17	17	sub ok;

38	38	logsay "notice string";
39	39	logcarp "carp string";
40	40	logdbg 'info:12', "info string";
	41	logdebug "debug string in out";
41	42
42	43	ok 1, contains("t/file.err", "<error/3> error string");
43	44	ok 2, !contains("t/file.err", "notice string");
44	45	ok 3, contains("t/file.err", "<warning/4> carp string");
45	46	ok 4, contains("t/file.out", "<notice/6> notice string");
46	47	ok 5, contains("t/file.err", "<info/12> info string");
	48	ok 6, !contains("t/file.err", "debug string in out");
	49	ok 7, contains("t/file.out", "debug string in out");
47	50
48	51	unlink 't/file.out', 't/file.err';