File Coverage

blib/lib/Fred/Fish/DBUG.pm
Criterion Covered Total %
statement 111 128 86.7
branch 26 38 68.4
condition 10 16 62.5
subroutine 19 20 95.0
pod 0 12 0.0
total 166 214 77.5


line stmt bran cond sub pod time code
1             ###
2             ### Copyright (c) 2007 - 2025 Curtis Leach. All rights reserved.
3             ###
4             ### Based on the Fred Fish DBUG macros in C/C++.
5             ### This Algorithm is in the public domain!
6             ###
7             ### Module: Fred::Fish::DBUG
8              
9             =head1 NAME
10              
11             Fred::Fish::DBUG - Fred Fish library for Perl
12              
13             =head1 SYNOPSIS (Default)
14              
15             use Fred::Fish::DBUG qw / on /;
16             or
17             require Fred::Fish::DBUG;
18             Fred::Fish::DBUG::import ( qw / on / );
19              
20             =head1 DESCRIPTION
21              
22             F is a pure Perl implementation of the C/C++ Fred Fish macro
23             libraries. While in C/C++ this library is implemented mostly via macros, in
24             Perl this library is implemented using true function calls. It has also been
25             slightly modified to address Perlish features over C/C++ ones. This can make
26             using some features a bit strange compared to C/C++. But the basic concepts
27             are the same. The most powerful feature being able to dynamically turn B
28             logging on and off.
29              
30             But due to this module being implemented as functions, there can be significant
31             overhead when using this module. So see the next section on how to mitigate
32             this overhead.
33              
34             =head1 ELIMINATING THE OVERHEAD
35              
36             This can be as simple as changing B to B. This turns most
37             DBUG calls into calls to stubs that do very little. Dropping the current file
38             from any fish logging.
39              
40             But having to modify your code right before moving it into production, or
41             modifying it to troubleshoot, can make anyone nervous. So I provided ways to
42             dynamically do this for you.
43              
44             # Called from package my::special::module ... (off by default)
45             use Fred::Fish::DBUG qw / on_if_set my_special_module_flag /;
46              
47             Is equivalant to:
48             BEGIN { require Fred::Fish::DBUG;
49             my @opt = $ENV{my_special_module_flag} ? qw / ON / : qw / OFF /;
50             Fred::Fish::DBUG->import ( @opt );
51             }
52              
53             Where if B<$ENV{my_special_module_flag}> evaluates to true you have B
54             logging available. Otherwise it isn't. Chose a name for the environment
55             variable as appropriate to your situation.
56              
57             Or you can do the reverse where it's on by default:
58              
59             use Fred::Fish::DBUG qw / off_if_set my_special_module_flag /;
60              
61             In summary all the options are:
62              
63             use Fred::Fish::DBUG qw / on /;
64             use Fred::Fish::DBUG qw / off /;
65             use Fred::Fish::DBUG qw / on_if_set EnvVar /;
66             use Fred::Fish::DBUG qw / off_if_set EnvVar /;
67             use Fred::Fish::DBUG; # Same as if qw / on / was used.
68              
69             # While enforcing a minimum version ...
70             use Fred::Fish::DBUG 2.03 qw / on /;
71              
72             =head1 TRAPPING SIGNALS IN FISH
73              
74             As an extension to the Fred Fish library, this module allows the trapping and
75             logging to B of all trappable signals for your OS. This list of signals
76             varies per OS. But the most common two being B<__DIE__> and B<__WARN__>.
77              
78             But in order to trace these signals you must first ask B to do so by
79             by first sourcing in L, and then calling
80             B. See that module for more details. You don't have to
81             use that module, but it can make thigs easier if you do.
82              
83             Just be aware that both B<__DIE__> and B<__WARN__> signals can be thrown
84             during Perl's parsing phase of your code. So care must be taken if you try
85             to trap these signals in a BEGIN block. Since if set in BEGIN these traps
86             may end up interfering with your attempts to debug your code.
87              
88             =head1 TRAPPING STDOUT AND STDERR IN FISH
89              
90             Another extension to the Fred Fish libary allowing you to trap all prints to
91             STDOUT and/or STDERR to also appear in your B logs. Implemented as a
92             wrapper to Perl's "B" feature against the SDTOUT and STDERR file handles.
93              
94             Very useful for putting prints from your program or other modules into context
95             in your fish logs. Just be aware that you may have only one B per file
96             handle. But if your code does require ties to work, this module provides a
97             way to coexist.
98              
99             See L for more details on how to enable this feature.
100              
101             =head1 FISH FOR MULTI-THREADED PERL PROGRAMS
102              
103             This module should be thread-safe as long as Perl's I command is
104             thread-safe. If threads are used, there are two ways to use this module.
105              
106             The first way is call DBUG_PUSH($file, multi=>1) in the main process and then
107             spawn your threads. This will cause all threads to write to the same B
108             file as your main program. But you'll have to use a tool such as B in
109             order to be able to trace the logic of individual threads. Thread 0 is the main
110             process. If you don't use the B option, your B log will be
111             unusable since you'll be unable to tell which thread wrote each entry in your
112             log.
113              
114             The second way is to not call DBUG_PUSH() in the main thread until after you
115             spawn all your threads. In this case you can't share the same B file
116             name. Each thread should call DBUG_PUSH($file) using a unique file name for
117             each thread's B log. Using option B is optional in this case,
118             but still recommended.
119              
120             But what happens with the B option if you reuse the same filename
121             between threads? In that case this module is B thread-safe! Each thread
122             can step on each other. You can limit the impact with a creative combination
123             of options to DBUG_PUSH(), but you can't reliably remove all the corruption
124             and dropped lines in the shared B logs. And your work around may
125             break in future releases of this module.
126              
127             As a reminder, when the main process (I) terminates, this causes
128             all the child threads to terminate as well. Even if they are still busy.
129             Also child threads do not normally call I and/or I blocks of code!
130             And all threads share the same PID.
131              
132             =head1 FISH FOR MULTI-PROCESS PERL PROGRAMS
133              
134             This is when you spawn a child process using B. In this case all
135             processes have a unique PID and each child process will call their own I
136             blocks. But otherwise it follows the same B rules as multi-threading.
137              
138             When the parent process terminates, it allows any running child process to
139             finish it's work and they can still write to B.
140              
141             To turn on fish for multi-process use DBUG_PUSH($file, multi=>1) as well.
142              
143             =head1 FURTHER INFORMATION
144              
145             Not all Perl implementations support mutli-threading and/or multi-processing.
146             So if you are not using multi-threading or multi-processing, I recommend
147             I using the B option.
148              
149             =head1 USING GOTO STATEMENTS
150              
151             Using a B can cause B issues where the return statements get out
152             of sync with the proper function entry points in your B logs. This is
153             because calls like B jump to MyFunction's entry
154             point, and removes the function using B from Perl's stack as if it was
155             never there.
156              
157             Currently the only fix for this is to not use B and
158             the corresponding B methods in functions that use B.
159             Limit yourself to calls to B in those methods instead.
160              
161             Your other choice is to reorganize your code to avoid using the B
162             statement in the first place.
163              
164             A common place you'd see a B is if you used the I function.
165             But even there, there are alternatives to using the B if you want
166             clean B logging.
167              
168             =head1 USING THIS MODULE IN A CPAN MODULE
169              
170             When you upload a module using B to CPAN, you probably don't want your
171             code trace being dumped to an end user's B logs by default. So I
172             recommend doing the following in your code so that "make test" will still have
173             B turned on, while normal usage won't trace in B.
174              
175             use Fred::Fish::DBUG qw / on_if_set my_special_module_flag /;
176              
177             For an explination on how this works, reread the POD above.
178              
179             =head1 FUNCTIONS
180              
181             =over 4
182              
183             =cut
184              
185             package Fred::Fish::DBUG;
186              
187 37     37   662777 use strict;
  37         88  
  37         1488  
