Commit | Line | Data |
27141a7a |
1 | use strict; |
2 | use warnings; |
3 | |
4 | use Log::Contextual::SimpleLogger; |
5 | use Test::More qw(no_plan); |
6 | use Log::Contextual qw(:log set_logger); |
7 | |
8 | my ($var1,$var2,$var3); |
9 | my $complex_dispatcher = do { |
10 | |
11 | my $l1 = Log::Contextual::SimpleLogger->new({ |
12 | levels => [qw(trace debug info warn error fatal)], |
13 | coderef => sub { $var1 = shift }, |
14 | }); |
15 | |
16 | my $l2 = Log::Contextual::SimpleLogger->new({ |
17 | levels => [qw(trace debug info warn error fatal)], |
18 | coderef => sub { $var2 = shift }, |
19 | }); |
20 | |
21 | my $l3 = Log::Contextual::SimpleLogger->new({ |
22 | levels => [qw(trace debug info warn error fatal)], |
23 | coderef => sub { $var3 = shift }, |
24 | }); |
25 | |
26 | my %registry = ( |
27 | -logger => $l3, |
28 | A1 => { |
29 | -logger => $l1, |
30 | lol => $l2, |
31 | }, |
32 | A2 => { -logger => $l2 }, |
33 | ); |
34 | |
35 | sub { |
36 | my ( $package, $info ) = @_; |
37 | |
38 | my $logger = $registry{'-logger'}; |
39 | if (my $r = $registry{$package}) { |
40 | $logger = $r->{'-logger'} if $r->{'-logger'}; |
37a8266a |
41 | my (undef, undef, undef, $sub) = caller($info->{caller_level} + 1); |
27141a7a |
42 | $sub =~ s/^\Q$package\E:://g; |
43 | $logger = $r->{$sub} if $r->{$sub}; |
44 | } |
45 | return $logger; |
46 | } |
47 | }; |
48 | |
49 | set_logger $complex_dispatcher; |
50 | |
51 | log_debug { '1.var3' }; |
52 | |
53 | is($var3, "[debug] 1.var3\n", "default logger works"); |
54 | |
55 | $var3 = ''; |
56 | |
57 | A1::lol(); |
58 | A1::rofl(); |
59 | |
60 | is($var2, "[debug] 1.var2\n", "default package logger works"); |
61 | is($var1, "[debug] 1.var1\n", "package::sub logger works"); |
62 | |
63 | $var1 = ''; |
64 | $var2 = ''; |
65 | |
66 | A2::foo(); |
67 | |
68 | is($var2, "[debug] 2.var2\n", "only default package logger works"); |
69 | |
70 | $var2 = ''; |
71 | |
72 | A3::squint(); |
73 | |
74 | is($var3, "[debug] 2.var3\n", "global default logger works"); |
75 | |
76 | BEGIN { |
77 | package A1; |
78 | use Log::Contextual ':log'; |
79 | |
80 | sub lol { log_debug { '1.var2' } } |
81 | sub rofl { log_debug { '1.var1' } } |
82 | |
83 | package A2; |
84 | use Log::Contextual ':log'; |
85 | |
86 | sub foo { log_debug { '2.var2' } } |
87 | |
88 | package A3; |
89 | use Log::Contextual ':log'; |
90 | |
91 | sub squint { log_debug { '2.var3' } } |
92 | } |