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
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
|
use Test::More;
use IO::File;
use IO::String;
use strict;
use Log::Any;
use utf8;
my @log_methods = Log::Any->logging_methods();
my @detection_methods = Log::Any->detection_methods();
#binmode(STDOUT,':utf8');
plan tests =>
# require/use test
1
# basic function tests
+ (@log_methods + 1 + @detection_methods)
# custom print catcher
+ 2
# testing formatting
+ 2
# testing line swallowing/escapeing
+ 2
# unicode tests
+ 3
;
require_ok('Log::Any::Adapter::FileHandle') or die "Can't test the rest";
{
my $str = IO::String->new();
my $log = Log::Any::Adapter::FileHandle->new(category=>'test',fh=>$str);
my $test = join("\n", map { "[$_] test" } @log_methods)."\n";
foreach my $meth (@log_methods) {
eval {
$log->$meth("test");
};
if($@) {
fail("Log method $meth failed:$@");
} else {
pass("Log method $meth ok");
}
}
my $ref = $str->string_ref;
is($$ref,$test, "Testing to in memory IO::String filehandle");
foreach my $meth (@detection_methods) {
my $ret;
eval {
$ret = $log->$meth;
};
if($@) {
fail("Detection method $meth failed: $@");
} else {
if($ret) {
pass("Detection method $meth ok, and returns true");
} else {
fail("Detection method $meth called w/o dying, but returns false");
}
}
}
}
{
package PrintCatcher1;
use Test::More;
sub print {
my ($class, $string) = @_;
chomp $string;
like $string, qr/^\[\w+\] (.*?)$/, "Got log message $string";
}
1;
package main;
my $catcher = bless {}, 'PrintCatcher1';
my $log = Log::Any::Adapter::FileHandle->new(category=>'test',fh=>$catcher);
$log->warning("Test message 1");
$log->info("Test Message 2");
}
{
package PrintCatcher2;
use Test::More;
sub print {
my ($class, $string) = @_;
chomp $string;
like $string, qr/^\|\w+\| (.*?)$/, "Got custom format log message $string";
}
1;
package main;
my $catcher = bless {}, 'PrintCatcher2';
my $log = Log::Any::Adapter::FileHandle->new(category=>'test',format=>'|%s| %s',fh=>$catcher);
$log->warning("Test message 1");
$log->info("Test Message 2");
}
{
package PrintCatcher3;
use Test::More;
sub print {
my ($class, $string) = @_;
chomp $string;
unlike $string, qr/\n/s, "Message all on one line";
}
1;
package main;
my $catcher = bless {}, 'PrintCatcher3';
my $log = Log::Any::Adapter::FileHandle->new(category=>'test',escape=>'newline',fh=>$catcher);
$log->warning("Test \nmessage 1");
$log->info("Test \n\nMess\nage 2");
}
{
package PrintCatcher4;
use Test::More;
our $should_be;
sub print {
my ($class, $string) = @_;
chomp $string;
#unlike $string, qr/\n/s, "Message all on one line";
is($string, $should_be, "Uncode escape test");
}
1;
package main;
my $catcher = bless {}, 'PrintCatcher4';
my $log = Log::Any::Adapter::FileHandle->new(category=>'test',escape=>'nonascii',fh=>$catcher);
my @items = (
[ "See my airplane? ✈ ✈ ✈", "[warning] See my airplane? \\x{2708} \\x{2708} \\x{2708}"],
[ "newlines\ntoo!", "[warning] newlines\\ntoo!"],
[ "newlines\nandunicode✬", "[warning] newlines\\nandunicode\\x{272c}"]
);
foreach my $item (@items) {
$PrintCatcher4::should_be = $item->[1];
$log->warning($item->[0]);
}
}
|
