Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

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.

gav^

Comment on Debugging with Hook::WrapSub
Download Code
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: vladb@cpan.org, b_vlad@telus.net


    _____________________
    # Under Construction

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (12)
As of 2015-07-30 17:07 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (273 votes), past polls