package DEBUGGER; use Exporter; @ISA = qw(Exporter); # default debug settings $::debug_level = 0; $::frame = 0; $::trace = 0; # --- _check_debug_level() ---- # check if current debug level # falls within specified range # sub _check_debug_level { my ($debug_level_low, $debug_level_hi) = @_; return 1 unless @_; # check succeeded if no limit is specified. $debug_level_hi ||= $::debug_level; return (($::debug_level >= $debug_level_low) && ($::debug_level <= $debug_level_hi)); } # _check_debug_level() # --- __break(;$$) ---- # set break point. # push @EXPORT, '__break'; # public sub __break(;$$) { $DB::single = _check_debug_level(@_); } # __break() # --- __break_if(;$$$) ---- # set conditional break point. # (could also be tied to specific # debugging levels) # push @EXPORT, '__break_if'; # public sub __break_if(;$$$) { $DB::single = shift && (@_ && _check_debug_level(@_)); } # __break() # --- _init(package) ---- # initialize perl debugger # sub _init { my ($pkg) = shift; $DB::trace = $::trace; $DB::frame = $::frame; } # _init() # --- import(package, %args) ---- # process import args # sub import { my ($pkg, %args) = @_; for (qw(debug_level frame trace)) { $::{$_} = \$args{$_} if (exists $args{$_}); } __PACKAGE__->_init(); __PACKAGE__->export_to_level(1); } # import() # --- filter(fh) --------------------------------- # # input: # fh -- reference to a FileHandle handle object. # # returns next line that is free of any # debugger code. # handy for filtering any debugging code # from source files when ready to move # to production/release. # # NOTE: this subroutine assumes every debug method # call is placed on a separate line of it's own! # Otherwise, it would require a full-scale Perl # parser to accomplish the task of weeding debug # code out. # sub filter { my $fh = shift; my ($line) = ""; __break(); while ($line = <$fh>) { # quit loop if this line is not a debug code # note: look for the first ';' from the end of # the string. This will only work if the debug # statement is on a line of its own! last unless ($line =~ m/.*__break.*/); } return $line; } # filter 1; __END__ =head1 NAME DEBUGGER - Implements mechanism for setting breakpoints for interactive Perl debugger. =head1 SYNOPSIS # Tell DEBUGGER to use debug level of 2 # and also print execution frames (refer to # perldebug for more info) without # tracing the code. # use DEBUGGER ( debug_level => 2, frame => 1, # print frames (level 1) trace => 0, ); my $x = 2 * 2; # will break here if debug level falls between # 1 and 3 (inclusively). __break 1,3; # Breakpoint 1 my $s = "foobar"; __break 5; # Breakpoint 2 print "will break here iff debug level is 5\n"; # break here if $x is less than 3 # and debug_level is set to 2 __break_if $x < 5, 2; # Breakpoint 3 print "exiting...\n"; =head1 DESCRIPTION The DEBUGGER implements a simple mechanism to control interactive Perl debugger via conditional breakpoints. Interactive Perl debugger is activated by including option '-d' when executing your script with 'perl ' command. To read more on this, refer to Perl documentation on perldebugger. =head2 Setting Breakpoints Breakpoints are set inside a Perl script via a call to the two special functions __break and __break_if implemented by the DEBUGGER module. The first method is enough to set a simple non-conditional breakpoint, whereas, the latter is handy for setting up conditional breakpoints. A breakpoint may optionally be tied to a specific debug level range. For example, use DEBUGGER (debug_level => 2); print "foo"; __break; # _always_ break here! print "bar"; __break 1,2; # break here if debug level is # between 1 and 2 inclusively. # break only if condition ($x == $y) evaluates # to true __break_if $x == $y; # break if condition ($x == $y) evaluates to true # and debug_level is set to a value falling between # 2 and 5 inclusively. __break_if $x == $y, 2,5; =head1 NOTE To access __break* routines inside nested modules where DEBUGGER module is not 'use'ed explicitly, use full module name to access a breakpoint method: package FOO; myprint { DEBUGGER::__break; print "foobar!"; } 1; In fact, you may wish to use same notation in your main script where as well for increased 'verbosity' ;-) =head1 AUTHOR Vladimir Bogdanov =head2 contact: vladb@cpan.org, b_vlad@telus.net