Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change

Debugging with Hook::WrapSub

by gav^ (Curate)
on Jun 20, 2002 at 21:10 UTC ( #176157=perlmeditation: print w/replies, xml ) Need Help??

I was tempted to call this a 'debugging trick of the week' but my last one was nearly 2 months ago :)

Basically the problem I had was in a CGI script I wanted to know what page was being displayed and if any utility subs were being used. I was just about to go through and add some debugging prints to the the top of each sub when I deicided that I had to be able to be lazy...

# turn on debugging use constant DEBUG_HOOKS => 0; if (DEBUG_HOOKS) { require Hook::WrapSub; require Devel::GetSymbols; require Data::Dump; no warnings 'once'; my $hook_pre = sub { printf "<hr><pre>Calling: <b>%s</b>\nArgs: %s</pre><hr>", $Hook::WrapSub::name, Data::Dump::dump(@_); }; my $hook_post = sub { printf "<hr><pre>Called: <b>%s</b> Result: %s</pre><hr>", $Hook::WrapSub::name, Data::Dump::dump(@Hook::WrapSub::result); }; foreach my $sub (grep /^(page|do)_/, Devel::GetSymbols::subs()) { Hook::WrapSub::wrap_subs($hook_pre, $sub, $hook_post); } }
Replace Data::Dump with your favorite (I prefer it as it is compact) and the grep to match your naming conventions.


Replies are listed 'Best First'.
Re: Debugging with Hook::WrapSub
by vladb (Vicar) on Jun 20, 2002 at 22:38 UTC
    gav^, this would only work on subroutines that match the '^(page|do)_' pattern? You could take this pattern outside and make it a piece of your 'debug' configuration:
    # turn on debugging use constant DEBUG_HOOKS => 0; use constant DEBUG_SUB_MATCH => '^(page|do)_'; if (DEBUG_HOOKS) { require Hook::WrapSub; require Devel::GetSymbols; require Data::Dump; no warnings 'once'; my $hook_pre = sub { printf "<hr><pre>Calling: <b>%s</b>\nArgs: %s</pre><hr>", $Hook::WrapSub::name, Data::Dump::dump(@_); }; my $hook_post = sub { printf "<hr><pre>Called: <b>%s</b> Result: %s</pre><hr>", $Hook::WrapSub::name, Data::Dump::dump(@Hook::WrapSub::result); }; foreach my $sub (grep /DEBUG_SUB_MATCH/, Devel::GetSymbols::subs() +) { Hook::WrapSub::wrap_subs($hook_pre, $sub, $hook_post); } }
    Otherwise, this sounds like a good way to debug Perl scripts. Some time ago, I wrote a custom DEBUGGER module to help me debug my Perl scripts. If time allows (and you let me borrow your code ;), I'll update this module to include the functionality.

    (Warning: the DEBUGGER module is in 'beta' stage. I haven't had the chance to even proof read the documentation! ;-)
    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 specifi +ed. $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 interactiv +e 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 (le +vel 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 <your script>' 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:,

    # Under Construction

Log In?

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlmeditation [id://176157]
Approved by FoxtrotUniform
Front-paged by Aristotle
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others avoiding work at the Monastery: (1)
As of 2023-06-07 21:52 GMT
Find Nodes?
    Voting Booth?
    How often do you go to conferences?

    Results (29 votes). Check out past polls.