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 | |
6ae293d7 |
8 | my ($var1, $var2, $var3); |
27141a7a |
9 | my $complex_dispatcher = do { |
10 | |
11 | my $l1 = Log::Contextual::SimpleLogger->new({ |
489f71b2 |
12 | levels => [qw(trace debug info warn error fatal)], |
13 | coderef => sub { $var1 = shift }, |
27141a7a |
14 | }); |
15 | |
16 | my $l2 = Log::Contextual::SimpleLogger->new({ |
489f71b2 |
17 | levels => [qw(trace debug info warn error fatal)], |
18 | coderef => sub { $var2 = shift }, |
27141a7a |
19 | }); |
20 | |
21 | my $l3 = Log::Contextual::SimpleLogger->new({ |
489f71b2 |
22 | levels => [qw(trace debug info warn error fatal)], |
23 | coderef => sub { $var3 = shift }, |
27141a7a |
24 | }); |
25 | |
26 | my %registry = ( |
27 | -logger => $l3, |
6ae293d7 |
28 | A1 => { |
27141a7a |
29 | -logger => $l1, |
30 | lol => $l2, |
31 | }, |
6ae293d7 |
32 | A2 => {-logger => $l2}, |
27141a7a |
33 | ); |
34 | |
35 | sub { |
6ae293d7 |
36 | my ($package, $info) = @_; |
27141a7a |
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; |
6ae293d7 |
46 | } |
27141a7a |
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 { |
6ae293d7 |
77 | |
27141a7a |
78 | package A1; |
79 | use Log::Contextual ':log'; |
80 | |
6ae293d7 |
81 | sub lol { |
82 | log_debug { '1.var2' } |
83 | } |
84 | |
85 | sub rofl { |
86 | log_debug { '1.var1' } |
87 | } |
27141a7a |
88 | |
89 | package A2; |
90 | use Log::Contextual ':log'; |
91 | |
6ae293d7 |
92 | sub foo { |
93 | log_debug { '2.var2' } |
94 | } |
27141a7a |
95 | |
96 | package A3; |
97 | use Log::Contextual ':log'; |
98 | |
6ae293d7 |
99 | sub squint { |
100 | log_debug { '2.var3' } |
101 | } |
27141a7a |
102 | } |