line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Bio::Phylo::Util::Logger; |
2
|
57
|
|
|
57
|
|
338
|
use strict; |
|
57
|
|
|
|
|
110
|
|
|
57
|
|
|
|
|
1462
|
|
3
|
57
|
|
|
57
|
|
269
|
use warnings; |
|
57
|
|
|
|
|
101
|
|
|
57
|
|
|
|
|
1345
|
|
4
|
57
|
|
|
57
|
|
260
|
use base 'Exporter'; |
|
57
|
|
|
|
|
98
|
|
|
57
|
|
|
|
|
4796
|
|
5
|
57
|
|
|
57
|
|
21242
|
use Term::ANSIColor; |
|
57
|
|
|
|
|
378578
|
|
|
57
|
|
|
|
|
3925
|
|
6
|
57
|
|
|
57
|
|
421
|
use Bio::Phylo::Util::Exceptions 'throw'; |
|
57
|
|
|
|
|
118
|
|
|
57
|
|
|
|
|
2318
|
|
7
|
57
|
|
|
57
|
|
3133
|
use Bio::Phylo::Util::CONSTANT qw'/looks_like/'; |
|
57
|
|
|
|
|
106
|
|
|
57
|
|
|
|
|
18126
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
our ( %VERBOSITY, $PREFIX, %STYLE ); |
10
|
|
|
|
|
|
|
our $STYLE = 'detailed'; |
11
|
|
|
|
|
|
|
our $COLORED = 1; # new default: we use colors |
12
|
|
|
|
|
|
|
our $TRACEBACK = 0; |
13
|
|
|
|
|
|
|
our @EXPORT_OK = qw(DEBUG INFO WARN ERROR FATAL VERBOSE); |
14
|
|
|
|
|
|
|
our %EXPORT_TAGS = ( 'simple' => [@EXPORT_OK], 'levels' => [@EXPORT_OK] ); |
15
|
|
|
|
|
|
|
our %COLORS = ( |
16
|
|
|
|
|
|
|
'DEBUG' => 'blue', |
17
|
|
|
|
|
|
|
'INFO' => 'green', |
18
|
|
|
|
|
|
|
'WARN' => 'yellow', |
19
|
|
|
|
|
|
|
'ERROR' => 'bold red', |
20
|
|
|
|
|
|
|
'FATAL' => 'red', |
21
|
|
|
|
|
|
|
); |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
BEGIN { |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
# compute the path to the root of Bio::Phylo, |
26
|
|
|
|
|
|
|
# use that as the default prefix |
27
|
57
|
|
|
57
|
|
236
|
my $package = __PACKAGE__; |
28
|
57
|
|
|
|
|
104
|
my $file = __FILE__; |
29
|
57
|
|
|
|
|
267
|
$package =~ s/::/\//g; |
30
|
57
|
|
|
|
|
152
|
$package .= '.pm'; |
31
|
57
|
|
|
|
|
844
|
$file =~ s/\Q$package\E$//; |
32
|
57
|
|
|
|
|
147
|
$PREFIX = $file; |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
# set verbosity to 2, i.e. warn |
35
|
57
|
|
50
|
|
|
428
|
$VERBOSITY{'*'} = $ENV{'BIO_PHYLO_VERBOSITY'} || 2; |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
# define verbosity styles |
38
|
57
|
|
|
|
|
73881
|
%STYLE = ( |
39
|
|
|
|
|
|
|
'simple' => '${level}: $message', |
40
|
|
|
|
|
|
|
'detailed' => '$level $sub [$file $line] - $message', |
41
|
|
|
|
|
|
|
); |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
{ |
45
|
|
|
|
|
|
|
my %levels = ( FATAL => 0, ERROR => 1, WARN => 2, INFO => 3, DEBUG => 4 ); |
46
|
|
|
|
|
|
|
my @listeners = ( sub { |
47
|
|
|
|
|
|
|
my ( $string, $level ) = @_; |
48
|
|
|
|
|
|
|
if ( $COLORED and -t STDERR ) { |
49
|
|
|
|
|
|
|
print STDERR colored( $string, $COLORS{$level} ); |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
else { |
52
|
|
|
|
|
|
|
print STDERR $string; |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
} ); # default |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
# dummy constructor that dispatches to VERBOSE(), |
57
|
|
|
|
|
|
|
# then returns the package name |
58
|
|
|
|
|
|
|
sub new { |
59
|
200
|
|
|
200
|
1
|
898
|
my $class = shift; |
60
|
200
|
50
|
|
|
|
1532
|
$class->VERBOSE(@_) if @_; |
61
|
200
|
|
|
|
|
1322
|
return $class; |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
# set additional listeners |
65
|
|
|
|
|
|
|
sub set_listeners { |
66
|
2
|
|
|
2
|
1
|
13
|
my ( $class, @args ) = @_; |
67
|
2
|
|
|
|
|
4
|
for my $arg (@args) { |
68
|
2
|
100
|
|
|
|
6
|
if ( looks_like_instance $arg, 'CODE' ) { |
69
|
1
|
|
|
|
|
3
|
push @listeners, $arg; |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
else { |
72
|
1
|
|
|
|
|
7
|
throw 'BadArgs' => "$arg not a CODE reference"; |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
} |
75
|
1
|
|
|
|
|
4
|
return $class; |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
# this is never called directly. rather, messages are dispatched here |
79
|
|
|
|
|
|
|
# by the DEBUG() ... FATAL() subs below |
80
|
|
|
|
|
|
|
sub LOG ($$) { |
81
|
248228
|
|
|
248228
|
0
|
366393
|
my ( $message, $level ) = @_; |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
# probe the call stack |
84
|
248228
|
|
|
|
|
905285
|
my ( $pack2, $file2, $line2, $sub ) = caller( $TRACEBACK + 2 ); |
85
|
248228
|
|
|
|
|
806767
|
my ( $pack1, $file, $line, $sub1 ) = caller( $TRACEBACK + 1 ); |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
# cascade verbosity from global to local |
88
|
248228
|
|
|
|
|
427131
|
my $verbosity = $VERBOSITY{'*'}; # global |
89
|
248228
|
50
|
|
|
|
404657
|
$verbosity = $VERBOSITY{$pack1} if exists $VERBOSITY{$pack1}; # package |
90
|
248228
|
50
|
33
|
|
|
603635
|
$verbosity = $VERBOSITY{$sub} if $sub and exists $VERBOSITY{$sub}; # sub |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
# verbosity is higher than the current caller, proceed |
93
|
248228
|
50
|
|
|
|
481044
|
if ( $verbosity >= $levels{$level} ) { |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
# strip the prefix from the calling file's path |
96
|
0
|
0
|
|
|
|
0
|
if ( index($file, $PREFIX) == 0 ) { |
97
|
0
|
|
|
|
|
0
|
$file =~ s/^\Q$PREFIX\E//; |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
# select one of the templates |
101
|
0
|
|
|
|
|
0
|
my $string; |
102
|
0
|
|
|
|
|
0
|
my $s = $STYLE{$STYLE}; |
103
|
0
|
|
|
|
|
0
|
$string = eval "qq[$s\n]"; |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
# dispatch to the listeners |
106
|
0
|
|
|
|
|
0
|
$_->( $string, $level, $sub, $file, $line, $message ) for @listeners; |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
# these subs both return their verbosity constants and, if |
111
|
|
|
|
|
|
|
# provided with a message, dispatch the message to LOG() |
112
|
0
|
0
|
|
0
|
1
|
0
|
sub FATAL (;$) { LOG $_[0], 'FATAL' if $_[0]; $levels{'FATAL'} } |
|
0
|
|
|
|
|
0
|
|
113
|
0
|
0
|
|
0
|
1
|
0
|
sub ERROR (;$) { LOG $_[0], 'ERROR' if $_[0]; $levels{'ERROR'} } |
|
0
|
|
|
|
|
0
|
|
114
|
4
|
50
|
|
4
|
1
|
15
|
sub WARN (;$) { LOG $_[0], 'WARN' if $_[0]; $levels{'WARN'} } |
|
4
|
|
|
|
|
8
|
|
115
|
66121
|
50
|
|
66121
|
1
|
155330
|
sub INFO (;$) { LOG $_[0], 'INFO' if $_[0]; $levels{'INFO'} } |
|
66121
|
|
|
|
|
81144
|
|
116
|
182113
|
100
|
|
182113
|
1
|
400677
|
sub DEBUG (;$) { LOG $_[0], 'DEBUG' if $_[0]; $levels{'DEBUG'} } |
|
182113
|
|
|
|
|
218999
|
|
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
sub PREFIX { |
119
|
0
|
|
|
0
|
1
|
0
|
my ( $class, $prefix ) = @_; |
120
|
0
|
0
|
|
|
|
0
|
$PREFIX = $prefix if $prefix; |
121
|
0
|
|
|
|
|
0
|
return $PREFIX; |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
sub VERBOSE { |
125
|
14
|
100
|
66
|
14
|
1
|
126
|
shift if ref $_[0] or $_[0] eq __PACKAGE__; |
126
|
14
|
50
|
|
|
|
51
|
if (@_) { |
127
|
14
|
|
|
|
|
55
|
my %opt = looks_like_hash @_; |
128
|
14
|
|
|
|
|
41
|
my $level = $opt{'-level'}; |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
# verbosity is specified |
131
|
14
|
50
|
|
|
|
49
|
if ( defined $level ) { |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
# check validity |
134
|
14
|
50
|
25
|
|
|
93
|
if ( $level > 4 xor $level < 0 ) { |
135
|
0
|
|
|
|
|
0
|
throw 'OutOfBounds' => "'-level' can be between 0 and 4, not $level"; |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
# verbosity is specified for one or more packages |
139
|
14
|
50
|
|
|
|
90
|
if ( my $class = $opt{'-class'} ) { |
|
|
50
|
|
|
|
|
|
140
|
0
|
0
|
|
|
|
0
|
if ( ref $class eq 'ARRAY' ) { |
141
|
0
|
|
|
|
|
0
|
for my $c ( @{ $class } ) { |
|
0
|
|
|
|
|
0
|
|
142
|
0
|
|
|
|
|
0
|
$VERBOSITY{$c} = $level; |
143
|
0
|
|
|
|
|
0
|
INFO "Changed verbosity for class $c to $level"; |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
else { |
147
|
0
|
|
|
|
|
0
|
$VERBOSITY{$class} = $level; |
148
|
0
|
|
|
|
|
0
|
INFO "Changed verbosity for class $class to $level"; |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
# verbosity is specified for one or more methods |
153
|
|
|
|
|
|
|
elsif ( my $method = $opt{'-method'} ) { |
154
|
0
|
0
|
|
|
|
0
|
if ( ref $method eq 'ARRAY' ) { |
155
|
0
|
|
|
|
|
0
|
for my $m ( @{ $method } ) { |
|
0
|
|
|
|
|
0
|
|
156
|
0
|
|
|
|
|
0
|
$VERBOSITY{$m} = $level; |
157
|
0
|
|
|
|
|
0
|
INFO "Changed verbosity for method $m to $level"; |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
else { |
161
|
0
|
|
|
|
|
0
|
$VERBOSITY{$method} = $level; |
162
|
0
|
|
|
|
|
0
|
INFO "Changed verbosity for method $method to $level"; |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
# verbosity is set globally |
167
|
|
|
|
|
|
|
else { |
168
|
14
|
|
|
|
|
39
|
$VERBOSITY{'*'} = $level; |
169
|
14
|
|
|
|
|
81
|
INFO "Changed global verbosity to $VERBOSITY{'*'}"; |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
# log to a file |
174
|
14
|
50
|
|
|
|
64
|
if ( $opt{'-file'} ) { |
175
|
0
|
0
|
|
|
|
0
|
open my $fh, '>>', $opt{'-file'} or throw 'FileError' => $!; |
176
|
0
|
|
|
0
|
|
0
|
__PACKAGE__->set_listeners(sub { print $fh shift }); |
|
0
|
|
|
|
|
0
|
|
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
# log to a handle |
180
|
14
|
50
|
|
|
|
57
|
if ( $opt{'-handle'} ) { |
181
|
0
|
|
|
|
|
0
|
my $fh = $opt{'-handle'}; |
182
|
0
|
|
|
0
|
|
0
|
__PACKAGE__->set_listeners(sub { print $fh shift }); |
|
0
|
|
|
|
|
0
|
|
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
# log to listeners |
186
|
14
|
50
|
|
|
|
53
|
if ( $opt{'-listeners'} ) { |
187
|
0
|
|
|
|
|
0
|
__PACKAGE__->set_listeners(@{$opt{'-listeners'}}); |
|
0
|
|
|
|
|
0
|
|
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
# update the prefix |
191
|
14
|
50
|
|
|
|
52
|
if ( $opt{'-prefix'} ) { |
192
|
0
|
|
|
|
|
0
|
__PACKAGE__->PREFIX($opt{'-prefix'}); |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
# set logstyle |
196
|
14
|
50
|
|
|
|
47
|
if ( $opt{'-style'} ) { |
197
|
0
|
|
|
|
|
0
|
my $s = lc $opt{'-style'}; |
198
|
0
|
0
|
|
|
|
0
|
if ( exists $STYLE{$s} ) { |
199
|
0
|
|
|
|
|
0
|
$STYLE = $s; |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
} |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
# turn colors on/off. default is on. |
204
|
14
|
50
|
|
|
|
59
|
$COLORED = !!$opt{'-colors'} if defined $opt{'-colors'}; |
205
|
|
|
|
|
|
|
} |
206
|
14
|
|
|
|
|
49
|
return $VERBOSITY{'*'}; |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
# Change the terminal to a predefined color. For example to make sure that |
210
|
|
|
|
|
|
|
# an entire exception (or part of it) is marked up as FATAL, or so that the |
211
|
|
|
|
|
|
|
# output from an external command is marked up as DEBUG. |
212
|
|
|
|
|
|
|
sub start_color { |
213
|
0
|
|
|
0
|
1
|
0
|
my ( $self, $level, $handle ) = @_; |
214
|
0
|
0
|
|
|
|
0
|
$handle = \*STDERR if not $handle; |
215
|
0
|
0
|
0
|
|
|
0
|
if ( $COLORED and -t $handle ) { |
216
|
0
|
|
|
|
|
0
|
print $handle color $COLORS{$level}; |
217
|
|
|
|
|
|
|
} |
218
|
0
|
|
|
|
|
0
|
return $COLORS{$level}; |
219
|
|
|
|
|
|
|
} |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
sub stop_color { |
222
|
0
|
|
|
0
|
1
|
0
|
my ( $self, $handle ) = @_; |
223
|
0
|
0
|
|
|
|
0
|
$handle = \*STDERR if not $handle; |
224
|
0
|
0
|
0
|
|
|
0
|
if ( $COLORED and -t $handle ) { |
225
|
0
|
|
|
|
|
0
|
print $handle color 'reset'; |
226
|
|
|
|
|
|
|
} |
227
|
0
|
|
|
|
|
0
|
return $self; |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
# aliases for singleton methods |
231
|
|
|
|
|
|
|
sub fatal { |
232
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
233
|
0
|
|
|
|
|
0
|
$TRACEBACK++; |
234
|
0
|
|
|
|
|
0
|
FATAL shift; |
235
|
0
|
|
|
|
|
0
|
$TRACEBACK--; |
236
|
|
|
|
|
|
|
} |
237
|
|
|
|
|
|
|
sub error { |
238
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
239
|
0
|
|
|
|
|
0
|
$TRACEBACK++; |
240
|
0
|
|
|
|
|
0
|
ERROR shift; |
241
|
0
|
|
|
|
|
0
|
$TRACEBACK--; |
242
|
|
|
|
|
|
|
} |
243
|
|
|
|
|
|
|
sub warn { |
244
|
4
|
|
|
4
|
1
|
9
|
my $self = shift; |
245
|
4
|
|
|
|
|
6
|
$TRACEBACK++; |
246
|
4
|
|
|
|
|
12
|
WARN shift; |
247
|
4
|
|
|
|
|
38
|
$TRACEBACK--; |
248
|
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
|
sub info { |
250
|
64109
|
|
|
64109
|
1
|
87304
|
my $self = shift; |
251
|
64109
|
|
|
|
|
73763
|
$TRACEBACK++; |
252
|
64109
|
|
|
|
|
114772
|
INFO shift; |
253
|
64109
|
|
|
|
|
94344
|
$TRACEBACK--; |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
sub debug { |
256
|
182113
|
|
|
182113
|
1
|
236640
|
my $self = shift; |
257
|
182113
|
|
|
|
|
206093
|
$TRACEBACK++; |
258
|
182113
|
|
|
|
|
312708
|
DEBUG shift; |
259
|
182113
|
|
|
|
|
277721
|
$TRACEBACK--; |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
# empty destructor so we don't go up inheritance tree at the end |
263
|
|
|
|
0
|
|
|
sub DESTROY {} |
264
|
|
|
|
|
|
|
} |
265
|
|
|
|
|
|
|
1; |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
=head1 NAME |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
Bio::Phylo::Util::Logger - Logger of internal messages of several severity |
270
|
|
|
|
|
|
|
levels |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
=head1 SYNOPSIS |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
use strict; |
275
|
|
|
|
|
|
|
use Bio::Phylo::Util::Logger ':levels'; # import level constants |
276
|
|
|
|
|
|
|
use Bio::Phylo::IO 'parse'; |
277
|
|
|
|
|
|
|
use Bio::Phylo::Factory; |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
# Set the verbosity level of the tree class. |
280
|
|
|
|
|
|
|
# "DEBUG" is the most verbose level. All log messages |
281
|
|
|
|
|
|
|
# emanating from the tree class will be |
282
|
|
|
|
|
|
|
# transmitted. For this to work the level constants |
283
|
|
|
|
|
|
|
# have to have been imported! |
284
|
|
|
|
|
|
|
use Bio::Phylo::Forest::Tree 'verbose' => DEBUG; # note: DEBUG is not quoted! |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
# Create a file handle for logger to write to. |
287
|
|
|
|
|
|
|
# This is not necessary, by default the logger |
288
|
|
|
|
|
|
|
# writes to STDERR, but sometimes you will want |
289
|
|
|
|
|
|
|
# to write to a file, as per this example. |
290
|
|
|
|
|
|
|
open my $fh, '>', 'parsing.log' or die $!; |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
# Create a logger object. |
293
|
|
|
|
|
|
|
my $fac = Bio::Phylo::Factory->new; |
294
|
|
|
|
|
|
|
my $logger = $fac->create_logger; |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
# Set the verbosity level of the set_name |
297
|
|
|
|
|
|
|
# method in the base class. Messages coming |
298
|
|
|
|
|
|
|
# from this method will be transmitted. |
299
|
|
|
|
|
|
|
$logger->VERBOSE( |
300
|
|
|
|
|
|
|
'-level' => DEBUG, # note, not quoted, this is a constant! |
301
|
|
|
|
|
|
|
'-method' => 'Bio::Phylo::set_name', # quoted, otherwise bareword error! |
302
|
|
|
|
|
|
|
); |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
# 'Listeners' are subroutine references that |
305
|
|
|
|
|
|
|
# are executed when a message is transmitted. |
306
|
|
|
|
|
|
|
# The first argument passed to these subroutines |
307
|
|
|
|
|
|
|
# is the log message. This particular listener |
308
|
|
|
|
|
|
|
# will write the message to the 'parsing.log' |
309
|
|
|
|
|
|
|
# file, if the $fh file handle is still open. |
310
|
|
|
|
|
|
|
$logger->set_listeners( |
311
|
|
|
|
|
|
|
sub { |
312
|
|
|
|
|
|
|
my ($msg) = @_; |
313
|
|
|
|
|
|
|
if ( $fh->opened ) { |
314
|
|
|
|
|
|
|
print $fh $msg; |
315
|
|
|
|
|
|
|
} |
316
|
|
|
|
|
|
|
} |
317
|
|
|
|
|
|
|
); |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
# Now parse a tree, and see what is logged. |
320
|
|
|
|
|
|
|
my $tree = parse( |
321
|
|
|
|
|
|
|
'-format' => 'newick', |
322
|
|
|
|
|
|
|
'-string' => do { local $/; <DATA> }, |
323
|
|
|
|
|
|
|
)->first; |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
# Cleanly close the log handle. |
326
|
|
|
|
|
|
|
close $fh; |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
__DATA__ |
329
|
|
|
|
|
|
|
((((A,B),C),D),E); |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
The example above will write something like the following to the log file: |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
INFO Bio::Phylo::Forest::Tree::new [Bio/Phylo/Forest/Tree.pm, 99] - constructor called for 'Bio::Phylo::Forest::Tree' |
334
|
|
|
|
|
|
|
INFO Bio::Phylo::set_name [Bio/Phylo.pm, 281] - setting name 'A' |
335
|
|
|
|
|
|
|
INFO Bio::Phylo::set_name [Bio/Phylo.pm, 281] - setting name 'B' |
336
|
|
|
|
|
|
|
INFO Bio::Phylo::set_name [Bio/Phylo.pm, 281] - setting name 'C' |
337
|
|
|
|
|
|
|
INFO Bio::Phylo::set_name [Bio/Phylo.pm, 281] - setting name 'D' |
338
|
|
|
|
|
|
|
INFO Bio::Phylo::set_name [Bio/Phylo.pm, 281] - setting name 'E' |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
=head1 DESCRIPTION |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
This class defines a logger, a utility object for logging messages. |
343
|
|
|
|
|
|
|
The other objects in Bio::Phylo use this logger to give detailed feedback |
344
|
|
|
|
|
|
|
about what they are doing at per-class, per-method, user-configurable log levels |
345
|
|
|
|
|
|
|
(DEBUG, INFO, WARN, ERROR and FATAL). These log levels are constants that are |
346
|
|
|
|
|
|
|
optionally exported by this class by passing the ':levels' argument to your |
347
|
|
|
|
|
|
|
'use' statement, like so: |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
use Bio::Phylo::Util::Logger ':levels'; |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
If for some reason you don't want this behaviour (i.e. because there is |
352
|
|
|
|
|
|
|
something else by these same names in your namespace) you must use the fully |
353
|
|
|
|
|
|
|
qualified names for these levels, i.e. Bio::Phylo::Util::Logger::DEBUG and |
354
|
|
|
|
|
|
|
so on. |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
The least verbose is level FATAL, in which case only 'fatal' messages are shown. |
357
|
|
|
|
|
|
|
The most verbose level, DEBUG, shows debugging messages, including from internal |
358
|
|
|
|
|
|
|
methods (i.e. ones that start with underscores, and special 'ALLCAPS' perl |
359
|
|
|
|
|
|
|
methods like DESTROY or TIEARRAY). For example, to monitor what the root class |
360
|
|
|
|
|
|
|
is doing, you would say: |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
$logger->( -class => 'Bio::Phylo', -level => DEBUG ) |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
To define global verbosity you can omit the -class argument. To set verbosity |
365
|
|
|
|
|
|
|
at a more granular level, you can use the -method argument, which takes a |
366
|
|
|
|
|
|
|
fully qualified method name such as 'Bio::Phylo::set_name', such that messages |
367
|
|
|
|
|
|
|
originating from within that method's body get a different verbosity level. |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
=head1 METHODS |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
=head2 CONSTRUCTOR |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
=over |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
=item new() |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
Constructor for Logger. |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
Type : Constructor |
380
|
|
|
|
|
|
|
Title : new |
381
|
|
|
|
|
|
|
Usage : my $logger = Bio::Phylo::Util::Logger->new; |
382
|
|
|
|
|
|
|
Function: Instantiates a logger |
383
|
|
|
|
|
|
|
Returns : a Bio::Phylo::Util::Logger object |
384
|
|
|
|
|
|
|
Args : -level => Bio::Phylo::Util::Logger::INFO (DEBUG/INFO/WARN/ERROR/FATAL) |
385
|
|
|
|
|
|
|
-class => a package (or array ref) for which to set verbosity (optional) |
386
|
|
|
|
|
|
|
-method => a sub name (or array ref) for which to set verbosity (optional) |
387
|
|
|
|
|
|
|
-file => a file to which to append logging messages |
388
|
|
|
|
|
|
|
-listeners => array ref of subs that handle logging messages |
389
|
|
|
|
|
|
|
-prefix => a path fragment to strip from the paths in logging messages |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
=back |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
=head2 VERBOSITY LEVELS |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
=over |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
=item FATAL |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
Rarely happens, usually an exception is thrown instead. |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
=item ERROR |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
If this happens, something is seriously wrong that needs to be addressed. |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
=item WARN |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
If this happens, something is seriously wrong that needs to be addressed. |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
=item INFO |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
If something weird is happening, turn up verbosity to this level as it might |
413
|
|
|
|
|
|
|
explain some of the assumptions the code is making. |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
=item DEBUG |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
This is very verbose, probably only useful if you write core Bio::Phylo code. |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
=back |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
=head2 LOGGING METHODS |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
=over |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
=item debug() |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
Prints argument debugging message, depending on verbosity. |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
Type : logging method |
430
|
|
|
|
|
|
|
Title : debug |
431
|
|
|
|
|
|
|
Usage : $logger->debug( "debugging message" ); |
432
|
|
|
|
|
|
|
Function: prints debugging message, depending on verbosity |
433
|
|
|
|
|
|
|
Returns : invocant |
434
|
|
|
|
|
|
|
Args : logging message |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
=item info() |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
Prints argument informational message, depending on verbosity. |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
Type : logging method |
441
|
|
|
|
|
|
|
Title : info |
442
|
|
|
|
|
|
|
Usage : $logger->info( "info message" ); |
443
|
|
|
|
|
|
|
Function: prints info message, depending on verbosity |
444
|
|
|
|
|
|
|
Returns : invocant |
445
|
|
|
|
|
|
|
Args : logging message |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
=item warn() |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
Prints argument warning message, depending on verbosity. |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
Type : logging method |
452
|
|
|
|
|
|
|
Title : warn |
453
|
|
|
|
|
|
|
Usage : $logger->warn( "warning message" ); |
454
|
|
|
|
|
|
|
Function: prints warning message, depending on verbosity |
455
|
|
|
|
|
|
|
Returns : invocant |
456
|
|
|
|
|
|
|
Args : logging message |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
=item error() |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
Prints argument error message, depending on verbosity. |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
Type : logging method |
463
|
|
|
|
|
|
|
Title : error |
464
|
|
|
|
|
|
|
Usage : $logger->error( "error message" ); |
465
|
|
|
|
|
|
|
Function: prints error message, depending on verbosity |
466
|
|
|
|
|
|
|
Returns : invocant |
467
|
|
|
|
|
|
|
Args : logging message |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
=item fatal() |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
Prints argument fatal message, depending on verbosity. |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
Type : logging method |
474
|
|
|
|
|
|
|
Title : fatal |
475
|
|
|
|
|
|
|
Usage : $logger->fatal( "fatal message" ); |
476
|
|
|
|
|
|
|
Function: prints fatal message, depending on verbosity |
477
|
|
|
|
|
|
|
Returns : invocant |
478
|
|
|
|
|
|
|
Args : logging message |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
=item set_listeners() |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
Adds listeners to send log messages to. |
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
Type : Mutator |
485
|
|
|
|
|
|
|
Title : set_listeners() |
486
|
|
|
|
|
|
|
Usage : $logger->set_listeners( sub { warn shift } ) |
487
|
|
|
|
|
|
|
Function: Sets additional listeners to log to (e.g. a file) |
488
|
|
|
|
|
|
|
Returns : invocant |
489
|
|
|
|
|
|
|
Args : One or more code references |
490
|
|
|
|
|
|
|
Comments: On execution of the listeners, the @_ arguments are: |
491
|
|
|
|
|
|
|
$log_string, # the formatted log string |
492
|
|
|
|
|
|
|
$level, # log level, i.e DEBUG, INFO, WARN, ERROR or FATAL |
493
|
|
|
|
|
|
|
$subroutine, # the calling subroutine |
494
|
|
|
|
|
|
|
$filename, # filename where log method was called |
495
|
|
|
|
|
|
|
$line, # line where log method was called |
496
|
|
|
|
|
|
|
$msg # the unformatted message |
497
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
=item start_color() |
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
Changes color of output stream to that of specified logging level. This so that for |
501
|
|
|
|
|
|
|
example all errors are automatically marked up as 'FATAL', or all output generated |
502
|
|
|
|
|
|
|
by an external program is marked up as 'DEBUG' |
503
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
Type : Mutator |
505
|
|
|
|
|
|
|
Title : start_color() |
506
|
|
|
|
|
|
|
Usage : $logger->start_color( 'DEBUG', \*STDOUT ) |
507
|
|
|
|
|
|
|
Function: Changes color of output stream |
508
|
|
|
|
|
|
|
Returns : color name |
509
|
|
|
|
|
|
|
Args : Log level whose color to use, |
510
|
|
|
|
|
|
|
(optional) which stream to change, default is STDERR |
511
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
=item stop_color() |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
Resets the color initiated by start_color() |
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
Type : Mutator |
517
|
|
|
|
|
|
|
Title : stop_color() |
518
|
|
|
|
|
|
|
Usage : $logger->stop_color( \*STDOUT ) |
519
|
|
|
|
|
|
|
Function: Changes color of output stream |
520
|
|
|
|
|
|
|
Returns : color name |
521
|
|
|
|
|
|
|
Args : (Optional) which stream to reset, default is STDERR |
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
=item PREFIX() |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
Getter and setter of path prefix to strip from source file paths in messages. |
527
|
|
|
|
|
|
|
By default, messages will have a field such as C<[$PREFIX/Bio/Phylo.pm, 280]>, |
528
|
|
|
|
|
|
|
which indicates the message was sent from line 280 in file Bio/Phylo.pm inside |
529
|
|
|
|
|
|
|
path $PREFIX. This is done so that your log won't be cluttered with |
530
|
|
|
|
|
|
|
unnecessarily long paths. To find out what C<$PREFIX> is set to, call the |
531
|
|
|
|
|
|
|
PREFIX() method on the logger, and to change it provide a path argument |
532
|
|
|
|
|
|
|
relative to which the paths to source files will be constructed. |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
Type : Mutator/Accessor |
535
|
|
|
|
|
|
|
Title : PREFIX() |
536
|
|
|
|
|
|
|
Usage : $logger->PREFIX( '/path/to/bio/phylo' ) |
537
|
|
|
|
|
|
|
Function: Sets/gets $PREFIX |
538
|
|
|
|
|
|
|
Returns : Verbose level |
539
|
|
|
|
|
|
|
Args : Optional: a path |
540
|
|
|
|
|
|
|
Comments: |
541
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
=item VERBOSE() |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
Setter for the verbose level. This comes in five levels: |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
FATAL = only fatal messages (though, when something fatal happens, you'll most |
547
|
|
|
|
|
|
|
likely get an exception object), |
548
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
ERROR = errors (hopefully recoverable), |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
WARN = warnings (recoverable), |
552
|
|
|
|
|
|
|
|
553
|
|
|
|
|
|
|
INFO = info (useful diagnostics), |
554
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
DEBUG = debug (almost every method call) |
556
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
Without additional arguments, i.e. by just calling VERBOSE( -level => $level ), |
558
|
|
|
|
|
|
|
you set the global verbosity level. By default this is 2. By increasing this |
559
|
|
|
|
|
|
|
level, the number of messages quickly becomes too great to make sense out of. |
560
|
|
|
|
|
|
|
To focus on a particular class, you can add the -class => 'Some::Class' |
561
|
|
|
|
|
|
|
(where 'Some::Class' stands for any of the class names in the Bio::Phylo |
562
|
|
|
|
|
|
|
release) argument, which means that messages originating from that class will |
563
|
|
|
|
|
|
|
have a different (presumably higher) verbosity level than the global level. |
564
|
|
|
|
|
|
|
By adding the -method => 'Fully::Qualified::method_name' (say, |
565
|
|
|
|
|
|
|
'Bio::Phylo::set_name'), you can change the verbosity of a specific method. When |
566
|
|
|
|
|
|
|
evaluating whether or not to transmit a message, the method-specific verbosity |
567
|
|
|
|
|
|
|
level takes precedence over the class-specific level, which takes precedence |
568
|
|
|
|
|
|
|
over the global level. |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
Type : Mutator |
571
|
|
|
|
|
|
|
Title : VERBOSE() |
572
|
|
|
|
|
|
|
Usage : $logger->VERBOSE( -level => $level ) |
573
|
|
|
|
|
|
|
Function: Sets/gets verbose level |
574
|
|
|
|
|
|
|
Returns : Verbose level |
575
|
|
|
|
|
|
|
Args : -level => 4 # or lower |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
# optional, or any other class |
578
|
|
|
|
|
|
|
-class => 'Bio::Phylo' |
579
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
# optional, fully qualified method name |
581
|
|
|
|
|
|
|
-method' => 'Bio::Phylo::set_name' |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
=back |
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
=head1 SEE ALSO |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
There is a mailing list at L<https://groups.google.com/forum/#!forum/bio-phylo> |
588
|
|
|
|
|
|
|
for any user or developer questions and discussions. |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
Also see the manual: L<Bio::Phylo::Manual> and L<http://rutgervos.blogspot.com>. |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
=head1 CITATION |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
If you use Bio::Phylo in published research, please cite it: |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
B<Rutger A Vos>, B<Jason Caravas>, B<Klaas Hartmann>, B<Mark A Jensen> |
597
|
|
|
|
|
|
|
and B<Chase Miller>, 2011. Bio::Phylo - phyloinformatic analysis using Perl. |
598
|
|
|
|
|
|
|
I<BMC Bioinformatics> B<12>:63. |
599
|
|
|
|
|
|
|
L<http://dx.doi.org/10.1186/1471-2105-12-63> |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
=cut |