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
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
|
#perl
use strict;
use warnings;
use IO::Scalar;
use Test::More tests => 9;
use Test::Exception;
dies_ok {
package DeprecatedTest;
use Moose;
use MooseX::LogDispatch;
with Logger();
} "Use of Logger() dies, now deprecated.";
{
package ConfigLogTest;
use Moose;
with qw/MooseX::LogDispatch/;
has config_filename => (
is => 'ro',
lazy => 1,
default => '/path/to/my/logfile',
);
}
{
package HardwiredLogTest;
use Moose;
with qw(MooseX::LogDispatch);
}
sub test_logger {
my ($logger) = @_;
$logger->debug('foo');
$logger->info('foo');
$logger->error('Gah!');
}
{
my $logger = new ConfigLogTest(
config_filename => 't/test.cfg'
);
isa_ok($logger->logger, 'Log::Dispatch');
is($logger->can('error'), undef, "Object not polluted");
tie *STDERR, 'IO::Scalar', \my $err;
local $SIG{__DIE__} = sub { untie *STDERR; die @_ };
test_logger($logger->logger);
untie *STDERR;
is($err, <<'EOF', "Got correct errors to stderr");
[info] foo at t/01basic.t line 43
[error] Gah! at t/01basic.t line 44
EOF
}
{
my $logger = new HardwiredLogTest;
isa_ok($logger->logger, 'Log::Dispatch');
is($logger->can('error'), undef, "Object not polluted");
tie *STDERR, 'IO::Scalar', \my $err;
local $SIG{__DIE__} = sub { untie *STDERR; die @_ };
test_logger($logger->logger);
untie *STDERR;
# Remove dates from front of lines
$err =~ s{^\[\w+ \w+\s+\d{1,2}\s+\d\d:\d\d:\d\d \d{4}\] }{}gm;
is($err, <<'EOF', "Got correct errors to stderr");
[debug] foo at t/01basic.t line 42
[info] foo at t/01basic.t line 43
[error] Gah! at t/01basic.t line 44
EOF
}
{
package LevelsLogTest;
use Moose;
with qw/MooseX::LogDispatch::Levels/;
}
{
my $logger = new LevelsLogTest;
isa_ok($logger->logger, 'Log::Dispatch');
tie *STDERR, 'IO::Scalar', \my $err;
local $SIG{__DIE__} = sub { untie *STDERR; die @_ };
test_logger($logger);
untie *STDERR;
# Remove dates from front of lines
$err =~ s{^\[\w+ \w+\s+\d{1,2}\s+\d\d:\d\d:\d\d \d{4}\] }{}gm;
is($err, <<'EOF', "Got correct errors to stderr");
[debug] foo at t/01basic.t line 42
[info] foo at t/01basic.t line 43
[error] Gah! at t/01basic.t line 44
EOF
}
|
