Codebase list liblog-dispatchouli-perl / fabdbb1
env_value, env_prefix to allow per-logger env vars Ricardo Signes 13 years ago
3 changed file(s) with 86 addition(s) and 3 deletion(s). Raw diff Collapse all Expand all
+1
-0
Changes less more
00 Revision history for {{$dist->name}}
11
22 {{$NEXT}}
3 add env_value and env_prefix methods
34
45 2.001 2011-01-13 12:45:05 America/New_York
56 greatly expanded tests and documentation for L::D::Global
+41
-3
lib/Log/Dispatchouli.pm less more
145145 if ($arg->{to_file}) {
146146 require Log::Dispatch::File;
147147 my $log_file = File::Spec->catfile(
148 ($ENV{DISPATCHOULI_PATH} || File::Spec->tmpdir),
148 ($self->env_value('PATH') || File::Spec->tmpdir),
149149 sprintf('%s.%04u%02u%02u',
150150 $ident,
151151 ((localtime)[5] + 1900),
169169 );
170170 }
171171
172 if ($arg->{facility} and not $ENV{DISPATCHOULI_NOSYSLOG}) {
172 if ($arg->{facility} and not $self->env_value('NOSYSLOG')) {
173173 require Log::Dispatch::Syslog;
174174 $log->add(
175175 Log::Dispatch::Syslog->new(
221221
222222 $self->{debug} = exists $arg->{debug}
223223 ? ($arg->{debug} ? 1 : 0)
224 : ($ENV{DISPATCHOULI_DEBUG} ? 1 : 0);
224 : ($self->env_value('DEBUG') ? 1 : 0);
225225
226226 $self->{fail_fatal} = exists $arg->{fail_fatal} ? $arg->{fail_fatal} : 1;
227227
439439 =cut
440440
441441 sub string_flogger { 'String::Flogger' }
442
443 =head2 env_prefix
444
445 This method should return a string used as a prefix to find environment
446 variables that affect the logger's behavior. For example, if this method
447 returns C<XYZZY> then when checking the environment for a default value for the
448 C<debug> parameter, Log::Dispatchouli will first check C<XYZZY_DEBUG>, then
449 C<DISPATCHOULI_DEBUG>.
450
451 By default, this method returns C<()>, which means no extra environment
452 variable is checked.
453
454 =cut
455
456 sub env_prefix { return; }
457
458 =head2 env_value
459
460 my $value = $logger->env_value('DEBUG');
461
462 This method returns the value for the environment variable suffix given. For
463 example, the example given, calling with C<DEBUG> will check
464 C<DISPATCHOULI_DEBUG>.
465
466 =cut
467
468 sub env_value {
469 my ($self, $suffix) = @_;
470
471 my @path = grep { defined } ($self->env_prefix, 'DISPATCHOULI');
472
473 for my $prefix (@path) {
474 my $name = join q{_}, $prefix, $suffix;
475 return $ENV{ $name } if defined $ENV{ $name };
476 }
477
478 return;
479 }
442480
443481 =head1 METHODS FOR TESTING
444482
+44
-0
t/env-value.t less more
0 #!perl
1 use strict;
2 use warnings;
3
4 use Test::More;
5
6 use Log::Dispatchouli;
7
8 {
9 package Xyzzy::Logger;
10 use base 'Log::Dispatchouli';
11
12 sub env_prefix { 'XYZZY' }
13 }
14
15 {
16 local $ENV{DISPATCHOULI_DEBUG} = 1;
17 local $ENV{XYZZY_DEBUG} = 0;
18 my $d_logger = Log::Dispatchouli->new_tester;
19 my $x_logger = Xyzzy::Logger->new_tester;
20
21 ok( $d_logger->is_debug, "DISPATCHOULI_ affects L::D logger");
22 ok( ! $x_logger->is_debug, "...but XYZZY_ overrides for X::L");
23 }
24
25 {
26 local $ENV{DISPATCHOULI_DEBUG} = 1;
27 my $d_logger = Log::Dispatchouli->new_tester;
28 my $x_logger = Xyzzy::Logger->new_tester;
29
30 ok( $d_logger->is_debug, "DISPATCHOULI_ affects L::D logger");
31 ok( $x_logger->is_debug, "...and X::L will use it with no XYZZY_");
32 }
33
34 {
35 local $ENV{XYZZY_DEBUG} = 1;
36 my $d_logger = Log::Dispatchouli->new_tester;
37 my $x_logger = Xyzzy::Logger->new_tester;
38
39 ok( $x_logger->is_debug, "XYZZY_ affects X::L");
40 ok( ! $d_logger->is_debug, "...but not L::D");
41 }
42
43 done_testing;