File: eg.t

package info (click to toggle)
liblog-contextual-perl 0.007000-1
  • links: PTS, VCS
  • area: main
  • in suites: stretch
  • size: 320 kB
  • ctags: 75
  • sloc: perl: 615; makefile: 2
file content (102 lines) | stat: -rw-r--r-- 2,012 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
use strict;
use warnings;

use Log::Contextual::SimpleLogger;
use Test::More qw(no_plan);
use Log::Contextual qw(:log set_logger);

my ($var1, $var2, $var3);
my $complex_dispatcher = do {

   my $l1 = Log::Contextual::SimpleLogger->new({
      levels  => [qw(trace debug info warn error fatal)],
      coderef => sub { $var1 = shift },
   });

   my $l2 = Log::Contextual::SimpleLogger->new({
      levels  => [qw(trace debug info warn error fatal)],
      coderef => sub { $var2 = shift },
   });

   my $l3 = Log::Contextual::SimpleLogger->new({
      levels  => [qw(trace debug info warn error fatal)],
      coderef => sub { $var3 = shift },
   });

   my %registry = (
      -logger => $l3,
      A1      => {
         -logger => $l1,
         lol     => $l2,
      },
      A2 => {-logger => $l2},
   );

   sub {
      my ($package, $info) = @_;

      my $logger = $registry{'-logger'};
      if (my $r = $registry{$package}) {
         $logger = $r->{'-logger'} if $r->{'-logger'};
         my (undef, undef, undef, $sub) = caller($info->{caller_level} + 1);
         $sub =~ s/^\Q$package\E:://g;
         $logger = $r->{$sub} if $r->{$sub};
      }
      return $logger;
     }
};

set_logger $complex_dispatcher;

log_debug { '1.var3' };

is($var3, "[debug] 1.var3\n", "default logger works");

$var3 = '';

A1::lol();
A1::rofl();

is($var2, "[debug] 1.var2\n", "default package logger works");
is($var1, "[debug] 1.var1\n", "package::sub logger works");

$var1 = '';
$var2 = '';

A2::foo();

is($var2, "[debug] 2.var2\n", "only default package logger works");

$var2 = '';

A3::squint();

is($var3, "[debug] 2.var3\n", "global default logger works");

BEGIN {

   package A1;
   use Log::Contextual ':log';

   sub lol {
      log_debug { '1.var2' }
   }

   sub rofl {
      log_debug { '1.var1' }
   }

   package A2;
   use Log::Contextual ':log';

   sub foo {
      log_debug { '2.var2' }
   }

   package A3;
   use Log::Contextual ':log';

   sub squint {
      log_debug { '2.var3' }
   }
}