File Coverage

blib/lib/Debug/Easy.pm
Criterion Covered Total %
statement 171 202 84.6
branch 48 68 70.5
condition 10 18 55.5
subroutine 14 23 60.8
pod 12 12 100.0
total 255 323 78.9


line stmt bran cond sub pod time code
1             #############################################################################
2             ################# Easy Debugging Module ######################
3             ################# Copyright 2013 - 2018 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   536474 use strict;
  4         14  
  4         122  
12             use constant {
13 4         268 TRUE => 1,
14             FALSE => 0
15 4     4   20 };
  4         6  
16              
17 4     4   2963 use DateTime;
  4         1549960  
  4         178  
18 4     4   2357 use Term::ANSIColor;
  4         32951  
  4         305  
19 4     4   1824 use Time::HiRes qw(time);
  4         4983  
  4         14  
20 4     4   662 use File::Basename;
  4         8  
  4         206  
21              
22 4     4   2067 use Data::Dumper;
  4         20123  
  4         202  
23              
24 4     4   32 use Config;
  4         7  
  4         296  
25              
26              
27             BEGIN {
28 4     4   20 require Exporter;
29              
30             # set the version for version checking
31 4         5 our $VERSION = '2.03';
32              
33             # Inherit from Exporter to export functions and variables
34 4         56 our @ISA = qw(Exporter);
35              
36             # Functions and variables which are exported by default
37 4         16 our @EXPORT = qw();
38              
39             # Functions and variables which can be optionally exported
40 4         8696 our @EXPORT_OK = qw(@Levels);
41             } ## end BEGIN
42              
43             $Data::Dumper::Sortkeys = TRUE;
44             $Data::Dumper::Purity = TRUE;
45              
46             # This can be optionally exported for whatever
47             our @Levels = qw( ERR WARN NOTICE INFO VERBOSE DEBUG DEBUGMAX );
48              
49             # For quick level checks to speed up execution
50             our %LevelLogic;
51             for (my $count = 0 ; $count < scalar(@Levels) ; $count++) {
52             $LevelLogic{$Levels[$count]} = $count;
53             }
54              
55             our $PARENT = $$; # This needs to be defined at the very beginning before new
56             my ($SCRIPTNAME, $SCRIPTPATH, $suffix) = fileparse($0);
57              
58             =head1 NAME
59              
60             Debug::Easy - A Handy Debugging Module With Colorized Output and Formatting
61              
62             =head1 SYNOPSIS
63              
64             use Debug::Easy;
65              
66             my $debug = Debug::Easy->new( 'LogLevel' => 'DEBUG', 'Color' => 1 );
67              
68             '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.
69              
70             The following is a list, in order of level, of the logging methods:
71              
72             ERR = Error
73             WARN = Warning
74             NOTICE = Notice
75             INFO = Information
76             VERBOSE = Special version of INFO that does not output any
77             Logging headings. Very useful for verbose modes in your
78             scripts.
79             DEBUG = Level 1 Debugging messages
80             DEBUGMAX = Level 2 Debugging messages (typically more terse)
81              
82             The parameter is either a string or a reference to an array of strings to output as multiple lines.
83              
84             Each string can contain newlines, which will also be split into a separate line and formatted accordingly.
85              
86             $debug->ERR( ['Error message']);
87             $debug->ERROR( ['Error message']);
88             $debug->WARN( ['Warning message']);
89             $debug->WARNING( ['Warning message']);
90             $debug->NOTICE( ['Notice message']);
91             $debug->INFO( ['Information and VERBOSE mode message']);
92             $debug->INFORMATION(['Information and VERBOSE mode message']);
93             $debug->DEBUG( ['Level 1 Debug message']);
94             $debug->DEBUGMAX( ['Level 2 (terse) Debug message']);
95              
96             my @messages = (
97             'First Message',
98             'Second Message',
99             "Third Message First Line\nThird Message Second Line",
100             \%hash_reference
101             );
102              
103             $debug->INFO(\@messages);
104              
105             =head1 DESCRIPTION
106              
107             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!
108              
109             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.
110              
111             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.
112              
113             Generally all you need are the defaults and you are ready to go.
114              
115             =head1 B<EXPORTABLE VARIABLES>
116              
117             =head2 B<@Levels>
118              
119             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.
120              
121             =cut
122              
123             sub DESTROY { # We spit out one last message before we die, the total execute time.
124 13     13   6583 my $self = shift;
125 13         144 my $bench = colored(['bright_cyan'], sprintf('%06s', sprintf('%.02f', (time - $self->{'MASTERSTART'}))));
126 13         476 my $name = $SCRIPTNAME;
127 13 50       55 $name .= ' [child]' if ($PARENT ne $$);
128 13         76 $self->DEBUG([$bench . ' ' . colored(['black on_white'],"---- $name complete ----")]);
129             }
130              
131             =head1 B<METHODS>
132              
133             =head2 B<new>
134              
135             * The parameter names are case insensitive as of Version 0.04.
136              
137             =over 4
138              
139             =item B<LogLevel> [level]
140              
141             This adjusts the global log level of the Debug object. It requires a string.
142              
143             =back
144              
145             =over 8
146              
147             B<ERR> (default)
148              
149             This level shows only error messages and all other messages are not shown.
150              
151             B<WARN>
152              
153             This level shows error and warning messages. All other messages are not shown.
154              
155             B<NOTICE>
156              
157             This level shows error, warning, and notice messages. All other messages are not shown.
158              
159             B<INFO>
160              
161             This level shows error, warning, notice, and information messages. Only debug level messages are not shown.
162              
163             B<VERBOSE>
164              
165             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.
166              
167             B<DEBUG>
168              
169             This level shows error, warning, notice, information, and level 1 debugging messages. Level 2 Debug messages are not shown.
170              
171             B<DEBUGMAX>
172              
173             This level shows all messages up to level 2 debugging messages.
174              
175             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.
176              
177             =back
178              
179             =over 4
180              
181             =item B<Color> [boolean] (Not case sensitive)
182              
183             B<0>, B<Off>, or B<False> (Off)
184              
185             This turns off colored output. Everything is plain text only.
186              
187             B<1>, B<On>, or B<True> (On - Default)
188              
189             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".
190              
191             =back
192              
193             =over 4
194              
195             =item B<Prefix> [pattern]
196              
197             This is global
198              
199             A string that is parsed into the output prefix.
200              
201             DEFAULT: '%Date% %Time% %Benchmark% %Loglevel%[%Subroutine%][%Lastline%] '
202              
203             %Date% = Date (Uses format of "DateStamp" below)
204             %Time% = Time (Uses format of "TimeStamp" below)
205             %Epoch% = Epoch (Unix epoch)
206             %Benchmark% = Benchmark - The time it took between the last benchmark display
207             of this loglevel. If in an INFO level message, it benchmarks
208             the time until the next INFO level message. The same rule is
209             true for all loglevels.
210             %Loglevel% = Log Level
211             %Lines% = Line Numbers of all nested calls
212             %Module% = Module and subroutine of call (can be a lot of stuff!)
213             %Subroutine% = Just the last subroutine
214             %Lastline% = Just the last line number
215             %PID% = Process ID
216             %date% = Just Date (typically used internally only, use %Date%)
217             %time% = Just time (typically used internally only, use %Time%)
218             %epoch% = Unix epoch (typically used internally only, use %Epoch%)
219             %Filename% = Script Filename (parsed $0)
220             %Fork% = Running in parent or child?
221             P = Parent
222             C = Child
223             %Thread% = Running in Parent or Thread
224             P = Parent
225             T## = Thread # = Thread ID
226              
227             =item B<[loglevel]-Prefix> [pattern]
228              
229             You can define a prefix for a specific log level.
230              
231             ERR-Prefix
232             WARN-Prefix
233             NOTICE-Prefix
234             INFO-Prefix
235             DEBUG-Prefix
236             DEBUGMAX-Prefix
237              
238             If one of these are not defined, then the global value is used.
239              
240             =item B<TimeStamp> [pattern]
241              
242             (See Log::Fast for specifics on these)
243              
244             I suggest you just use Prefix above, but here it is anyway.
245              
246             Make this an empty string to turn it off, otherwise:
247              
248             =back
249              
250             =over 8
251              
252             B<%T>
253              
254             Formats the timestamp as HH:MM:SS. This is the default for the timestamp.
255              
256             B<%S>
257              
258             Formats the timestamp as seconds.milliseconds. Normally not needed, as the benchmark is more helpful.
259              
260             B<%T %S>
261              
262             Combines both of the above. Normally this is just too much, but here if you really want it.
263              
264             =back
265              
266             =over 4
267              
268             =item B<DateStamp> [pattern]
269              
270             I suggest you just use Prefix above, but here it is anyway.
271              
272             Make this an empty string to turn it off, otherwise:
273              
274             =back
275              
276             =over 8
277              
278             B<%D>
279              
280             Formats the datestamp as YYYY-MM-DD. It is the default, and the only option.
281              
282             =back
283              
284             =over 4
285              
286             =item B<FileHandle>
287              
288             File handle to write log messages.
289              
290             =item B<ANSILevel>
291              
292             Contains a hash reference describing the various colored debug level labels
293              
294             The default definition (using Term::ANSIColor) is as follows:
295              
296             =back
297              
298             =over 8
299              
300             'ANSILevel' => {
301             'ERR' => colored(['white on_red'], '[ ERROR ]'),
302             'WARN' => colored(['black on_yellow'], '[WARNING]'),
303             'NOTICE' => colored(['yellow'], '[NOTICE ]'),
304             'INFO' => colored(['black on_white'], '[ INFO ]'),
305             'DEBUG' => colored(['bold green'], '[ DEBUG ]'),
306             'DEBUGMAX' => colored(['bold black on_green'], '[DEBUGMX]'),
307             }
308              
309             =back
310              
311             =cut
312              
313             sub new {
314             # This module uses the Log::Fast library heavily. Many of the
315             # Log::Fast variables and features can work here. See the perldocs
316             # for Log::Fast for specifics.
317 13     13 1 2265 my $class = shift;
318 13         309 my ($filename, $dir, $suffix) = fileparse($0);
319 13         103 my $self = {
320             'LogLevel' => 'ERR', # Default is errors only
321             'Type' => 'fh', # Default is a filehandle
322             'Path' => '/var/log', # Default path should type be unix
323             'FileHandle' => \*STDERR, # Default filehandle is STDERR
324             'MasterStart' => time,
325             'ANY_LastStamp' => time, # Initialize main benchmark
326             'ERR_LastStamp' => time, # Initialize the ERR benchmark
327             'WARN_LastStamp' => time, # Initialize the WARN benchmark
328             'INFO_LastStamp' => time, # Initialize the INFO benchmark
329             'NOTICE_LastStamp' => time, # Initialize the NOTICE benchmark
330             'DEBUG_LastStamp' => time, # Initialize the DEBUG benchmark
331             'DEBUGMAX_LastStamp' => time, # Initialize the DEBUGMAX benchmark
332             'Color' => TRUE, # Default to colorized output
333             'DateStamp' => colored(['yellow'], '%date%'),
334             'TimeStamp' => colored(['yellow'], '%time%'),
335             'Epoch' => colored(['cyan'], '%epoch%'),
336             'Padding' => -20, # Default padding is 20 spaces
337             'Lines-Padding' => -2,
338             'Subroutine-Padding' => 0,
339             'Line-Padding' => 0,
340             'PARENT' => $$,
341             'Prefix' => '%Date% %Time% %Benchmark% %Loglevel%[%Subroutine%][%Lastline%] ',
342             'DEBUGMAX-Prefix' => '%Date% %Time% %Benchmark% %Loglevel%[%Module%][%Lines%] ',
343             'Filename' => '[' . colored(['magenta'], $filename) . ']',
344             'TIMEZONE' => DateTime::TimeZone->new(name => 'local'),
345             'ANSILevel' => {
346             'ERR' => colored(['white on_red'], '[ ERROR ]'),
347             'WARN' => colored(['black on_yellow'], '[WARNING ]'),
348             'NOTICE' => colored(['yellow'], '[ NOTICE ]'),
349             'INFO' => colored(['black on_white'], '[ INFO ]'),
350             'DEBUG' => colored(['bold green'], '[ DEBUG ]'),
351             'DEBUGMAX' => colored(['bold black on_green'], '[DEBUGMAX]'),
352             },
353             };
354              
355             # This pretty much makes all hash keys uppercase
356 13         19565 my @Keys = (keys %{$self}); # Hash is redefined on the fly, so get the list before
  13         63  
357 13         30 foreach my $Key (@Keys) {
358 338         393 my $upper = uc($Key);
359 338 100       492 if ($Key ne $upper) {
    50          
360 312         461 $self->{$upper} = $self->{$Key};
361              
362             # This fixes a documentation error for past versions
363 312 100       461 if ($upper eq 'LOGLEVEL') {
364 13 50       28 $self->{$upper} = 'ERR' if ($self->{$upper} =~ /^ERROR$/i);
365 13         52 $self->{$upper} = uc($self->{$upper}); # Make loglevels case insensitive
366             }
367 312         441 delete($self->{$Key});
368             } elsif ($Key eq 'LOGLEVEL') { # Make loglevels case insensitive
369 0         0 $self->{$upper} = uc($self->{$upper});
370             }
371             } ## end foreach my $Key (@Keys)
372             { # This makes sure the user overrides actually override
373 13         16 my %params = (@_);
  13         35  
374 13         31 foreach my $Key (keys %params) {
375 39         81 $self->{uc($Key)} = $params{$Key};
376             }
377             }
378              
379             # This instructs the ANSIColor library to turn off coloring,
380             # if the Color attribute is set to zero.
381 13 50       65 if ($self->{'COLOR'} =~ /0|FALSE|OFF|NO/i) {
382 0         0 $ENV{'ANSI_COLORS_DISABLED'} = TRUE;
383             # If COLOR is FALSE, then clear color data from ANSILEVEL, as these were
384             # defined before color was turned off.
385 0         0 $self->{'ANSILEVEL'} = {
386             'ERR' => '[ ERROR ]',
387             'WARN' => '[WARNING ]',
388             'NOTICE' => '[ NOTICE ]',
389             'INFO' => '[ INFO ]',
390             'DEBUG' => '[ DEBUG ]',
391             'DEBUGMAX' => '[DEBUGMAX]',
392             };
393 0         0 $self->{'DATESTAMP'} = '%date%';
394 0         0 $self->{'TIMESTAMP'} = '%time%';
395 0         0 $self->{'EPOCH'} = '%epoch%';
396             }
397              
398 13         28 foreach my $lvl (@Levels) {
399 91 100 66     306 $self->{"$lvl-PREFIX"} = $self->{'PREFIX'} unless (exists($self->{"$lvl-PREFIX"}) && defined($self->{"$lvl-PREFIX"}));
400             }
401              
402 13         23 my $fh = $self->{'FILEHANDLE'};
403             # Signal the script has started (and logger initialized)
404 13         26 my $name = $SCRIPTNAME;
405 13 50       41 $name .= ' [child]' if ($PARENT ne $$);
406 13         65 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";
407              
408 13         602 bless($self, $class);
409 13         67 return ($self);
410             } ## end sub new
411              
412             =head2 debug
413              
414             NOTE: This is a legacy method for backwards compatibility. Please use the direct methods instead.
415              
416             The parameters must be passed in the order given
417              
418             =over 4
419              
420             =item B<LEVEL>
421              
422             The log level with which this message is to be triggered
423              
424             =item B<MESSAGE(S)>
425              
426             A string or a reference to a list of strings to output line by line.
427              
428             =back
429              
430             =cut
431              
432             sub debug {
433 247     247 1 123299 my $self = shift;
434 247         421 my $level = uc(shift);
435 247         297 my $msgs = shift;
436              
437 247 100       1054 if ($level !~ /ERR.*|WARN.*|NOTICE|INFO.*|DEBUG/i) { # Compatibility with older versions.
438 108         150 $level = uc($msgs); # It tosses the legacy __LINE__ argument
439 108         163 $msgs = shift;
440             }
441 247         769 $level =~ s/(OR|ING|RMATION)$//; # Strip off the excess
442              
443             # A much quicker bypass when the log level is below what is needed
444 247 100       962 return if ($LevelLogic{$self->{'LOGLEVEL'}} < $LevelLogic{$level});
445              
446 142         172 my @messages;
447 142 100 66     559 if (ref($msgs) eq 'SCALAR' || ref($msgs) eq '') {
    50          
448 92         164 push(@messages, $msgs);
449             } elsif (ref($msgs) eq 'ARRAY') {
450 50         69 @messages = @{$msgs};
  50         112  
451             } else {
452 0         0 push(@messages,Dumper($msgs));
453             } ## end else [ if (ref($msgs) eq 'SCALAR'...)]
454 142         313 my ($sname, $cline, $nested, $subroutine, $thisBench, $thisBench2, $sline, $short) = ('', '', '', '', '', '', '', '');
455              
456             # Figure out the proper caller tree and line number ladder
457             # But only if it's part of the prefix, else don't waste time.
458 142 50       750 if ($self->{'PREFIX'} =~ /\%(Subroutine|Module|Lines|Lastline)\%/) { # %P = Subroutine, %l = Line number(s)
459 142         193 my $package = '';
460 142         166 my $count = 1;
461 142         148 my $nest = 0;
462 142         393 while (my @array = caller($count)) {
463 12 100       31 if ($array[3] !~ /Debug::Easy/) {
464 4         7 $package = $array[0];
465 4         26 my $subroutine = $array[3];
466 4         31 $subroutine =~ s/^$package\:\://;
467 4         29 $sname =~ s/$subroutine//;
468 4 50       14 if ($sname eq '') {
469 4 50       13 $sname = ($subroutine ne '') ? $subroutine : $package;
470 4         6 $cline = $array[2];
471             } else {
472 0         0 $sname = $subroutine . '::' . $sname;
473 0         0 $cline = $array[2] . '/' . $cline;
474             }
475 4 50       12 if ($count == 2) {
476 0         0 $short = $array[3];
477 0         0 $sline = $array[2];
478             }
479 4         7 $nest++;
480             } ## end if ($array[3] !~ /Debug::Easy/)
481 12         60 $count++;
482             } ## end while (my @array = caller...)
483 142 100       236 if ($package ne '') {
484 4         10 $sname = $package . '::' . $sname;
485 4 50       11 $nested = ' ' x $nest if ($nest);
486             } else {
487 138         167 my @array = caller(1);
488 138         174 $cline = $array[2];
489 138 50 33     279 if (!defined($cline) || $cline eq '') {
490 138         598 @array = caller(0);
491 138         236 $cline = $array[2];
492             }
493 138         167 $sname = 'main';
494 138         160 $sline = $cline;
495 138         247 $short = $sname;
496             } ## end else [ if ($package ne '') ]
497 142 50       215 $subroutine = ($sname ne '') ? $sname : 'main';
498 142 50       302 $self->{'PADDING'} = 0 - length($subroutine) if (length($subroutine) > abs($self->{'PADDING'}));
499 142 50       258 $self->{'LINES-PADDING'} = 0 - length($cline) if (length($cline) > abs($self->{'LINES-PADDING'}));
500 142 100       236 $self->{'SUBROUTINE-PADDING'} = 0 - length($short) if (length($short) > abs($self->{'SUBROUTINE-PADDING'}));
501 142 100       232 $self->{'LINE-PADDING'} = 0 - length($sline) if (length($sline) > abs($self->{'LINE-PADDING'}));
502 142         434 $cline = sprintf('%' . $self->{'LINES-PADDING'} . 's', $cline);
503 142         614 $subroutine = colored(['bold cyan'], sprintf('%' . $self->{'PADDING'} . 's', $subroutine));
504 142         5272 $sline = sprintf('%' . $self->{'LINE-PADDING'} . 's', $sline);
505 142         455 $short = colored(['bold cyan'], sprintf('%' . $self->{'SUBROUTINE-PADDING'} . 's', $short));
506             } ## end if ($self->{'PREFIX'} ...)
507              
508             # Figure out the benchmarks, but only if it is in the prefix
509 142 50       4538 if ($self->{'PREFIX'} =~ /\%Benchmark\%/) {
510             # For multiline output, only output the bench data on the first line. Use padded spaces for the rest.
511             # $thisBench = sprintf('%7s', sprintf(' %.02f', time - $self->{$level . '_LASTSTAMP'}));
512 142         964 $thisBench = sprintf('%7s', sprintf(' %.02f', time - $self->{'ANY_LASTSTAMP'}));
513 142         290 $thisBench2 = ' ' x length($thisBench);
514             } ## end if ($self->{'PREFIX'} ...)
515 142         175 my $first = TRUE; # Set the first line flag.
516 142         207 foreach my $msg (@messages) { # Loop through each line of output and format accordingly.
517 234 50       456 if (ref($msg) ne '') {
518 0         0 $msg = Dumper($msg);
519             } ## end if (ref($msg) ne '')
520 234 100       460 if ($msg =~ /\n/s) { # If the line contains newlines, then it too must be split into multiple lines.
521 46         114 my @message = split(/\n/, $msg);
522 46         73 foreach my $line (@message) { # Loop through the split lines and format accordingly.
523 92         215 $self->_send_to_logger($level, $nested, $line, $first, $thisBench, $thisBench2, $subroutine, $cline, $sline, $short);
524 92         219 $first = FALSE; # Clear the first line flag.
525             }
526             } else { # This line does not contain newlines. Treat it as a single line.
527 188         367 $self->_send_to_logger($level, $nested, $msg, $first, $thisBench, $thisBench2, $subroutine, $cline, $sline, $short);
528             }
529 234         456 $first = FALSE; # Clear the first line flag.
530             } ## end foreach my $msg (@messages)
531 142         268 $self->{'ANY_LASTSTAMP'} = time;
532 142         538 $self->{$level . '_LASTSTAMP'} = time;
533             } ## end sub debug
534              
535             sub _send_to_logger { # This actually simplifies the previous method ... seriously
536 280     280   351 my $self = shift;
537 280         367 my $level = shift;
538 280         291 my $padding = shift;
539 280         349 my $msg = shift;
540 280         368 my $first = shift;
541 280         283 my $thisBench = shift;
542 280         303 my $thisBench2 = shift;
543 280         302 my $subroutine = shift;
544 280         311 my $cline = shift;
545 280         293 my $sline = shift;
546 280         284 my $shortsub = shift;
547              
548 280   33     544 my $timezone = $self->{'TIMEZONE'} || DateTime::TimeZone->new(name => 'local');
549 280         730 my $dt = DateTime->now('time_zone' => $timezone);
550 280         75529 my $Date = $dt->ymd();
551 280         3255 my $Time = $dt->hms();
552 280         2136 my $prefix = $self->{$level . '-PREFIX'} . ''; # A copy not a pointer
553 280 50       1105 my $forked = ($PARENT ne $$) ? 'C' : 'P';
554 280         315 my $threaded = 'PT-';
555 280         540 my $epoch = time;
556 280 50 33     2612 if (exists($Config{'useithreads'}) && $Config{'useithreads'}) { # Do eval so non-threaded perl's don't whine
557 0         0 eval(q(
558             my $tid = threads->tid();
559             $threaded = ($tid > 0) ? sprintf('T%02d',$tid) : 'PT-';
560             ));
561             }
562              
563 280         895 $prefix =~ s/\%PID\%/$$/g;
564 280         1279 $prefix =~ s/\%Loglevel\%/$self->{'ANSILEVEL'}->{$level}/g;
565 280         514 $prefix =~ s/\%Lines\%/$cline/g;
566 280         677 $prefix =~ s/\%Lastline\%/$sline/g;
567 280         592 $prefix =~ s/\%Subroutine\%/$shortsub/g;
568 280         742 $prefix =~ s/\%Date\%/$self->{'DATESTAMP'}/g;
569 280         701 $prefix =~ s/\%Time\%/$self->{'TIMESTAMP'}/g;
570 280         434 $prefix =~ s/\%Epoch\%/$self->{'EPOCH'}/g;
571 280         643 $prefix =~ s/\%date\%/$Date/g;
572 280         625 $prefix =~ s/\%time\%/$Time/g;
573 280         399 $prefix =~ s/\%epoch\%/$epoch/g;
574 280         341 $prefix =~ s/\%Filename\%/$self->{'FILENAME'}/g;
575 280         360 $prefix =~ s/\%Fork\%/$forked/g;
576 280         397 $prefix =~ s/\%Thread\%/$threaded/g;
577 280         337 $prefix =~ s/\%Module\%/$subroutine/g;
578              
579 280 100       432 if ($first) {
580 142         314 $prefix =~ s/\%Benchmark\%/$thisBench/g;
581             } else {
582 138         312 $prefix =~ s/\%Benchmark\%/$thisBench2/g;
583             }
584 280         438 my $fh = $self->{'FILEHANDLE'};
585 280 100 100     720 if ($level eq 'INFO' && $self->{'LOGLEVEL'} eq 'VERBOSE') { # Trap verbose flag and temporarily drop the prefix.
    100          
586 6         37 print $fh "$msg\n";
587             # $self->{'LOG'}->INFO($msg);
588             } elsif ($level eq 'DEBUGMAX') { # Special version of DEBUG. Outputs as DEBUG in Log::Fast
589 12 50       28 if ($self->{'LOGLEVEL'} eq 'DEBUGMAX') {
590 12         95 print $fh "$prefix$padding$msg\n";
591             # $self->{'LOG'}->DEBUG($prefix . $padding . $msg);
592             }
593             } else {
594 262         1946 print $fh "$prefix$padding$msg\n";
595             # $self->{'LOG'}->$level($prefix . $padding . $msg);
596             }
597             } ## end sub _send_to_logger
598              
599             =head2 B<ERR> or B<ERROR>
600              
601             Sends ERROR level debugging output to the log. Errors are always shown.
602              
603             =over 4
604              
605             =item B<MESSAGE>
606              
607             Either a single string or a reference to a list of strings
608              
609             =back
610             =cut
611              
612             sub ERR {
613 0     0 1 0 my $self = shift;
614 0         0 $self->debug('ERR', @_);
615             }
616              
617             sub ERROR {
618 0     0 1 0 my $self = shift;
619 0         0 $self->debug('ERR', @_);
620             }
621              
622             =head2 B<WARN> or B<WARNING>
623              
624             If the log level is WARN or above, then these warnings are logged.
625              
626             =over 4
627              
628             =item B<MESSAGE>
629              
630             Either a single string or a reference to a list of strings
631              
632             =back
633             =cut
634              
635             sub WARN {
636 0     0 1 0 my $self = shift;
637 0         0 $self->debug('WARN', @_);
638             }
639              
640             sub WARNING {
641 0     0 1 0 my $self = shift;
642 0         0 $self->debug('WARN', @_);
643             }
644              
645             =head2 B<NOTICE> or B<ATTENTION>
646              
647             If the loglevel is NOTICE or above, then these notices are logged.
648              
649             =over 4
650              
651             =item B<MESSAGE>
652              
653             Either a single string or a reference to a list of strings
654              
655             =back
656             =cut
657              
658             sub NOTICE {
659 0     0 1 0 my $self = shift;
660 0         0 $self->debug('NOTICE', @_);
661             }
662              
663             sub ATTENTION {
664 0     0 1 0 my $self = shift;
665 0         0 $self->debug('NOTICE'. @_);
666             }
667              
668             =head2 B<INFO> or B<INFORMATION>
669              
670             If the loglevel is INFO (or VERBOSE) or above, then these information messages are displayed.
671              
672             =over 4
673              
674             =item B<MESSAGE>
675              
676             Either a single string or a reference to a list of strings
677              
678             =back
679             =cut
680              
681             sub INFO {
682 0     0 1 0 my $self = shift;
683 0         0 $self->debug('INFO', @_);
684             }
685              
686             sub INFORMATION {
687 0     0 1 0 my $self = shift;
688 0         0 $self->debug('INFO', @_);
689             }
690              
691             =head2 B<DEBUG>
692              
693             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.
694              
695             =over 4
696              
697             =item B<MESSAGE>
698              
699             Either a single string or a reference to a list of strings
700              
701             =back
702             =cut
703              
704             sub DEBUG {
705 13     13 1 473 my $self = shift;
706 13         30 $self->debug('DEBUG', @_);
707             }
708              
709             =head2 B<DEBUGMAX>
710              
711             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.
712              
713             =over 4
714              
715             =item B<MESSAGE>
716              
717             Either a single string or a reference to a list of strings
718              
719             =back
720             =cut
721              
722             sub DEBUGMAX {
723 0     0 1   my $self = shift;
724 0           $self->debug('DEBUGMAX', @_);
725             }
726              
727             1;
728              
729             =head1 B<CAVEATS>
730              
731             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.
732              
733             Ways around this are to separately create a Debug::Easy object in each fork or thread, and have them log to separate files.
734              
735             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.
736              
737             =head1 B<INSTALLATION>
738              
739             To install this module, run the following commands:
740              
741             perl Build.PL
742             ./Build
743             ./Build test
744             ./Build install
745              
746             OR you can use the old ExtUtils::MakeMaker method:
747              
748             perl Makefile.PL
749             make
750             make test
751             make install
752              
753             =head1 AUTHOR
754              
755             Richard Kelsch <rich@rk-internet.com>
756              
757             Copyright 2013-2018 Richard Kelsch, All Rights Reserved.
758              
759             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
760              
761             =head1 B<VERSION>
762              
763             Version 2.00 (June 13, 2018)
764              
765             =head1 B<BUGS>
766              
767             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.
768              
769             =head1 B<SUPPORT>
770              
771             You can find documentation for this module with the perldoc command.
772              
773             C<perldoc Debug::Easy>
774              
775              
776             You can also look for information at:
777              
778             =over 4
779              
780             =item * RT: CPAN's request tracker (report bugs here)
781              
782             L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Debug-Easy>
783              
784             =item * AnnoCPAN: Annotated CPAN documentation
785              
786             L<http://annocpan.org/dist/Debug-Easy>
787              
788             =item * CPAN Ratings
789              
790             L<http://cpanratings.perl.org/d/Debug-Easy>
791              
792             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.
793              
794             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.
795              
796             So, check the reviews AND the version number when that review was written.
797              
798             =item * Search CPAN
799              
800             L<http://search.cpan.org/dist/Debug-Easy/>
801              
802             =back
803              
804             =head1 B<AUTHOR COMMENTS>
805              
806             Earlier versions of this module (pre version 1.0), were difficult to code with, and not "Easy" as the name implied. Version 1.x+ has addressed the issues brought forward by some users (and reviewers), and has made the module truely easy to use.
807              
808             Version 2.0 promises to be even simpler, with fewer prerequisites on installation. Specifically the requirement for "Log::Fast" will be removed, and this module will exclusively handle logging, as I believe it should.
809              
810             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.
811              
812             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.
813              
814             =head1 B<LICENSE AND COPYRIGHT>
815              
816             Copyright 2013-2018 Richard Kelsch.
817              
818             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:
819              
820             L<http://www.perlfoundation.org/artistic_license_2_0>
821              
822             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.
823              
824             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.
825              
826             This license does not grant you the right to use any trademark, service mark, tradename, or logo of the Copyright Holder.
827              
828             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.
829              
830             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.
831              
832             =cut