line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
############################################################################# |
2
|
|
|
|
|
|
|
################# Easy Debugging Module ###################### |
3
|
|
|
|
|
|
|
################# Copyright 2013 - 2021 Richard Kelsch ###################### |
4
|
|
|
|
|
|
|
################# All Rights Reserved ###################### |
5
|
|
|
|
|
|
|
############################################################################# |
6
|
|
|
|
|
|
|
####### Licensing information available near the end of this file. ########## |
7
|
|
|
|
|
|
|
############################################################################# |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
package Debug::Easy; |
10
|
|
|
|
|
|
|
|
11
|
4
|
|
|
4
|
|
422269
|
use strict; |
|
4
|
|
|
|
|
39
|
|
|
4
|
|
|
|
|
165
|
|
12
|
|
|
|
|
|
|
use constant { |
13
|
4
|
|
|
|
|
339
|
TRUE => 1, |
14
|
|
|
|
|
|
|
FALSE => 0 |
15
|
4
|
|
|
4
|
|
24
|
}; |
|
4
|
|
|
|
|
8
|
|
16
|
|
|
|
|
|
|
|
17
|
4
|
|
|
4
|
|
3810
|
use DateTime; |
|
4
|
|
|
|
|
2076879
|
|
|
4
|
|
|
|
|
236
|
|
18
|
4
|
|
|
4
|
|
3308
|
use Term::ANSIColor; |
|
4
|
|
|
|
|
42266
|
|
|
4
|
|
|
|
|
440
|
|
19
|
4
|
|
|
4
|
|
2737
|
use Time::HiRes qw(time); |
|
4
|
|
|
|
|
6219
|
|
|
4
|
|
|
|
|
18
|
|
20
|
4
|
|
|
4
|
|
805
|
use File::Basename; |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
266
|
|
21
|
|
|
|
|
|
|
|
22
|
4
|
|
|
4
|
|
2843
|
use Data::Dumper; $Data::Dumper::Sortkeys = TRUE; $Data::Dumper::Purity = TRUE; $Data::Dumper::Deparse = TRUE; |
|
4
|
|
|
|
|
28728
|
|
|
4
|
|
|
|
|
377
|
|
23
|
|
|
|
|
|
|
|
24
|
4
|
|
|
4
|
|
35
|
use Config; |
|
4
|
|
|
|
|
14
|
|
|
4
|
|
|
|
|
373
|
|
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
BEGIN { |
28
|
4
|
|
|
4
|
|
25
|
require Exporter; |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
# set the version for version checking |
31
|
4
|
|
|
|
|
10
|
our $VERSION = '2.05'; |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
# Inherit from Exporter to export functions and variables |
34
|
4
|
|
|
|
|
80
|
our @ISA = qw(Exporter); |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
# Functions and variables which are exported by default |
37
|
4
|
|
|
|
|
21
|
our @EXPORT = qw(); |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
# Functions and variables which can be optionally exported |
40
|
4
|
|
|
|
|
11312
|
our @EXPORT_OK = qw(@Levels); |
41
|
|
|
|
|
|
|
} ## end BEGIN |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
# This can be optionally exported for whatever |
44
|
|
|
|
|
|
|
our @Levels = qw( ERR WARN NOTICE INFO VERBOSE DEBUG DEBUGMAX ); |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
# For quick level checks to speed up execution |
47
|
|
|
|
|
|
|
our %LevelLogic; |
48
|
|
|
|
|
|
|
for (my $count = 0 ; $count < scalar(@Levels) ; $count++) { |
49
|
|
|
|
|
|
|
$LevelLogic{$Levels[$count]} = $count; |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
our $PARENT = $$; # This needs to be defined at the very beginning before new |
53
|
|
|
|
|
|
|
my ($SCRIPTNAME, $SCRIPTPATH, $suffix) = fileparse($0); |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
=head1 NAME |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
Debug::Easy - A Handy Debugging Module With Colorized Output and Formatting |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
=head1 SYNOPSIS |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
use Debug::Easy; |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
my $debug = Debug::Easy->new( 'LogLevel' => 'DEBUG', 'Color' => 1 ); |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
'LogLevel' is the maximum level to report, and ignore the rest. The method names correspond to their loglevels, when outputting a specific message. This identifies to the module what type of message it is. |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
The following is a list, in order of level, of the logging methods: |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
ERR = Error |
70
|
|
|
|
|
|
|
WARN = Warning |
71
|
|
|
|
|
|
|
NOTICE = Notice |
72
|
|
|
|
|
|
|
INFO = Information |
73
|
|
|
|
|
|
|
VERBOSE = Special version of INFO that does not output any |
74
|
|
|
|
|
|
|
Logging headings. Very useful for verbose modes in your |
75
|
|
|
|
|
|
|
scripts. |
76
|
|
|
|
|
|
|
DEBUG = Level 1 Debugging messages |
77
|
|
|
|
|
|
|
DEBUGMAX = Level 2 Debugging messages (typically more terse) |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
The parameter is either a string or a reference to an array of strings to output as multiple lines. |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
Each string can contain newlines, which will also be split into a separate line and formatted accordingly. |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
$debug->ERR( ['Error message']); |
84
|
|
|
|
|
|
|
$debug->ERROR( ['Error message']); |
85
|
|
|
|
|
|
|
$debug->WARN( ['Warning message']); |
86
|
|
|
|
|
|
|
$debug->WARNING( ['Warning message']); |
87
|
|
|
|
|
|
|
$debug->NOTICE( ['Notice message']); |
88
|
|
|
|
|
|
|
$debug->INFO( ['Information and VERBOSE mode message']); |
89
|
|
|
|
|
|
|
$debug->INFORMATION(['Information and VERBOSE mode message']); |
90
|
|
|
|
|
|
|
$debug->DEBUG( ['Level 1 Debug message']); |
91
|
|
|
|
|
|
|
$debug->DEBUGMAX( ['Level 2 (terse) Debug message']); |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
my @messages = ( |
94
|
|
|
|
|
|
|
'First Message', |
95
|
|
|
|
|
|
|
'Second Message', |
96
|
|
|
|
|
|
|
"Third Message First Line\nThird Message Second Line", |
97
|
|
|
|
|
|
|
\%hash_reference |
98
|
|
|
|
|
|
|
); |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
$debug->INFO(\@messages); |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
=head1 DESCRIPTION |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
This module makes it easy to add debugging features to your code, Without having to re-invent the wheel. It uses STDERR and ANSI color formatted text output, as well as indented and multiline text formatting, to make things easy to read. NOTE: It is generally defaulted to output in a format for viewing on wide terminals! |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
Benchmarking is automatic, to make it easy to spot bottlenecks in code. It automatically stamps from where it was called, and makes debug coding so much easier, without having to include the location of the debugging location in your debug message. This is all taken care of for you. |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
It also allows multiple output levels from errors only, to warnings, to notices, to verbose information, to full on debug output. All of this fully controllable by the coder. |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
Generally all you need are the defaults and you are ready to go. |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
=head1 B<EXPORTABLE VARIABLES> |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
=head2 B<@Levels> |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
A simple list of all the acceptable debug levels to pass as "LogLevel" in the {new} method. Not normally needed for coding, more for reference. Only exported if requested. |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
=cut |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
sub DESTROY { # We spit out one last message before we die, the total execute time. |
121
|
13
|
|
|
13
|
|
8210
|
my $self = shift; |
122
|
13
|
|
|
|
|
216
|
my $bench = colored(['bright_cyan'], sprintf('%06s', sprintf('%.02f', (time - $self->{'MASTERSTART'})))); |
123
|
13
|
|
|
|
|
619
|
my $name = $SCRIPTNAME; |
124
|
13
|
50
|
|
|
|
89
|
$name .= ' [child]' if ($PARENT ne $$); |
125
|
13
|
|
|
|
|
113
|
$self->DEBUG([$bench . ' ' . colored(['black on_white'],"---- $name complete ----")]); |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
=head1 B<METHODS> |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
=head2 B<new> |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
* The parameter names are case insensitive as of Version 0.04. |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=over 4 |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
=item B<LogLevel> [level] |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
This adjusts the global log level of the Debug object. It requires a string. |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
=back |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
=over 8 |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
B<ERR> (default) |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
This level shows only error messages and all other messages are not shown. |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
B<WARN> |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
This level shows error and warning messages. All other messages are not shown. |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
B<NOTICE> |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
This level shows error, warning, and notice messages. All other messages are not shown. |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
B<INFO> |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
This level shows error, warning, notice, and information messages. Only debug level messages are not shown. |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
B<VERBOSE> |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
This level can be used as a way to do "Verbose" output for your scripts. It ouputs INFO level messages without logging headers and on STDOUT instead of STDERR. |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
B<DEBUG> |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
This level shows error, warning, notice, information, and level 1 debugging messages. Level 2 Debug messages are not shown. |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
B<DEBUGMAX> |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
This level shows all messages up to level 2 debugging messages. |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
NOTE: It has been asked "Why have two debugging levels?" Well, I have had many times where I would like to see what a script is doing without it showing what I consider garbage overhead it may generate. This is simply because the part of the code you are debugging you may not need such a high level of detail. I use 'DEBUGMAX' to show me absolutely everything. Such as Data::Dumper output. Besides, anyone asking that question obviously hasn't dealt with complex data conversion scripts. |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
=back |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
=over 4 |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=item B<Color> [boolean] (Not case sensitive) |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
B<0>, B<Off>, or B<False> (Off) |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
This turns off colored output. Everything is plain text only. |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
B<1>, B<On>, or B<True> (On - Default) |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
This turns on colored output. This makes it easier to spot all of the different types of messages throughout a sea of debug output. You can read the output with Less, and see color, by using it's switch "-r". |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
=back |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
=over 4 |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
=item B<Prefix> [pattern] |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
This is global |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
A string that is parsed into the output prefix. |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
DEFAULT: '%Date% %Time% %Benchmark% %Loglevel%[%Subroutine%][%Lastline%] ' |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
%Date% = Date (Uses format of "DateStamp" below) |
201
|
|
|
|
|
|
|
%Time% = Time (Uses format of "TimeStamp" below) |
202
|
|
|
|
|
|
|
%Epoch% = Epoch (Unix epoch) |
203
|
|
|
|
|
|
|
%Benchmark% = Benchmark - The time it took between the last benchmark display |
204
|
|
|
|
|
|
|
of this loglevel. If in an INFO level message, it benchmarks |
205
|
|
|
|
|
|
|
the time until the next INFO level message. The same rule is |
206
|
|
|
|
|
|
|
true for all loglevels. |
207
|
|
|
|
|
|
|
%Loglevel% = Log Level |
208
|
|
|
|
|
|
|
%Lines% = Line Numbers of all nested calls |
209
|
|
|
|
|
|
|
%Module% = Module and subroutine of call (can be a lot of stuff!) |
210
|
|
|
|
|
|
|
%Subroutine% = Just the last subroutine |
211
|
|
|
|
|
|
|
%Lastline% = Just the last line number |
212
|
|
|
|
|
|
|
%PID% = Process ID |
213
|
|
|
|
|
|
|
%date% = Just Date (typically used internally only, use %Date%) |
214
|
|
|
|
|
|
|
%time% = Just time (typically used internally only, use %Time%) |
215
|
|
|
|
|
|
|
%epoch% = Unix epoch (typically used internally only, use %Epoch%) |
216
|
|
|
|
|
|
|
%Filename% = Script Filename (parsed $0) |
217
|
|
|
|
|
|
|
%Fork% = Running in parent or child? |
218
|
|
|
|
|
|
|
P = Parent |
219
|
|
|
|
|
|
|
C = Child |
220
|
|
|
|
|
|
|
%Thread% = Running in Parent or Thread |
221
|
|
|
|
|
|
|
P = Parent |
222
|
|
|
|
|
|
|
T## = Thread # = Thread ID |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
=item B<[loglevel]-Prefix> [pattern] |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
You can define a prefix for a specific log level. |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
ERR-Prefix |
229
|
|
|
|
|
|
|
WARN-Prefix |
230
|
|
|
|
|
|
|
NOTICE-Prefix |
231
|
|
|
|
|
|
|
INFO-Prefix |
232
|
|
|
|
|
|
|
DEBUG-Prefix |
233
|
|
|
|
|
|
|
DEBUGMAX-Prefix |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
If one of these are not defined, then the global value is used. |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
=item B<TimeStamp> [pattern] |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
(See Log::Fast for specifics on these) |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
I suggest you just use Prefix above, but here it is anyway. |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
Make this an empty string to turn it off, otherwise: |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
=back |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
=over 8 |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
B<%T> |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
Formats the timestamp as HH:MM:SS. This is the default for the timestamp. |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
B<%S> |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
Formats the timestamp as seconds.milliseconds. Normally not needed, as the benchmark is more helpful. |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
B<%T %S> |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
Combines both of the above. Normally this is just too much, but here if you really want it. |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
=back |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
=over 4 |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
=item B<DateStamp> [pattern] |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
I suggest you just use Prefix above, but here it is anyway. |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
Make this an empty string to turn it off, otherwise: |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
=back |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
=over 8 |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
B<%D> |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
Formats the datestamp as YYYY-MM-DD. It is the default, and the only option. |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
=back |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
=over 4 |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
=item B<FileHandle> |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
File handle to write log messages. |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
=item B<ANSILevel> |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
Contains a hash reference describing the various colored debug level labels |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
The default definition (using Term::ANSIColor) is as follows: |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
=back |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
=over 8 |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
'ANSILevel' => { |
298
|
|
|
|
|
|
|
'ERR' => colored(['white on_red'], '[ ERROR ]'), |
299
|
|
|
|
|
|
|
'WARN' => colored(['black on_yellow'], '[WARNING]'), |
300
|
|
|
|
|
|
|
'NOTICE' => colored(['yellow'], '[NOTICE ]'), |
301
|
|
|
|
|
|
|
'INFO' => colored(['black on_white'], '[ INFO ]'), |
302
|
|
|
|
|
|
|
'DEBUG' => colored(['bold green'], '[ DEBUG ]'), |
303
|
|
|
|
|
|
|
'DEBUGMAX' => colored(['bold black on_green'], '[DEBUGMX]'), |
304
|
|
|
|
|
|
|
} |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
=back |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
=cut |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
sub new { |
311
|
|
|
|
|
|
|
# This module uses the Log::Fast library heavily. Many of the |
312
|
|
|
|
|
|
|
# Log::Fast variables and features can work here. See the perldocs |
313
|
|
|
|
|
|
|
# for Log::Fast for specifics. |
314
|
13
|
|
|
13
|
1
|
3147
|
my $class = shift; |
315
|
13
|
|
|
|
|
514
|
my ($filename, $dir, $suffix) = fileparse($0); |
316
|
13
|
|
|
|
|
181
|
my $self = { |
317
|
|
|
|
|
|
|
'LogLevel' => 'ERR', # Default is errors only |
318
|
|
|
|
|
|
|
'Type' => 'fh', # Default is a filehandle |
319
|
|
|
|
|
|
|
'Path' => '/var/log', # Default path should type be unix |
320
|
|
|
|
|
|
|
'FileHandle' => \*STDERR, # Default filehandle is STDERR |
321
|
|
|
|
|
|
|
'MasterStart' => time, |
322
|
|
|
|
|
|
|
'ANY_LastStamp' => time, # Initialize main benchmark |
323
|
|
|
|
|
|
|
'ERR_LastStamp' => time, # Initialize the ERR benchmark |
324
|
|
|
|
|
|
|
'WARN_LastStamp' => time, # Initialize the WARN benchmark |
325
|
|
|
|
|
|
|
'INFO_LastStamp' => time, # Initialize the INFO benchmark |
326
|
|
|
|
|
|
|
'NOTICE_LastStamp' => time, # Initialize the NOTICE benchmark |
327
|
|
|
|
|
|
|
'DEBUG_LastStamp' => time, # Initialize the DEBUG benchmark |
328
|
|
|
|
|
|
|
'DEBUGMAX_LastStamp' => time, # Initialize the DEBUGMAX benchmark |
329
|
|
|
|
|
|
|
'Color' => TRUE, # Default to colorized output |
330
|
|
|
|
|
|
|
'DateStamp' => colored(['yellow'], '%date%'), |
331
|
|
|
|
|
|
|
'TimeStamp' => colored(['yellow'], '%time%'), |
332
|
|
|
|
|
|
|
'Epoch' => colored(['cyan'], '%epoch%'), |
333
|
|
|
|
|
|
|
'Padding' => -20, # Default padding is 20 spaces |
334
|
|
|
|
|
|
|
'Lines-Padding' => -2, |
335
|
|
|
|
|
|
|
'Subroutine-Padding' => 0, |
336
|
|
|
|
|
|
|
'Line-Padding' => 0, |
337
|
|
|
|
|
|
|
'PARENT' => $$, |
338
|
|
|
|
|
|
|
'Prefix' => '%Date% %Time% %Benchmark% %Loglevel%[%Subroutine%][%Lastline%] ', |
339
|
|
|
|
|
|
|
'DEBUGMAX-Prefix' => '%Date% %Time% %Benchmark% %Loglevel%[%Module%][%Lines%] ', |
340
|
|
|
|
|
|
|
'Filename' => '[' . colored(['magenta'], $filename) . ']', |
341
|
|
|
|
|
|
|
'TIMEZONE' => DateTime::TimeZone->new(name => 'local'), |
342
|
|
|
|
|
|
|
'ANSILevel' => { |
343
|
|
|
|
|
|
|
'ERR' => colored(['white on_red'], '[ ERROR ]'), |
344
|
|
|
|
|
|
|
'WARN' => colored(['black on_yellow'], '[WARNING ]'), |
345
|
|
|
|
|
|
|
'NOTICE' => colored(['yellow'], '[ NOTICE ]'), |
346
|
|
|
|
|
|
|
'INFO' => colored(['black on_white'], '[ INFO ]'), |
347
|
|
|
|
|
|
|
'DEBUG' => colored(['bold green'], '[ DEBUG ]'), |
348
|
|
|
|
|
|
|
'DEBUGMAX' => colored(['bold black on_green'], '[DEBUGMAX]'), |
349
|
|
|
|
|
|
|
}, |
350
|
|
|
|
|
|
|
}; |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
# This pretty much makes all hash keys uppercase |
353
|
13
|
|
|
|
|
28114
|
my @Keys = (keys %{$self}); # Hash is redefined on the fly, so get the list before |
|
13
|
|
|
|
|
88
|
|
354
|
13
|
|
|
|
|
39
|
foreach my $Key (@Keys) { |
355
|
338
|
|
|
|
|
482
|
my $upper = uc($Key); |
356
|
338
|
100
|
|
|
|
622
|
if ($Key ne $upper) { |
|
|
50
|
|
|
|
|
|
357
|
312
|
|
|
|
|
588
|
$self->{$upper} = $self->{$Key}; |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
# This fixes a documentation error for past versions |
360
|
312
|
100
|
|
|
|
590
|
if ($upper eq 'LOGLEVEL') { |
361
|
13
|
50
|
|
|
|
40
|
$self->{$upper} = 'ERR' if ($self->{$upper} =~ /^ERROR$/i); |
362
|
13
|
|
|
|
|
35
|
$self->{$upper} = uc($self->{$upper}); # Make loglevels case insensitive |
363
|
|
|
|
|
|
|
} |
364
|
312
|
|
|
|
|
877
|
delete($self->{$Key}); |
365
|
|
|
|
|
|
|
} elsif ($Key eq 'LOGLEVEL') { # Make loglevels case insensitive |
366
|
0
|
|
|
|
|
0
|
$self->{$upper} = uc($self->{$upper}); |
367
|
|
|
|
|
|
|
} |
368
|
|
|
|
|
|
|
} ## end foreach my $Key (@Keys) |
369
|
|
|
|
|
|
|
{ # This makes sure the user overrides actually override |
370
|
13
|
|
|
|
|
26
|
my %params = (@_); |
|
13
|
|
|
|
|
58
|
|
371
|
13
|
|
|
|
|
45
|
foreach my $Key (keys %params) { |
372
|
39
|
|
|
|
|
104
|
$self->{uc($Key)} = $params{$Key}; |
373
|
|
|
|
|
|
|
} |
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
# This instructs the ANSIColor library to turn off coloring, |
377
|
|
|
|
|
|
|
# if the Color attribute is set to zero. |
378
|
13
|
50
|
|
|
|
96
|
if ($self->{'COLOR'} =~ /0|FALSE|OFF|NO/i) { |
379
|
0
|
|
|
|
|
0
|
$ENV{'ANSI_COLORS_DISABLED'} = TRUE; |
380
|
|
|
|
|
|
|
# If COLOR is FALSE, then clear color data from ANSILEVEL, as these were |
381
|
|
|
|
|
|
|
# defined before color was turned off. |
382
|
0
|
|
|
|
|
0
|
$self->{'ANSILEVEL'} = { |
383
|
|
|
|
|
|
|
'ERR' => '[ ERROR ]', |
384
|
|
|
|
|
|
|
'WARN' => '[WARNING ]', |
385
|
|
|
|
|
|
|
'NOTICE' => '[ NOTICE ]', |
386
|
|
|
|
|
|
|
'INFO' => '[ INFO ]', |
387
|
|
|
|
|
|
|
'DEBUG' => '[ DEBUG ]', |
388
|
|
|
|
|
|
|
'DEBUGMAX' => '[DEBUGMAX]', |
389
|
|
|
|
|
|
|
}; |
390
|
0
|
|
|
|
|
0
|
$self->{'DATESTAMP'} = '%date%'; |
391
|
0
|
|
|
|
|
0
|
$self->{'TIMESTAMP'} = '%time%'; |
392
|
0
|
|
|
|
|
0
|
$self->{'EPOCH'} = '%epoch%'; |
393
|
|
|
|
|
|
|
} |
394
|
|
|
|
|
|
|
|
395
|
13
|
|
|
|
|
41
|
foreach my $lvl (@Levels) { |
396
|
91
|
100
|
66
|
|
|
455
|
$self->{"$lvl-PREFIX"} = $self->{'PREFIX'} unless (exists($self->{"$lvl-PREFIX"}) && defined($self->{"$lvl-PREFIX"})); |
397
|
|
|
|
|
|
|
} |
398
|
|
|
|
|
|
|
|
399
|
13
|
|
|
|
|
31
|
my $fh = $self->{'FILEHANDLE'}; |
400
|
|
|
|
|
|
|
# Signal the script has started (and logger initialized) |
401
|
13
|
|
|
|
|
38
|
my $name = $SCRIPTNAME; |
402
|
13
|
50
|
|
|
|
54
|
$name .= ' [child]' if ($PARENT ne $$); |
403
|
13
|
|
|
|
|
97
|
print $fh sprintf(' %.02f%s %s', 0, $self->{'ANSILEVEL'}->{'DEBUG'}, colored(['black on_white'], "----- $name begin -----") . " (To View in 'less', use it's '-r' switch)" ),"\n"; |
404
|
|
|
|
|
|
|
|
405
|
13
|
|
|
|
|
777
|
bless($self, $class); |
406
|
13
|
|
|
|
|
93
|
return ($self); |
407
|
|
|
|
|
|
|
} ## end sub new |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
=head2 debug |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
NOTE: This is a legacy method for backwards compatibility. Please use the direct methods instead. |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
The parameters must be passed in the order given |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
=over 4 |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
=item B<LEVEL> |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
The log level with which this message is to be triggered |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
=item B<MESSAGE(S)> |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
A string or a reference to a list of strings to output line by line. |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
=back |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
=cut |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
sub debug { |
430
|
247
|
|
|
247
|
1
|
154490
|
my $self = shift; |
431
|
247
|
|
|
|
|
516
|
my $level = uc(shift); |
432
|
247
|
|
|
|
|
350
|
my $msgs = shift; |
433
|
|
|
|
|
|
|
|
434
|
247
|
100
|
|
|
|
1379
|
if ($level !~ /ERR.*|WARN.*|NOTICE|INFO.*|DEBUG/i) { # Compatibility with older versions. |
435
|
108
|
|
|
|
|
176
|
$level = uc($msgs); # It tosses the legacy __LINE__ argument |
436
|
108
|
|
|
|
|
216
|
$msgs = shift; |
437
|
|
|
|
|
|
|
} |
438
|
247
|
|
|
|
|
1060
|
$level =~ s/(OR|ING|RMATION)$//; # Strip off the excess |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
# A much quicker bypass when the log level is below what is needed |
441
|
247
|
100
|
|
|
|
1316
|
return if ($LevelLogic{$self->{'LOGLEVEL'}} < $LevelLogic{$level}); |
442
|
|
|
|
|
|
|
|
443
|
142
|
|
|
|
|
221
|
my @messages; |
444
|
142
|
100
|
66
|
|
|
723
|
if (ref($msgs) eq 'SCALAR' || ref($msgs) eq '') { |
|
|
50
|
|
|
|
|
|
445
|
92
|
|
|
|
|
207
|
push(@messages, $msgs); |
446
|
|
|
|
|
|
|
} elsif (ref($msgs) eq 'ARRAY') { |
447
|
50
|
|
|
|
|
74
|
@messages = @{$msgs}; |
|
50
|
|
|
|
|
140
|
|
448
|
|
|
|
|
|
|
} else { |
449
|
0
|
|
|
|
|
0
|
push(@messages,Dumper($msgs)); |
450
|
|
|
|
|
|
|
} ## end else [ if (ref($msgs) eq 'SCALAR'...)] |
451
|
142
|
|
|
|
|
409
|
my ($sname, $cline, $nested, $subroutine, $thisBench, $thisBench2, $sline, $short) = ('', '', '', '', '', '', '', ''); |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
# Figure out the proper caller tree and line number ladder |
454
|
|
|
|
|
|
|
# But only if it's part of the prefix, else don't waste time. |
455
|
142
|
50
|
|
|
|
899
|
if ($self->{'PREFIX'} =~ /\%(Subroutine|Module|Lines|Lastline)\%/) { # %P = Subroutine, %l = Line number(s) |
456
|
142
|
|
|
|
|
251
|
my $package = ''; |
457
|
142
|
|
|
|
|
184
|
my $count = 1; |
458
|
142
|
|
|
|
|
188
|
my $nest = 0; |
459
|
142
|
|
|
|
|
475
|
while (my @array = caller($count)) { |
460
|
12
|
100
|
|
|
|
63
|
if ($array[3] !~ /Debug::Easy/) { |
461
|
4
|
|
|
|
|
32
|
$package = $array[0]; |
462
|
4
|
|
|
|
|
9
|
my $subroutine = $array[3]; |
463
|
4
|
|
|
|
|
45
|
$subroutine =~ s/^$package\:\://; |
464
|
4
|
|
|
|
|
26
|
$sname =~ s/$subroutine//; |
465
|
4
|
50
|
|
|
|
18
|
if ($sname eq '') { |
466
|
4
|
50
|
|
|
|
14
|
$sname = ($subroutine ne '') ? $subroutine : $package; |
467
|
4
|
|
|
|
|
10
|
$cline = $array[2]; |
468
|
|
|
|
|
|
|
} else { |
469
|
0
|
|
|
|
|
0
|
$sname = $subroutine . '::' . $sname; |
470
|
0
|
|
|
|
|
0
|
$cline = $array[2] . '/' . $cline; |
471
|
|
|
|
|
|
|
} |
472
|
4
|
50
|
|
|
|
16
|
if ($count == 2) { |
473
|
0
|
|
|
|
|
0
|
$short = $array[3]; |
474
|
0
|
|
|
|
|
0
|
$sline = $array[2]; |
475
|
|
|
|
|
|
|
} |
476
|
4
|
|
|
|
|
9
|
$nest++; |
477
|
|
|
|
|
|
|
} ## end if ($array[3] !~ /Debug::Easy/) |
478
|
12
|
|
|
|
|
59
|
$count++; |
479
|
|
|
|
|
|
|
} ## end while (my @array = caller...) |
480
|
142
|
100
|
|
|
|
324
|
if ($package ne '') { |
481
|
4
|
|
|
|
|
12
|
$sname = $package . '::' . $sname; |
482
|
4
|
50
|
|
|
|
15
|
$nested = ' ' x $nest if ($nest); |
483
|
|
|
|
|
|
|
} else { |
484
|
138
|
|
|
|
|
240
|
my @array = caller(1); |
485
|
138
|
|
|
|
|
212
|
$cline = $array[2]; |
486
|
138
|
50
|
33
|
|
|
361
|
if (!defined($cline) || $cline eq '') { |
487
|
138
|
|
|
|
|
724
|
@array = caller(0); |
488
|
138
|
|
|
|
|
287
|
$cline = $array[2]; |
489
|
|
|
|
|
|
|
} |
490
|
138
|
|
|
|
|
207
|
$sname = 'main'; |
491
|
138
|
|
|
|
|
199
|
$sline = $cline; |
492
|
138
|
|
|
|
|
297
|
$short = $sname; |
493
|
|
|
|
|
|
|
} ## end else [ if ($package ne '') ] |
494
|
142
|
50
|
|
|
|
312
|
$subroutine = ($sname ne '') ? $sname : 'main'; |
495
|
142
|
50
|
|
|
|
383
|
$self->{'PADDING'} = 0 - length($subroutine) if (length($subroutine) > abs($self->{'PADDING'})); |
496
|
142
|
50
|
|
|
|
331
|
$self->{'LINES-PADDING'} = 0 - length($cline) if (length($cline) > abs($self->{'LINES-PADDING'})); |
497
|
142
|
100
|
|
|
|
301
|
$self->{'SUBROUTINE-PADDING'} = 0 - length($short) if (length($short) > abs($self->{'SUBROUTINE-PADDING'})); |
498
|
142
|
100
|
|
|
|
313
|
$self->{'LINE-PADDING'} = 0 - length($sline) if (length($sline) > abs($self->{'LINE-PADDING'})); |
499
|
142
|
|
|
|
|
549
|
$cline = sprintf('%' . $self->{'LINES-PADDING'} . 's', $cline); |
500
|
142
|
|
|
|
|
748
|
$subroutine = colored(['bold cyan'], sprintf('%' . $self->{'PADDING'} . 's', $subroutine)); |
501
|
142
|
|
|
|
|
6484
|
$sline = sprintf('%' . $self->{'LINE-PADDING'} . 's', $sline); |
502
|
142
|
|
|
|
|
525
|
$short = colored(['bold cyan'], sprintf('%' . $self->{'SUBROUTINE-PADDING'} . 's', $short)); |
503
|
|
|
|
|
|
|
} ## end if ($self->{'PREFIX'} ...) |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
# Figure out the benchmarks, but only if it is in the prefix |
506
|
142
|
50
|
|
|
|
5556
|
if ($self->{'PREFIX'} =~ /\%Benchmark\%/) { |
507
|
|
|
|
|
|
|
# For multiline output, only output the bench data on the first line. Use padded spaces for the rest. |
508
|
|
|
|
|
|
|
# $thisBench = sprintf('%7s', sprintf(' %.02f', time - $self->{$level . '_LASTSTAMP'})); |
509
|
142
|
|
|
|
|
1185
|
$thisBench = sprintf('%7s', sprintf(' %.02f', time - $self->{'ANY_LASTSTAMP'})); |
510
|
142
|
|
|
|
|
409
|
$thisBench2 = ' ' x length($thisBench); |
511
|
|
|
|
|
|
|
} ## end if ($self->{'PREFIX'} ...) |
512
|
142
|
|
|
|
|
217
|
my $first = TRUE; # Set the first line flag. |
513
|
142
|
|
|
|
|
261
|
foreach my $msg (@messages) { # Loop through each line of output and format accordingly. |
514
|
234
|
50
|
|
|
|
529
|
if (ref($msg) ne '') { |
515
|
0
|
|
|
|
|
0
|
$msg = Dumper($msg); |
516
|
|
|
|
|
|
|
} ## end if (ref($msg) ne '') |
517
|
234
|
100
|
|
|
|
566
|
if ($msg =~ /\n/s) { # If the line contains newlines, then it too must be split into multiple lines. |
518
|
46
|
|
|
|
|
159
|
my @message = split(/\n/, $msg); |
519
|
46
|
|
|
|
|
86
|
foreach my $line (@message) { # Loop through the split lines and format accordingly. |
520
|
92
|
|
|
|
|
269
|
$self->_send_to_logger($level, $nested, $line, $first, $thisBench, $thisBench2, $subroutine, $cline, $sline, $short); |
521
|
92
|
|
|
|
|
250
|
$first = FALSE; # Clear the first line flag. |
522
|
|
|
|
|
|
|
} |
523
|
|
|
|
|
|
|
} else { # This line does not contain newlines. Treat it as a single line. |
524
|
188
|
|
|
|
|
495
|
$self->_send_to_logger($level, $nested, $msg, $first, $thisBench, $thisBench2, $subroutine, $cline, $sline, $short); |
525
|
|
|
|
|
|
|
} |
526
|
234
|
|
|
|
|
569
|
$first = FALSE; # Clear the first line flag. |
527
|
|
|
|
|
|
|
} ## end foreach my $msg (@messages) |
528
|
142
|
|
|
|
|
323
|
$self->{'ANY_LASTSTAMP'} = time; |
529
|
142
|
|
|
|
|
680
|
$self->{$level . '_LASTSTAMP'} = time; |
530
|
|
|
|
|
|
|
} ## end sub debug |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
sub _send_to_logger { # This actually simplifies the previous method ... seriously |
533
|
280
|
|
|
280
|
|
415
|
my $self = shift; |
534
|
280
|
|
|
|
|
413
|
my $level = shift; |
535
|
280
|
|
|
|
|
393
|
my $padding = shift; |
536
|
280
|
|
|
|
|
368
|
my $msg = shift; |
537
|
280
|
|
|
|
|
421
|
my $first = shift; |
538
|
280
|
|
|
|
|
362
|
my $thisBench = shift; |
539
|
280
|
|
|
|
|
392
|
my $thisBench2 = shift; |
540
|
280
|
|
|
|
|
375
|
my $subroutine = shift; |
541
|
280
|
|
|
|
|
378
|
my $cline = shift; |
542
|
280
|
|
|
|
|
374
|
my $sline = shift; |
543
|
280
|
|
|
|
|
376
|
my $shortsub = shift; |
544
|
|
|
|
|
|
|
|
545
|
280
|
|
33
|
|
|
669
|
my $timezone = $self->{'TIMEZONE'} || DateTime::TimeZone->new(name => 'local'); |
546
|
280
|
|
|
|
|
970
|
my $dt = DateTime->now('time_zone' => $timezone); |
547
|
280
|
|
|
|
|
93687
|
my $Date = $dt->ymd(); |
548
|
280
|
|
|
|
|
3933
|
my $Time = $dt->hms(); |
549
|
280
|
|
|
|
|
2583
|
my $prefix = $self->{$level . '-PREFIX'} . ''; # A copy not a pointer |
550
|
280
|
50
|
|
|
|
953
|
my $forked = ($PARENT ne $$) ? 'C' : 'P'; |
551
|
280
|
|
|
|
|
419
|
my $threaded = 'PT-'; |
552
|
280
|
|
|
|
|
637
|
my $epoch = time; |
553
|
280
|
50
|
33
|
|
|
3196
|
if (exists($Config{'useithreads'}) && $Config{'useithreads'}) { # Do eval so non-threaded perl's don't whine |
554
|
0
|
|
|
|
|
0
|
eval(q( |
555
|
|
|
|
|
|
|
my $tid = threads->tid(); |
556
|
|
|
|
|
|
|
$threaded = ($tid > 0) ? sprintf('T%02d',$tid) : 'PT-'; |
557
|
|
|
|
|
|
|
)); |
558
|
|
|
|
|
|
|
} |
559
|
|
|
|
|
|
|
|
560
|
280
|
|
|
|
|
1055
|
$prefix =~ s/\%PID\%/$$/g; |
561
|
280
|
|
|
|
|
1522
|
$prefix =~ s/\%Loglevel\%/$self->{'ANSILEVEL'}->{$level}/g; |
562
|
280
|
|
|
|
|
701
|
$prefix =~ s/\%Lines\%/$cline/g; |
563
|
280
|
|
|
|
|
811
|
$prefix =~ s/\%Lastline\%/$sline/g; |
564
|
280
|
|
|
|
|
770
|
$prefix =~ s/\%Subroutine\%/$shortsub/g; |
565
|
280
|
|
|
|
|
966
|
$prefix =~ s/\%Date\%/$self->{'DATESTAMP'}/g; |
566
|
280
|
|
|
|
|
957
|
$prefix =~ s/\%Time\%/$self->{'TIMESTAMP'}/g; |
567
|
280
|
|
|
|
|
533
|
$prefix =~ s/\%Epoch\%/$self->{'EPOCH'}/g; |
568
|
280
|
|
|
|
|
735
|
$prefix =~ s/\%date\%/$Date/g; |
569
|
280
|
|
|
|
|
760
|
$prefix =~ s/\%time\%/$Time/g; |
570
|
280
|
|
|
|
|
490
|
$prefix =~ s/\%epoch\%/$epoch/g; |
571
|
280
|
|
|
|
|
452
|
$prefix =~ s/\%Filename\%/$self->{'FILENAME'}/g; |
572
|
280
|
|
|
|
|
485
|
$prefix =~ s/\%Fork\%/$forked/g; |
573
|
280
|
|
|
|
|
439
|
$prefix =~ s/\%Thread\%/$threaded/g; |
574
|
280
|
|
|
|
|
430
|
$prefix =~ s/\%Module\%/$subroutine/g; |
575
|
|
|
|
|
|
|
|
576
|
280
|
100
|
|
|
|
554
|
if ($first) { |
577
|
142
|
|
|
|
|
407
|
$prefix =~ s/\%Benchmark\%/$thisBench/g; |
578
|
|
|
|
|
|
|
} else { |
579
|
138
|
|
|
|
|
391
|
$prefix =~ s/\%Benchmark\%/$thisBench2/g; |
580
|
|
|
|
|
|
|
} |
581
|
280
|
|
|
|
|
531
|
my $fh = $self->{'FILEHANDLE'}; |
582
|
280
|
100
|
100
|
|
|
939
|
if ($level eq 'INFO' && $self->{'LOGLEVEL'} eq 'VERBOSE') { # Trap verbose flag and temporarily drop the prefix. |
|
|
100
|
|
|
|
|
|
583
|
6
|
|
|
|
|
48
|
print $fh "$msg\n"; |
584
|
|
|
|
|
|
|
# $self->{'LOG'}->INFO($msg); |
585
|
|
|
|
|
|
|
} elsif ($level eq 'DEBUGMAX') { # Special version of DEBUG. Outputs as DEBUG in Log::Fast |
586
|
12
|
50
|
|
|
|
31
|
if ($self->{'LOGLEVEL'} eq 'DEBUGMAX') { |
587
|
12
|
|
|
|
|
109
|
print $fh "$prefix$padding$msg\n"; |
588
|
|
|
|
|
|
|
# $self->{'LOG'}->DEBUG($prefix . $padding . $msg); |
589
|
|
|
|
|
|
|
} |
590
|
|
|
|
|
|
|
} else { |
591
|
262
|
|
|
|
|
2411
|
print $fh "$prefix$padding$msg\n"; |
592
|
|
|
|
|
|
|
# $self->{'LOG'}->$level($prefix . $padding . $msg); |
593
|
|
|
|
|
|
|
} |
594
|
|
|
|
|
|
|
} ## end sub _send_to_logger |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
=head2 B<ERR> or B<ERROR> |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
Sends ERROR level debugging output to the log. Errors are always shown. |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
=over 4 |
601
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
=item B<MESSAGE> |
603
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
Either a single string or a reference to a list of strings |
605
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
=back |
607
|
|
|
|
|
|
|
=cut |
608
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
sub ERR { |
610
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
611
|
0
|
|
|
|
|
0
|
$self->debug('ERR', @_); |
612
|
|
|
|
|
|
|
} |
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
sub ERROR { |
615
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
616
|
0
|
|
|
|
|
0
|
$self->debug('ERR', @_); |
617
|
|
|
|
|
|
|
} |
618
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
=head2 B<WARN> or B<WARNING> |
620
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
If the log level is WARN or above, then these warnings are logged. |
622
|
|
|
|
|
|
|
|
623
|
|
|
|
|
|
|
=over 4 |
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
=item B<MESSAGE> |
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
Either a single string or a reference to a list of strings |
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
=back |
630
|
|
|
|
|
|
|
=cut |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
sub WARN { |
633
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
634
|
0
|
|
|
|
|
0
|
$self->debug('WARN', @_); |
635
|
|
|
|
|
|
|
} |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
sub WARNING { |
638
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
639
|
0
|
|
|
|
|
0
|
$self->debug('WARN', @_); |
640
|
|
|
|
|
|
|
} |
641
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
=head2 B<NOTICE> or B<ATTENTION> |
643
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
If the loglevel is NOTICE or above, then these notices are logged. |
645
|
|
|
|
|
|
|
|
646
|
|
|
|
|
|
|
=over 4 |
647
|
|
|
|
|
|
|
|
648
|
|
|
|
|
|
|
=item B<MESSAGE> |
649
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
Either a single string or a reference to a list of strings |
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
=back |
653
|
|
|
|
|
|
|
=cut |
654
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
sub NOTICE { |
656
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
657
|
0
|
|
|
|
|
0
|
$self->debug('NOTICE', @_); |
658
|
|
|
|
|
|
|
} |
659
|
|
|
|
|
|
|
|
660
|
|
|
|
|
|
|
sub ATTENTION { |
661
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
662
|
0
|
|
|
|
|
0
|
$self->debug('NOTICE'. @_); |
663
|
|
|
|
|
|
|
} |
664
|
|
|
|
|
|
|
|
665
|
|
|
|
|
|
|
=head2 B<INFO> or B<INFORMATION> |
666
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
If the loglevel is INFO (or VERBOSE) or above, then these information messages are displayed. |
668
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
=over 4 |
670
|
|
|
|
|
|
|
|
671
|
|
|
|
|
|
|
=item B<MESSAGE> |
672
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
Either a single string or a reference to a list of strings |
674
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
=back |
676
|
|
|
|
|
|
|
=cut |
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
sub INFO { |
679
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
680
|
0
|
|
|
|
|
0
|
$self->debug('INFO', @_); |
681
|
|
|
|
|
|
|
} |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
sub INFORMATION { |
684
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
685
|
0
|
|
|
|
|
0
|
$self->debug('INFO', @_); |
686
|
|
|
|
|
|
|
} |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
=head2 B<DEBUG> |
689
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
If the Loglevel is DEBUG or above, then basic debugging messages are logged. DEBUG is intended for basic program flow messages for easy tracing. Best not to place variable contents in these messages. |
691
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
=over 4 |
693
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
=item B<MESSAGE> |
695
|
|
|
|
|
|
|
|
696
|
|
|
|
|
|
|
Either a single string or a reference to a list of strings |
697
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
=back |
699
|
|
|
|
|
|
|
=cut |
700
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
sub DEBUG { |
702
|
13
|
|
|
13
|
1
|
611
|
my $self = shift; |
703
|
13
|
|
|
|
|
46
|
$self->debug('DEBUG', @_); |
704
|
|
|
|
|
|
|
} |
705
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
=head2 B<DEBUGMAX> |
707
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
If the loglevel is DEBUGMAX, then all messages are shown, and terse debugging messages as well. Typically DEBUGMAX is used for variable dumps and detailed data output for heavy tracing. This is a very "noisy" log level. |
709
|
|
|
|
|
|
|
|
710
|
|
|
|
|
|
|
=over 4 |
711
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
=item B<MESSAGE> |
713
|
|
|
|
|
|
|
|
714
|
|
|
|
|
|
|
Either a single string or a reference to a list of strings |
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
=back |
717
|
|
|
|
|
|
|
=cut |
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
sub DEBUGMAX { |
720
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
721
|
0
|
|
|
|
|
|
$self->debug('DEBUGMAX', @_); |
722
|
|
|
|
|
|
|
} |
723
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
1; |
725
|
|
|
|
|
|
|
|
726
|
|
|
|
|
|
|
=head1 B<CAVEATS> |
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
Since it is possible to duplicate the object in a fork or thread, the output formatting may be mismatched between forks and threads due to the automatic padding adjustment of the subroutine name field. |
729
|
|
|
|
|
|
|
|
730
|
|
|
|
|
|
|
Ways around this are to separately create a Debug::Easy object in each fork or thread, and have them log to separate files. |
731
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
The "less" pager is the best for viewing log files generated by this module. It's switch "-r" allows you to see them in all their colorful glory. |
733
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
=head1 B<INSTALLATION> |
735
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
To install this module, run the following commands: |
737
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
perl Build.PL |
739
|
|
|
|
|
|
|
./Build |
740
|
|
|
|
|
|
|
./Build test |
741
|
|
|
|
|
|
|
./Build install |
742
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
OR you can use the old ExtUtils::MakeMaker method: |
744
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
perl Makefile.PL |
746
|
|
|
|
|
|
|
make |
747
|
|
|
|
|
|
|
make test |
748
|
|
|
|
|
|
|
make install |
749
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
=head1 AUTHOR |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
Richard Kelsch <rich@rk-internet.com> |
753
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. |
755
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
=head1 B<VERSION> |
757
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
Version 2.05 (April 5, 2021) |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
=head1 B<BUGS> |
761
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
Please report any bugs or feature requests to C<bug-easydebug at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=EasyDebug>. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. |
763
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
=head1 B<SUPPORT> |
765
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
767
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
C<perldoc Debug::Easy> |
769
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
or if you have "man" installed, then |
771
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
C<man Debug::Easy> |
773
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
You can also look for information at: |
775
|
|
|
|
|
|
|
|
776
|
|
|
|
|
|
|
=over 4 |
777
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker (report bugs here) |
779
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Debug-Easy> |
781
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
783
|
|
|
|
|
|
|
|
784
|
|
|
|
|
|
|
L<http://annocpan.org/dist/Debug-Easy> |
785
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
=item * CPAN Ratings |
787
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
L<http://cpanratings.perl.org/d/Debug-Easy> |
789
|
|
|
|
|
|
|
|
790
|
|
|
|
|
|
|
Not exactly a reliable and fair means of rating modules. Modules are updated and improved over time, and what may have been a poor or mediocre review at version 0,04, may not remotely apply to current or later versions. It applies ratings in an arbitrary manner with no ability for the author to add their own rebuttals or comments to the review, especially should the review be malicious or inapplicable. |
791
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
More importantly, issues brought up in a mediocre review may have been addressed and improved in later versions, or completely changed to allieviate that issue. |
793
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
So, check the reviews AND the version number when that review was written. |
795
|
|
|
|
|
|
|
|
796
|
|
|
|
|
|
|
=item * Search CPAN |
797
|
|
|
|
|
|
|
|
798
|
|
|
|
|
|
|
L<http://search.cpan.org/dist/Debug-Easy/> |
799
|
|
|
|
|
|
|
|
800
|
|
|
|
|
|
|
=back |
801
|
|
|
|
|
|
|
|
802
|
|
|
|
|
|
|
=head1 B<AUTHOR COMMENTS> |
803
|
|
|
|
|
|
|
|
804
|
|
|
|
|
|
|
I coded this module because it filled a gap when I was working for a major chip manufacturing company. It gave the necessary output the other coders asked for, and fulfilled a need. It has grown far beyond those days, and I use it every day in my coding work. |
805
|
|
|
|
|
|
|
|
806
|
|
|
|
|
|
|
If you have any features you wish added, or functionality improved or changed, then I welcome them, and will very likely incorporate them sooner than you think. |
807
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
=head1 B<LICENSE AND COPYRIGHT> |
809
|
|
|
|
|
|
|
|
810
|
|
|
|
|
|
|
Copyright 2013-2021 Richard Kelsch. |
811
|
|
|
|
|
|
|
|
812
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it under the terms of the the Artistic License (2.0). You may obtain a copy of the full license at: |
813
|
|
|
|
|
|
|
|
814
|
|
|
|
|
|
|
L<http://www.perlfoundation.org/artistic_license_2_0> |
815
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
Any use, modification, and distribution of the Standard or Modified Versions is governed by this Artistic License. By using, modifying or distributing the Package, you accept this license. Do not use, modify, or distribute the Package, if you do not accept this license. |
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
If your Modified Version has been derived from a Modified Version made by someone other than you, you are nevertheless required to ensure that your Modified Version complies with the requirements of this license. |
819
|
|
|
|
|
|
|
|
820
|
|
|
|
|
|
|
This license does not grant you the right to use any trademark, service mark, tradename, or logo of the Copyright Holder. |
821
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
This license includes the non-exclusive, worldwide, free-of-charge patent license to make, have made, use, offer to sell, sell, import and otherwise transfer the Package with respect to any patent claims licensable by the Copyright Holder that are necessarily infringed by the Package. If you institute patent litigation (including a cross-claim or counterclaim) against any party alleging that the Package constitutes direct or contributory patent infringement, then this Artistic License to you shall terminate on the date that such litigation is filed. |
823
|
|
|
|
|
|
|
|
824
|
|
|
|
|
|
|
Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
825
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
=cut |