188 37     37   210 use warnings;
  37         67  
  37         2514  
189              
190 37     37   218 use vars qw( @ISA @EXPORT @EXPORT_OK $VERSION );
  37         121  
  37         2938  
191 37     37   250 use Exporter;
  37         169  
  37         76923  
192              
193             $VERSION = "2.10";
194             @ISA = qw( Exporter );
195              
196             # ------------------------------------------------------------------------------
197             # When this module inherits from Fred::Fish::DBBUG::ON or Fred::Fish::DBUG::OFF,
198             # the special var @EXPORT will contain both functions and constant vars after
199             # import() is called.
200             #
201             # So "use Fred::Fish::DBUG;" Works just fine.
202             #
203             # require Fred::Fish::DBUG; Nothing available yet.
204             # Fred::Fish::DBUG->import (); Makes everything available for use.
205             #
206             # Everything exported for public use will always be named in upper case!
207             # ------------------------------------------------------------------------------
208             # The others were written to help the t/*.t programs validate that this module
209             # worked as advertised. Exposing them would just polute Perl's name space and
210             # perhaps confuse people when they don't always work.
211             # ------------------------------------------------------------------------------
212              
213             @EXPORT = qw( );
214             @EXPORT_OK = qw( );
215              
216             # Tells which module we are acting on.
217             # Only set during the call to import()!
218             # Must be a hash to allow for mixing & matching modes between files!
219             my %global_fish_module;
220              
221             # So we can dynamically swap between
222             # Fred::Fish::DBUG::ON & Fred::Fish::DBUG::OFF
223             # Is automatically called in most cases after BEGIN is called.
224             sub import
225             {
226             # Assuming: Fred::Fish::DBUG->import ()
227 77     77   15887 my $pkg = shift;
228 77         180 my $mode = shift;
229 77         176 my $env_var = shift;
230              
231             # Fred::Fish::DBUG::import () after all.
232 77 50       332 if ( $pkg ne __PACKAGE__ ) {
233 0         0 $env_var = $mode;
234 0         0 $mode = $pkg;
235 0         0 $pkg = __PACKAGE__;
236             }
237              
238             # print STDERR "use $pkg qw ($mode $env_var)\n";
239              
240 77 100       319 my $umode = $mode ? uc ($mode) : "ON";
241              
242 77         135 my $on_flag;
243              
244 77 100 66     229 if ( $umode eq "ON" ) {
    100          
    50          
245 71         132 $on_flag = 1;
246              
247             } elsif ( $umode eq "OFF" ) {
248 4         24 $on_flag = 0;
249              
250             } elsif ( $umode eq "ON_IF_SET" || $umode eq "OFF_IF_SET" ) {
251 2 50       8 if (! defined $env_var ) {
252 0         0 die ( "\nMissing required environment variable to use when '$mode' is used!\n",
253             "Syntax: use $pkg qw / $mode env_var_name /",
254             "\n\n" );
255             }
256 2 100 66     14 my $set = ( exists $ENV{$env_var} && $ENV{$env_var} ) ? 1 : 0;
257 2 100       6 if ( $umode eq "ON_IF_SET" ) {
258 1         2 $on_flag = $set;
259             } else {
260 1 50       5 $on_flag = $set ? 0 : 1;
261             }
262              
263             } else {
264 0 0       0 my $env = (defined $env_var) ? $env_var : "";
265 0         0 die ( "\nuse $pkg qw / $mode $env /; --- Unknown module option!\n\n" );
266             }
267              
268 77         135 my @imports;
269 77         134 my $fish_module = __PACKAGE__ . "::";
270              
271 77         148 my $minVer = 2.10;
272 77 100       188 if ( $on_flag ) {
273 73         223 $fish_module .= "ON";
274 73         3377 require Fred::Fish::DBUG::ON;
275 73         1609 Fred::Fish::DBUG::ON->VERSION ($minVer);
276 73         1268 @imports = @Fred::Fish::DBUG::ON::EXPORT;
277             } else {
278 4         10 $fish_module .= "OFF";
279 4         2235 require Fred::Fish::DBUG::OFF;
280 4         100 Fred::Fish::DBUG::OFF->VERSION ($minVer);
281 4         32 @imports = @Fred::Fish::DBUG::OFF::EXPORT;
282             }
283              
284             # Get the list of functions from the appropriate module.
285 77         1039 push (@EXPORT, @imports);
286              
287             # print STDERR "\n", join (", ", @EXPORT), "\n\n";
288              
289             # Make everything loaded public ...
290 77         324 my $caller = caller();
291 77         16620 ${fish_module}->export ($caller);
292              
293             # Determine which file the call to import happened in!
294 77         356 my $which = _find_key ();
295              
296             # print STDERR "\n -------> File: $which\n\n"; _print_trace ();
297              
298 77         239 $global_fish_module{$which} = $fish_module;
299              
300 77         3325 return;
301             }
302              
303             # The key is the filename of the program that did "use Fred::Fish::DBUG"
304             # So we can say which module we inherited from this time.
305             sub _find_key
306             {
307 77     77   148 my $idx = 1;
308              
309 77         418 my $key = (caller ($idx))[1];
310 77   66     797 while ( defined $key && ( $key =~ m/^[(]eval/ || $key =~ m/DBUG.pm$/ ) ) {
      33        
311 105         722 $key = (caller (++$idx))[1];
312             }
313 77         207 return ( $key );
314             }
315              
316             # Used to debug _find_key () ...
317             sub _print_trace
318             {
319 0     0   0 my $idx = 0;
320 0         0 my ($pkg, $f, $s) = (caller ($idx))[0, 1, 3];
321 0         0 print STDERR "\n$idx: $pkg --> $f --> $s\n";
322 0         0 while ( $pkg ) {
323 0         0 ($pkg, $f, $s) = (caller (++$idx))[0, 1, 3];
324 0 0       0 print STDERR "$idx: $pkg --> $f --> $s\n" if (defined $pkg);
325             }
326 0         0 print STDERR "\n";
327 0         0 return;
328             }
329              
330             # ==============================================================================
331             # Start of Helper methods designed to help test out this module's functionality.
332             # ==============================================================================
333              
334             # ==============================================================
335             # Not exposed on purpose, so they won't polute the naming space!
336             # Or have people trying to use them!
337             # ==============================================================
338             # Undocumented helper functions exclusively for use by the "t/*.t" programs.
339             # Not intended for use by anyone else.
340             # So subject to change without notice!
341             # They are used to help these test programs validate that this module is working
342             # as expected without having to manually examine the fish logs for everything!!
343             # But despite everything, some manual checks will always be needed!
344             # ==============================================================
345             # Most of these test functions in Fred::Fish::DBUG:OFF are broken and do not
346             # work there unless you lie and use the $hint arguments! So it's another
347             # reason not to use them in your own code base!
348             # In fact many of these test functions in this module are broken as well if fish
349             # was turned off or paused when the measured event happened.
350             # ==============================================================
351             # NOTE: Be carefull how they are called in the t/*.t programs.
352             # Always call as Fred::Fish::DBUG::func();
353             # never as Fred::Fish::DBUG->func();
354             # ==============================================================
355              
356             # This is the only method that knows about "other" instances ...
357             sub dbug_module_used
358             {
359 144     144 0 24392 my $key = shift; # Pass __FILE__ sourcing in this module ...
360              
361             # If not provided determine where func was called from.
362 144 100       736 unless ( defined $key ) {
363 4         23 my $idx = 0;
364 4         32 my ($caller_pkg, $caller_file, $this_func) = (caller ($idx))[0, 1, 3];
365             # print STDERR "\n$idx: $caller_pkg --> $caller_file --> $this_func\n";
366 4         12 $key = $caller_file;
367             }
368              
369 144         449 my $fish_module = _find_module ($key);
370 144 100       734 return ( wantarray ? ($fish_module, $key) : $fish_module );
371             }
372              
373             sub find_all_fish_users
374             {
375 7     7 0 630 return ( %global_fish_module );
376             }
377              
378             sub _find_module
379             {
380 534     534   2044 my $key = shift;
381 534   100     2036 my $mod = $global_fish_module{$key} || 'Fred::Fish::DBUG::Unknown';
382 534 100       2217 if ( $mod =~ m/::Unknown$/ ) {
383 3         1293 print STDERR "# Fred::Fish::DBUG Warning: Unknown user module: ${key}\n";
384             }
385 534         1318 return ( $mod );
386             }
387              
388             # ==================================================================
389             # The remaining functions only work against the "current" instance!
390             # ==================================================================
391              
392             # The current FISH function on the fish stack ...
393             sub dbug_func_name
394             {
395 68     68 0 941 my $hint = shift; # Only used in OFF.pm ...
396              
397 68         572 my ($pkg, $file, $this_func) = (caller (0))[0, 1, 3];
398 68         278 my $fish_module = _find_module ($file);
399              
400 68         564 my $func = ${fish_module}->can ('dbug_func_name');
401 68         387 return ( $func->( $hint ) ); # A name ...
402             }
403              
404             # Number of fish functions on the stack
405             # This one is used internally as well.
406             sub dbug_level
407             {
408 264     264 0 3516 my $hint = shift; # Only used in OFF.pm ...
409              
410 264         2306 my ($pkg, $file, $this_func) = (caller (0))[0, 1, 3];
411 264         1348 my $fish_module = _find_module ($file);
412              
413 264         2662 my $func = ${fish_module}->can ('dbug_level');
414 264 50       816 if (! defined $func) { return(-100); } # Hack.
  0         0  
415              
416 264         1175 return ( $func->( $hint ) ); # A count ...
417             }
418              
419             # This value is set via the calls to
420             # DBUG_RETURN() / DBUG_VOID_RETURN() / DBUG_RETURN_SPECIAL().
421             # It can only be non-zero if DBUG_MASK() was called 1st and only for
422             # DBUG_RETURN(). If fish is turned off it will be -1. Otherwise
423             # it will be a count of the masked values in fish!
424             # In all other situations it will return zero!
425              
426             sub dbug_mask_return_counts
427             {
428 9     9 0 88 my $hint = shift; # Only used in OFF.pm ...
429              
430 9         68 my ($pkg, $file, $this_func) = (caller (0))[0, 1, 3];
431 9         30 my $fish_module = _find_module ($file);
432              
433 9         124 my $func = ${fish_module}->can ('dbug_mask_return_counts');
434 9         35 return ( $func->( $hint ) ); # A count ...
435             }
436              
437             # This value is set via the last call to DBUG_ENTER_FUNC() / DBUG_ENTER_BLOCK()
438             # when it prints it's masked arguments to fish. If the write to fish doesn't
439             # happen the count will be -1!
440             # To decide what needs to be masked, you must call DBUG_MASK_NEXT_FUNC_CALL() 1st!
441             # Otherwise it will always be zero!
442              
443             sub dbug_mask_argument_counts
444             {
445 17     17 0 236 my $hint = shift; # Only used in OFF.pm ...
446              
447 17         130 my ($pkg, $file, $this_func) = (caller (0))[0, 1, 3];
448 17         68 my $fish_module = _find_module ($file);
449              
450 17         151 my $func = ${fish_module}->can ('dbug_mask_argument_counts');
451 17         59 return ( $func->( $hint ) ); # A count ...
452             }
453              
454             # These 3 actually work in Fred::Fish::DBUG::OFF as well!
455             sub dbug_threads_supported
456             {
457 1     1 0 12 my ($pkg, $file, $this_func) = (caller (0))[0, 1, 3];
458 1         4 my $fish_module = _find_module ($file);
459              
460 1         9 my $func = ${fish_module}->can ('dbug_threads_supported');
461 1         4 return ( $func->() ); # A boolean result ... 1/0
462             }
463              
464             sub dbug_fork_supported
465             {
466 15     15 0 236 my ($pkg, $file, $this_func) = (caller (0))[0, 1, 3];
467 15         75 my $fish_module = _find_module ($file);
468              
469 15         233 my $func = ${fish_module}->can ('dbug_fork_supported');
470 15         60 return ( $func->() ); # A boolean result ... 1/0
471             }
472              
473             sub dbug_time_hires_supported
474             {
475 2     2 0 50 my ($pkg, $file, $this_func) = (caller (0))[0, 1, 3];
476 2         9 my $fish_module = _find_module ($file);
477              
478 2         24 my $func = ${fish_module}->can ('dbug_time_hires_supported');
479 2         10 return ( $func->() ); # A boolean result ... 1/0
480             }
481              
482             # Internal functions some tests sometimes need access to ...
483             sub dbug_called_by
484             {
485 10     10 0 85 my ($pkg, $file, $this_func) = (caller (0))[0, 1, 3];
486 10         26 my $fish_module = _find_module ($file);
487              
488 10         115 my $func = ${fish_module}->can ('_dbug_called_by');
489 10         29 return ( $func->( @_ ) ); # A name ...
490             }
491              
492             sub dbug_indent
493             {
494 1     1 0 8 my $msg = shift;
495 1 50       5 $msg = "" unless (defined $msg);
496              
497 1         8 my ($pkg, $file, $this_func) = (caller (0))[0, 1, 3];
498 1         46 my $fish_module = _find_module ($file);
499              
500 1         10 my $func = ${fish_module}->can ('_indent');
501 1 50       4 return ($msg) unless (defined $func);
502 1         5 return ( $func->( $msg, @_ ) ); # A string ...
503             }
504              
505             sub dbug_stack_trace
506             {
507 2   50 2 0 23 my $msg = shift || "";
508              
509 2         10 my ($pkg, $file, $this_func) = (caller (0))[0, 1, 3];
510 2         6 my $fish_module = _find_module ($file);
511              
512 2         14 my $func = ${fish_module}->can ('_dbug_stack_trace');
513 2 50       7 return (0) unless (defined $func);
514              
515 0           my $cnt = $func->(1, $msg);
516 0           return ($cnt); # Count of eval levels detected.
517             }
518              
519             # ------------------------------------------------------------------------------
520             # Fred::Fish::DBUG POD
521             #
522             # I have tried to keep the POD functions in a meaningfull order. And keep the
523             # functions in Fred::Fish::DBUG:ON & Fred::Fish::DBUG::OFF in the same order.
524             # Hopefully this should make it easier to learn how to use & maintain this module.
525             #
526             # There is no actual code below this line, only POD text!
527             # ------------------------------------------------------------------------------
528              
529             =item DBUG_PUSH ( [$file [, %opts]] )
530              
531             Calling this function turns logging on so that all future DBUG B calls are
532             written to the requested file. Failure to call this function results in nothing
533             being written to the B logs. Currently there is no way to turn B
534             back off again except by aborting the program. But there are ways to turn
535             some of the logging off.
536              
537             You are expected to provide a filename to write the fish logs to. If
538             that file already exists, this function will recreate the B file and
539             write as its first log message that this happened. By default, the B
540             log's file permissions allow anyone to read the log file no matter the current
541             I settings.
542              
543             But if you fail to provide a filename, B will instead be written to
544             I. You may also use an open file handle or I reference instead
545             of a filename and B would be written there instead.
546              
547             The options hash may be passed by either reference or value. Either way works.
548             Most options are ignored unless you also gave it a filename to open.
549             Most option's value is a flag telling if it's turned on (1) or off (0), and
550             most options default to off unless otherwise specified. The valid options are:
551              
552             =over 4
553              
554             B - Open an old B log in append mode instead of creating a new
555             one.
556              
557             B - Turn autoflush on/off. By default it's turned on!
558              
559             B - Turn auto-open on/off. Causes each call to a B function to
560             auto-reopen the B log, write out its message, and then close the B
561             file again.
562              
563             B - If set, treat as if I was never called! (IE: Fish is off.)
564             It overrides all other options.
565              
566             B - See I for more details.
567              
568             B - Suppress the B logging for the Perl B blocks.
569              
570             B - Adds I to the end of the enter function
571             block. So you can locate the code making the call. Also added to the end of
572             I messages.
573              
574             B - Turns on/off writing process ownership info to the start of each line
575             of the B log. For multi-thread programs this is B-B.
576             Ex: 252345-0 is the main process && 252345-4 is the 4th thread spawned by the
577             process. But if it's a forked process it would be B/B<2-digits>.
578             Ex: 252345/00 is the main process. And 536435/35 is one of its forked child
579             processes. There are no sequential ids for forked processes, nor is the 2-digit
580             code guaranteed to be unique.
581              
582             B - If your program is multi-threaded or muli-process, use this option to
583             limit what gets written to B. B<1> - Limit B to the parent process.
584             B<0> - Write everything (default). B<-1> - Limit B to the child processes.
585              
586             B - Override the default B file permissions. Default is B<0644>.
587             It ignores the current I settings!
588              
589             B - Normally the 1st call to I is after the call to
590             I, but set to B if you've already called it. But you will lose
591             printing the function arguments if you do it this way.
592              
593             B - Strip off the module name for I and the various
594             return methods. So I becomes I in B.
595              
596             B - Number of seconds to sleep after calling I in your code.
597             The delay only happens if the write to B actually happens.
598             If I is installed you can sleep for fractions of a second. But if
599             it isn't installed your time will be truncated. IE: 0.5 becomes 0.
600              
601             B - Prints the elapsed time inside the function once any DBUG return
602             function is called. If I is installed it tracks to fractions of a
603             second. Otherwise it's whole seconds only.
604              
605             B - (1/0/code ref) - (1) Keep your B log only if your program exits
606             with a non-zero exit status. (0) Always keep your B log (default).
607             Otherwise it calls your function with the exit status as it's single argument.
608             It's expected to return B<1> to keep the B log or B<0> to toss it. This
609             code ref is only called if there is a B log to potentially remove.
610              
611             B - (1/0) - (0) Default, print variable reference addresses like
612             S which change between runs. (1) Suppress addresses so shows
613             up like S so it's easier to compare fish files between runs. Only
614             works for arguments and return values.
615              
616             B - Writes to B in UTF-8 mode. Use if you get warnings
617             about writing S<'Wide character in print'> to B.
618              
619             =back
620              
621             =cut
622              
623             # ==============================================================
624              
625             =item DBUG_POP ( )
626              
627             Not yet implemented.
628              
629             =cut
630              
631             # ==============================================================
632              
633             =item DBUG_ENTER_FUNC ( [@arguments] )
634              
635             Its expected to be called whenever you enter a function. You pass all the
636             arguments from the calling function to this one (B<@_>). It automatically
637             knows the calling function without having to be told what it is.
638              
639             To keep things in the B logs balanced, it expects you to call one of the
640             I variant methods when exiting your function!
641              
642             This function also works when called inside named blocks such as B blocks
643             or even try/catch blocks.
644              
645             It returns the name of the calling function. In rare cases this name can be
646             useful.
647              
648             See I should you need to mask any arguments!
649              
650             =cut
651              
652             # ==============================================================
653              
654             =item DBUG_ENTER_BLOCK ( $name[, @arguments] )
655              
656             Similar to I except that it deals with I blocks of
657             code. Or if you wish to call a particular function a different name in the
658             B logs.
659              
660             It usually expects you to call I when the block goes out of
661             scope to keep the B logs balanced. But nothing prevents you from using
662             one of the other return variants instead.
663              
664             It returns the name of the code block you used. In rare cases this name can
665             be useful.
666              
667             =cut
668              
669             # ==============================================================
670              
671             =item DBUG_PRINT ( $tag, $fmt [, $val1 [, $val2 [, ...]]] )
672              
673             This function writes the requested message to the active B log.
674              
675             The B<$tag> argument is a text identifier that will be used to 'tag' the line
676             being printed out and enforce any requested filtering and/or coloring.
677              
678             The remaining arguments are the same as what's passed to L if given a
679             B<$fmt> and one or more values. But if no values are given then it's treated
680             as a regular call to L.
681              
682             If the formatted message should be terminated by multiple B<\n>, then it will
683             be truncated to a single B<\n>. All trailing whitespace on each line will be
684             removed as well.
685              
686             It returns the formatted message written to fish and it will always end in
687             B<\n>. This message doesn't include the I<$tag> or the optional caller info
688             if the I option was used by B.
689              
690             This message is returned even if fish is currently turned off!
691              
692             B: If this request resulted in a write to B, and you asked for a
693             B in I, this function will sleep the requested number of
694             seconds before returning control to you. If no write, then no delay!
695              
696             =cut
697              
698             # ==============================================================
699              
700             =item DBUG_RETURN ( ... )
701              
702             It takes the parameter(s) passed as arguments and uses them as the return
703             values to the calling function similar to how perl's return command works.
704             Except that it also writes what is being returned to B. Since this is a
705             function, care should be taken if called from the middle of your function's
706             code. In that case use the syntax:
707             S<"return DBUG_RETURN( value1 [, value2 [, ...]] );">.
708              
709             It uses Perl's B feature to determine what to print to B and
710             return to the calling function. IE scalar mode (only the 1st value) or list
711             mode (all the values in the list). Which is not quite what many perl developers
712             might expect.
713              
714             EX: return (wantarray ? (value1, value2, ...) : value1);
715              
716             If I was called, it will mask the appropriate return value(s)
717             as: B******E>>.
718              
719             =cut
720              
721             # ==============================================================
722              
723             =item DBUG_ARRAY_RETURN ( @args )
724              
725             A variant of S<"DBUG_RETURN()"> that behaves the same as perl does natively when
726             returning a list to a scalar. IE it returns the # of elements in the @args
727             array.
728              
729             It always assumes @args is a list, even when provided a single scalar value.
730              
731             =cut
732              
733             # ==============================================================
734              
735             =item DBUG_VOID_RETURN ( )
736              
737             Terminates the current block of B code. It doesn't return any value back
738             to the calling function.
739              
740             =cut
741              
742             # ==============================================================
743              
744             =item DBUG_RETURN_SPECIAL ( $scalar, @array )
745              
746             This I variant allows you to differentiate between what to return
747             when your function is called in a scalar context vs an array context vs void
748             context.
749              
750             If called in an array context, the return value is equivalent to
751             S.>
752              
753             If called in a scalar context, the return value is equivalent to
754             S.> With a few special case exceptions.
755              
756             =over
757              
758             Special case # 1: If I<$scalar> is set to the predefined constant value
759             B, it returns the equivalent to
760             S.> Feel free to modify the contents of the referenced
761             array, it can't hurt anything. It's a copy.
762              
763             Special case # 2: If I<$scalar> is set to the predefined constant value
764             B, it returns the equivalent to
765             S,> the number of elements in the array.
766              
767             Special case # 3: If I<$scalar> is set to the predefined constant value
768             B, it returns the equivalent to
769             S,> the last element in the array.
770              
771             Special case # 4: If I<$scalar> is a CODE ref, it returns the equivalent to
772             S(@array)))>.>
773              
774             =back
775              
776             If called in a void context, the return value is equivalent to
777             S.> But in some cases it will print additional
778             information to B. But it will B call the CODE reference
779             when called in void context.
780              
781             =cut
782              
783             # ==============================================================
784              
785             =item DBUG_LEAVE ( [$status] )
786              
787             This function terminates your program with a call to I. It expects a
788             numeric argument to use as the program's I<$status> code, but will default to
789             zero if it's missing. It is considered the final return of your program.
790              
791             Only module B and B blocks can be logged after this function is
792             called as Perl cleans up after itself, unless you turned this feature off with
793             option B when B was first enabled.
794              
795             =cut
796              
797             # ==============================================================
798              
799             =item DBUG_CATCH ( )
800              
801             This function rebalances the B function trace after trapping B from
802             an B or B code block.
803              
804             If using B, place this function call inside the S> section
805             after each B block of code.
806              
807             If using B/B, place this function inside the B block instead.
808              
809             But if you don't call this function, the B logs will still try to auto
810             rebalance itself. But you loose why this happens and it I mischaracterize
811             why it did so in the B logs. It implies you trapped an B or B
812             event.
813              
814             So calling this function is in most cases optional. One of the few times it
815             could be considered required is if you used the B option to
816             I. In that case failure to immediately call it could affect your
817             timings when the rebalancing gets deferred until the next DBUG call.
818              
819             =cut
820              
821             # ==============================================================
822              
823             =item DBUG_PAUSE ( )
824              
825             Temporarily turns B off until the pause request goes out of scope. This
826             allows you to conditionally disable B for particularly verbose blocks of
827             code or any other reason you choose.
828              
829             The scope of the pause is defined as the previous call to a I
830             function variant and it's coresponding call to a I variant.
831              
832             While the pause is active, calling it again does nothing.
833              
834             =cut
835              
836             # ==============================================================
837              
838             =item DBUG_MASK ( @offsets )
839              
840             Sometimes the return value(s) returned by I and/or it's variants
841             contain sensitive data that you wouldn't want to see recorded in a B file.
842             Such as user names and passwords. So we need a way to mask these values without
843             the programmer having to jump through too many hoops to do so.
844              
845             So this function tells the I call that goes with the most recent
846             I variant which of its return values to mask. So if you have
847             multiple exit points to the current function, this one call handles the masking
848             for them all.
849              
850             The I<@offsets> array consists of 1 or more integers representing the offset to
851             expected return values. Or the special case of B<-1> to say mask all return
852             values.
853              
854             So I would cause I to mask the 1st and 3rd elements
855             being returned.
856              
857             If you pass a non-numeric value, it will assume that the return value is a hash
858             and that you are providing a hash key who's value needs to be masked.
859              
860             So if you say I, it might return
861             B*****E], [ONE], [1]>>. And since there is no key "THREE"
862             in your hash, nothing was masked for it. And as you can see, we only mask the
863             value, not the key itself! The key is case sensitive, so "two" wouldn't have
864             matched anything. Also remember that the order of the keys returned is random,
865             so pure numeric offsets wouldn't give you the desired results.
866              
867             We could have combined both examples with I.
868              
869             =cut
870              
871             # ==============================================================
872              
873             =item DBUG_MASK_NEXT_FUNC_CALL ( @offsets )
874              
875             Sometimes some arguments passed to I contain sensitive data
876             that you wouldn't want to see recorded in a B file. Such as user names
877             and passwords. So we need a way to mask these values without the programmer
878             having to jump through too many hoops to do so.
879              
880             So this function tells the next I or I call
881             which arguments are sensitive. If you call it multiple times before the next
882             time the enter function is called it will only remember the last time called!
883              
884             The I<@offsets> array consists of 1 or more integers representing the offset to
885             expected arguments. Or the special case of B<-1> to say mask all arguments
886             passed. Any other negative value will be ignored.
887              
888             But should any offset be non-numeric, it assumes one of the arguments was a
889             hash I with that string as it's key. And so it will mask the
890             next value after it if the key exists. Needed since the order of hash keys is
891             random. Also in this case the hash key is case insensitive. So "abc" and "ABC"
892             represent the same hash key.
893              
894             So I would cause I
895             to mask the 1st and 3rd elements passed to it as well as the next argument
896             after the "password" key.
897              
898             Any invalid offset value will be silently ignored.
899              
900             =cut
901              
902             # ==============================================================
903              
904             =item DBUG_FILTER ( [$level] )
905              
906             This function allows you to filter out unwanted messages being written to
907             B. This is controlled by the value of I<$level> being passed to
908             this method. If you never call this method, by default you'll get
909             everything.
910              
911             If you call it with no I<$level> provided, the current level will remain
912             unchanged!
913              
914             It returns up to two values: (old_level, new_level)
915              
916             The old_level may be -1 if it was previously using custom filtering.
917              
918             The valid levels are defined by the following exposed constants:
919              
920             =over 4
921              
922             B - Just the function entry and exit points.
923              
924             B - Add on the function arguments & return values.
925              
926             B - Add on DBUG_PRINT calls with ERROR as their tag.
927              
928             B - Add on trapped writes to STDOUT & STDERR.
929              
930             B - Add on DBUG_PRINT calls with WARN or WARNING as
931             their tag.
932              
933             B - Add on DBUG_PRINT calls with DEBUG or DBUG as
934             their tag.
935              
936             B - Add on DBUG_PRINT calls with INFO as their tag.
937              
938             B - Include everything! (default)
939              
940             B - Include Fred::Fish::DBUG diagnostics.
941              
942             =back
943              
944             =cut
945              
946             # ==============================================================
947              
948             =item DBUG_CUSTOM_FILTER ( @levels )
949              
950             This function allows you to customize which filter level(s) should appear in
951             your B logs. You can pick and choose from any of the levels defined by
952             I. If you provide an invalid level, it will be silently ignored.
953             Any level not listed will no longer appear in B.
954              
955             =cut
956              
957             # ==============================================================
958              
959             =item DBUG_CUSTOM_FILTER_OFF ( @levels )
960              
961             This function is the reverse of I. Instead of specifying
962             the filter levels you wish to see, you specify the list of levels you don't
963             want to see. Sometimes it's just easier to list what you don't want to see
964             in B.
965              
966             =cut
967              
968             # ==============================================================
969              
970             =item DBUG_SET_FILTER_COLOR ( $level [, @color_attr] )
971              
972             This method allows you to control what I to use when printing to the
973             B logs for each filter I. Each I may use different
974             I or repeat the same I between I.
975              
976             See I above to see what the valid levels are.
977              
978             See L for what I strings are available. But I
979             or the empty string means to use no I information. (default) You may
980             use strings like ("red on_yellow") or ("red", "on_yellow") or even use the color
981             constants (RED, ON_YELLOW).
982              
983             If L is not installed, this method does nothing. If you set
984             I<$ENV{ANSI_COLORS_DISABLED}> to a non-zero value it will disable your I
985             choice as well.
986              
987             Returns B<1> if the color request was accepted, else B<0>.
988              
989             =cut
990              
991             # ==============================================================
992              
993             =item DBUG_ACTIVE ( )
994              
995             This function tells you if B is currently turned on or not.
996              
997             It will return B<0> if I was never called, called with
998             S 1>>, or if I is currently in effect. It ignores
999             any filter request.
1000              
1001             It will return B<1> if B is currently writing to a file.
1002              
1003             It will return B<-1> if B is currently writing to your screen via
1004             B or B.
1005              
1006             =cut
1007              
1008             # ==============================================================
1009              
1010             =item DBUG_EXECUTE ( $tag )
1011              
1012             This boolean function helps determine if a call to I using this
1013             I<$tag> would actually result in the print request being written to B
1014             or not.
1015              
1016             It returns B<1> if the I would write it to B and B<0> if for
1017             any reason it wouldn't write to B. It returns B<-1> if B is
1018             currently writing to your screena via B or B.
1019              
1020             Reasons for returning B<0> would be: Fish was turned off, pause was turned on,
1021             or you set your B filtering level too low.
1022              
1023             This way you can write conditional code based on what's being written to fish!
1024              
1025             =cut
1026              
1027             # ==============================================================
1028              
1029             =item DBUG_FILE_NAME ( )
1030              
1031             Returns the full absolute file name to the B log created by I.
1032             If I was passed an open file handle, then the file name is unknown
1033             and the empty string is returned!
1034              
1035             =cut
1036              
1037             # ==============================================================
1038              
1039             =item DBUG_FILE_HANDLE ( )
1040              
1041             Returns the file handle to the open I file created by I. If
1042             I wasn't called, or called using I, then it returns
1043             I instead.
1044              
1045             =cut;
1046              
1047             # ==============================================================
1048              
1049             =item DBUG_ASSERT ( $expression [, $always_on [, $msg]] )
1050              
1051             This function works similar to the C/C++ I function except that it
1052             can't tell you what the boolean expression was.
1053              
1054             This I is usually turned off when B isn't currently active.
1055             But you may enable it even when B is turned off by setting the
1056             I<$always_on> flag to true.
1057              
1058             If the I<$expression> is true, no action is taken and nothing is written
1059             to B.
1060              
1061             But if the I<$expression> is false, it will log the event to B and then
1062             exit your program with a status code of B<14>. Meaning this exit can't be
1063             trapped by I or I/I blocks.
1064              
1065             If you provide the optional I<$msg>, it will print out that message as well
1066             after the assert statement.
1067              
1068             These messages will be written to both B and B.
1069              
1070             =cut
1071              
1072             # ==============================================================
1073              
1074             =item DBUG_MODULE_LIST ( )
1075              
1076             This optional method writes to B all modules used by your program. It
1077             provides the module version as well as where the module was installed. Very
1078             useful when you are trying to see what's different between different installs
1079             of perl or when you need to open a CPAN ticket.
1080              
1081             =cut
1082              
1083             # ------------------------------------------------------------------------------
1084             # End of Fred::Fish::DBUG ...
1085             # ------------------------------------------------------------------------------
1086              
1087             # ==============================================================================
1088             # Start of Signal Handling Extenstion to this module ...
1089             # No longer has POD since now in separate module.
1090             # ==============================================================================
1091              
1092             # =item DBUG_TRAP_SIGNAL ( $signal, $action [, @forward_to] )
1093              
1094             # =item DBUG_FIND_CURRENT_TRAPS ( $signal )
1095              
1096             # =item DBUG_DIE_CONTEXT ( )
1097              
1098             # ==============================================================================
1099             # Start of TIE to STDOUT/STDERR Extenstion to this module ...
1100             # No longer has POD since now in separate module.
1101             # ==============================================================================
1102              
1103             # =item DBUG_TIE_STDERR ( [$callback_func [, $ignore_chaining [, $caller ]]] )
1104              
1105             # =item DBUG_TIE_STDOUT ( [$callback_func [, $ignore_chaining [, $caller ]]] )
1106              
1107             # =item DBUG_UNTIE_STDERR ( )
1108              
1109             # =item DBUG_UNTIE_STDOUT ( )
1110              
1111             # ==============================================================
1112              
1113             =back
1114              
1115             =head1 CREDITS
1116              
1117             To Fred Fish for developing the basic algorithm and putting it into the
1118             public domain! Any bugs in its implementation are purely my fault.
1119              
1120             =head1 SEE ALSO
1121              
1122             L - Is what does the actual work when fish is enabled.
1123              
1124             L - Is the stub version of the ON module.
1125              
1126             L - Allows you to trap and log STDOUT/STDERR to B.
1127              
1128             L - Allows you to trap and log signals to B.
1129              
1130             L - Allows you to implement action
1131             DBUG_SIG_ACTION_LOG for B. Really dangerous to use. Will break most
1132             code bases.
1133              
1134             L - A L wrapper to redirect test results to
1135             B.
1136              
1137             L - Sample code demonstrating using the DBUG module.
1138              
1139             =head1 COPYRIGHT
1140              
1141             Copyright (c) 2007 - 2025 Curtis Leach. All rights reserved.
1142              
1143             This program is free software. You can redistribute it and/or modify it
1144             under the same terms as Perl itself.
1145              
1146             =cut
1147              
1148             # ============================================================
1149             #required if module is included w/ require command;
1150             1;
1151