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
|