Devel-DumpTrace
view release on metacpan or search on metacpan
lib/Devel/DumpTrace.pm view on Meta::CPAN
package Devel::DumpTrace;
## no critic (NoStrict,StringyEval)
use 5.008000;
use Hash::SafeKeys;
use PadWalker;
use Scalar::Util 1.14;
use Text::Shorten;
use Devel::DumpTrace::CachedDisplayedArray;
use Devel::DumpTrace::CachedDisplayedHash;
use IO::Handle;
use File::Temp;
use Carp;
use Fcntl qw(:flock :seek);
use strict;
use warnings;
our $VERSION = '0.29';
my $Time_HiRes_avail;
my $color_avail;
BEGIN {
# process environment before Devel::DumpTrace::Const is compiled
if (defined $ENV{DUMPTRACE}) {
my $kv_splitter = $ENV{DUMPTRACE}=~/;/ ? ';' : ',';
foreach my $kv (split $kv_splitter, $ENV{DUMPTRACE}) {
my ($k,$v) = split /=/, $kv, 2;
$ENV{"DUMPTRACE_$k"} = $v;
}
}
$Time_HiRes_avail = eval 'use Time::HiRes qw(time);1' || 0;
$color_avail = eval
'use Term::ANSIColor;$Term::ANSIColor::VERSION>=3.00' || 0;
# idea from Devel::GlobalDestruction 0.13
# replace $_GLOBAL_DESTRUCTION used in earlier versions
if (defined ${^GLOBAL_PHASE}) {
eval 'sub __inGD(){${^GLOBAL_PHASE}eq q{DESTRUCT}&&__END()};1';
} else {
require B;
eval 'sub __inGD(){${B::main_cv()}==0&&__END();};1';
}
}
use Devel::DumpTrace::Const;
our $ARRAY_ELEM_SEPARATOR = ',';
our $HASH_ENTRY_SEPARATOR = ';';
our $HASH_PAIR_SEPARATOR = '=>';
our $XEVAL_SEPARATOR = ':';
our $SEPARATOR = "-------------------------------------------\n";
my $pid = $$;
our $DUMPTRACE_FH;
our $DUMPTRACE_COLOR;
our $SMART_ABBREV = 1;
our $DB_ARGS_DEPTH = 3;
our %EXCLUDE_PKG = ();
our %INCLUDE_PKG = ('main' => 1);
our @EXCLUDE_PATTERN = ('^Devel::DumpTrace', '^Text::Shorten');
our @INCLUDE_PATTERN = ();
our (%DEFERRED, $PAD_MY, $PAD_OUR, $TRACE);
our $_THREADS = 0;
our $_INIT = 0;
lib/Devel/DumpTrace.pm view on Meta::CPAN
DISPLAY_TERSE,
DISPLAY_TERSE,
DISPLAY_GABBY,
DISPLAY_GABBY,
DISPLAY_GABBY,
DISPLAY_GABBY,
DISPLAY_GABBY)[$TRACE % 10];
}
# map $TRACE variable to an abbreviation style
sub _abbrev_style_old {
return (ABBREV_SMART,
ABBREV_SMART,
ABBREV_MILD_SM,
ABBREV_NONE,
ABBREV_MILD_SM,
ABBREV_NONE,
ABBREV_NONE,
ABBREV_NONE,
ABBREV_NONE,
ABBREV_NONE,)[$TRACE % 10]
}
sub _abbrev_style_new {
return (ABBREV_SMART,
ABBREV_SMART,
ABBREV_STRONG,
ABBREV_MILD_SM,
ABBREV_MILD,
ABBREV_NONE,
ABBREV_SMART,
ABBREV_STRONG,
ABBREV_MILD_SM,
ABBREV_NONE,)[$TRACE % 10]
}
BEGIN {
*_display_style = *_display_style_old;
*_abbrev_style = *_abbrev_style_old;
}
sub _package_style {
return $TRACE >= 100;
}
sub save_pads {
my $n = shift || 0;
my $target_depth = current_depth() - $n - 1;
if ($target_depth < 0) {
Carp::cluck "save_pads: request for negative frame ",
current_depth(), " $target_depth $n at ";
return;
}
if ($n < 0) {
Carp::cluck "save_pads: request for shallow frame ",
current_depth(), " $target_depth $n at ";
return;
}
eval {
$PAD_MY = PadWalker::peek_my($n + 1);
$PAD_OUR = PadWalker::peek_our($n + 1);
1;
} or do {
Carp::confess("$@ from PadWalker: \$n=$n is too large.\n",
"Target depth was $target_depth\n");
};
# add extra data to the pads so that they can be refreshed
# at an arbitrary point in the future
$PAD_MY->{__DEPTH__} = $PAD_OUR->{__DEPTH__} = current_depth() - $n - 1;
return;
}
sub current_depth {
my $n = 0;
$n++ while caller($n);
return $n-1;
}
sub refresh_pads {
return if __inGD();
my $current = current_depth();
my $target = $PAD_MY->{__DEPTH__};
if ($current >= $target) {
save_pads($current - $target);
}
# $current < $target
return;
}
our $last_dumptrace = '';
my @dt_prefix = (" ", ### not used
"> ", ### not used
">> ", # to display current file/line/sub
">>> ", # raw statement
">>>> ", # with var substitution, before execution
">>>>> ", # with var substitution after execution
" \t ", ### not used
"> \t ", ### not used
">> \t ", ### not used
">>> \t ", # raw statetment
">>>> \t ", # with var substitution, before execution
">>>>>\t ", # with var substitution after execution
"");
sub dumptrace {
my ($n, $tab, @output) = @_;
my $dt = join ('', @output);
my $out = $dt_prefix[$n+6*!!$tab] . $dt;
if ($last_dumptrace && $dt eq $last_dumptrace) {
# duplicate
return;
}
$last_dumptrace = $dt;
if ($DUMPTRACE_COLOR) {
our $DUMPTRACE_RESET;
$out = join $/, map( $DUMPTRACE_COLOR . $_ . $DUMPTRACE_RESET,
split($/,$out)), "";
}
our $LOCKOBJ && lock(my $lock = \$LOCKOBJ);
print {$DUMPTRACE_FH} $out;
}
lib/Devel/DumpTrace.pm view on Meta::CPAN
If the C<DUMPTRACE_TIME> environment variable is set to a true value,
this module will include program runtime information with the file
and line number in all trace output. Depending on the evaluation needs
of each line of the code, the timestamp associated with a line may
be created either immediately before or immediately after the line
is executed.
If the C<DUMPTRACE_COUNT> environment variable is set to a true value,
this module will include a count with the file and line number in all
trace output, indicating how many times your program has visited a
particular line of code.
The default behaviour of C<Devel::DumpTrace> is to include the name of
the current subroutine each time the file and line number are displayed.
If C<DUMPTRACE_NO_SUB> environment variable is set to a true value,
then the subroutine name will not be displayed.
C<DUMPTRACE_TIME>, C<DUMPTRACE_PID>, C<DUMPTRACE_COUNT>, and
C<DUMPTRACE_NO_SUB> may be used separately or in any combination.
When more than one environment variable needs to be set, the caller
can use the C<DUMPTRACE> environment variable to set multiple variables
concisely. If C<$ENV{DUMPTRACE}> is set, this module will split
the variable value into key value pairs and update the other relevant
environment variables. That is,
DUMPTRACE=PID=1,FH=trace.out,EXCLPKG=My::Module
is equivalent to the longer
DUMPTRACE_PID=1 DUMPTRACE_FH=trace.out DUMPTRACE_EXCL=My::Module
If C<DUMPTRACE_COLOR> is set, and if the L<Term::ANSIColor|Term::ANSIColor>
module can be loaded, then C<Devel::DumpTrace> output will be colored in
the specified color. If your program produces output and you are writing
C<Devel::DumpTrace> output to your console, the different color of the
DumpTrace output will help the actual output from the program stand out.
Example:
DUMPTRACE_COLOR="bold yellow on_black" perl -d:DumpTrace myScript.pl
=cut
Documented in Devel/DumpTrace/PPI.pm: $ENV{DUMPTRACE_DUMB_ABBREV}
=head1 INCOMPATIBILITIES
None known.
=head1 EXPORT
Nothing is exported from this module.
=head1 DIAGNOSTICS
All output from this module is for diagnostics.
=head1 DEPENDENCIES
L<PadWalker|PadWalker> for arbitrary access to lexical variables.
L<Scalar::Util|Scalar::Util> for the reference identification
convenience methods.
=head1 BUGS AND LIMITATIONS
=head2 Parser limitations
Some known cases where the output of this module will
be incorrect or misleading include:
=head3 Multiple statements on one line
$b = 7;
$a=4; $b=++$a;
=================================
>>>>> 4=4; 7=++undef;
>>>>> 5=4; 7=++4;
All expressions on a line are evaluated, not just expressions in the statement
currently being executed. Also see the basic parser limitation below concerning
multiple lines for one statement.
=head3 Statements with chained assignments; complex assignment expressions
($a,$b) = ('','bar');
$a = $b = 'foo';
>>>>> 'foo' = 'bar' = 'foo';
$rin=$ein=3;
>> select $rout=$in,undef,$eout=$ein,0;
>>> select $rout=3,undef,undef=3,0;
>>>>> select 3=3,undef,undef=3,0;
Everything to the right of the I<first> assignment operator in a
statement is evaluated I<before> the statement is executed.
=head3 Displayed value of @_ variable is unreliable
The displayed value of C<@_> inside a subroutine is subject to
some of the issues described in L<perlfunc/"caller">:
... be aware that setting @DB::args is best effort, intended for
debugging or generating backtraces, and should not be relied upon
... a side effect of the current implementation means that effects
of shift @_ can normally be undone (but not pop @_ or other splicing,
and not if a reference to @_ has been taken, and subject to the caveat
about reallocated elements), so @DB::args is actually a hybrid of the
current state and initial state of @_ . Buyer beware.
That is, the displayed value of C<@_> inside a subroutine may be
corrupted. Different versions of Perl may have different behavior.
=head3 C<grep EXPR,LIST> and C<map EXPR,LIST> statements
C<grep EXPR,LIST> and C<map EXPR,LIST> constructions are evaluated
a single time, after the entier C<LIST> has been evaluated, and this
module does not let you drill down to how each element of the list
was evaluated with the given C<EXPR>. The constructions
lib/Devel/DumpTrace.pm view on Meta::CPAN
/expression/; # actually $_ =~ /expression/
my $self = shift; # actually my $self = shift(@_);
That is not currently a capability of this module.
=head3 Special Perl variables are not recognized
$a = join $/, 'foo', 'bar'; # ==> $a = join $/, 'foo', 'bar'
Special variables with pure alphanumeric names like C<@ARGV>, C<$_>,
and C<$1> will still be interpolated. I<Do see>
L<perlfunc/"caller"> I<for some important caveats about how>
C<@_> I<is represented by this module>.
For some of these limitations, there are easy workarounds
(break up chained assignments, put all statements on separate lines, etc.)
if you think the extra information provided by this module is worth the
effort to make your code more friendly for this module.
=head2 Other bugs or feature requests
Please report any other bugs or feature requests to
C<bug-Devel-DumpTrace at rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Devel-DumpTrace>.
I will be notified, and then you'll automatically be notified of
progress on your bug as I make changes.
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc Devel::DumpTrace
You can also look for information at:
=over 4
=item * RT: CPAN's request tracker
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Devel-DumpTrace>
=item * AnnoCPAN: Annotated CPAN documentation
L<http://annocpan.org/dist/Devel-DumpTrace>
=item * CPAN Ratings
L<http://cpanratings.perl.org/d/Devel-DumpTrace>
=item * Search CPAN
L<http://search.cpan.org/dist/Devel-DumpTrace/>
=back
=head1 SEE ALSO
L<dumpvar.pl|perl5db.pl>, as used by the Perl debugger.
L<Devel::Trace|Devel::Trace>, L<PadWalker|PadWalker>.
L<Devel::DumpTrace::PPI|Devel::DumpTrace::PPI> is part of this
distribution and provides similar functionality using L<PPI|PPI>
to parse the source code.
L<Devel::TraceVars|Devel::TraceVars> is a very similar effort to
C<Devel::DumpTrace>, but this
module handles arrays, hashes, references, objects, lexical C<our>
variables, and addresses more edge cases.
L<Tie::Trace|Tie::Trace> provides facilities to watch the values
of specific variables, including stack trace information about
where and how the variables values were changed.
Ideas from the L<Devel::GlobalDestruction> module were used to
manage output during the end game of the traced script.
=head1 AUTHOR
Marty O'Brien, E<lt>mob at cpan.orgE<gt>
=head1 LICENSE AND COPYRIGHT
Copyright 2010-2019 Marty O'Brien.
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.
See http://dev.perl.org/licenses/ for more information.
=cut
( run in 3.100 seconds using v1.01-cache-2.11-cpan-0fb53d1c279 )