-require 5.005; # For (defined ref) and $#$v
+use 5.006_001; # for (defined ref) and $#$v and our
package Dumpvalue;
use strict;
-use vars qw(%address *stab %subs);
+our $VERSION = '1.10';
+our(%address, $stab, @stab, %stab, %subs);
+# documentation nits, handle complex data structures better by chromatic
# translate control chars to ^X - Randal Schwartz
# Modifications to print types by Peter Gordon v1.0
{ no strict 'refs';
$_ = &{'overload::StrVal'}($_)
if $self->{bareStringify} and ref $_
- and defined %overload:: and defined &{'overload::StrVal'};
+ and %overload:: and defined &{'overload::StrVal'};
}
if ($tick eq 'auto') {
my $val = $v;
{ no strict 'refs';
$val = &{'overload::StrVal'}($v)
- if defined %overload:: and defined &{'overload::StrVal'};
+ if %overload:: and defined &{'overload::StrVal'};
}
($address) = $val =~ /(0x[0-9a-f]+)\)$/ ;
if (!$self->{dumpReused} && defined $address) {
if ($self->{compactDump} && !grep(ref $_, @{$v})) {
if ($#$v >= 0) {
$short = $sp . "0..$#{$v} " .
- join(" ",
- map {$self->stringify($_)} @{$v}[0..$tArrayDepth])
- . "$shortmore";
+ join(" ",
+ map {exists $v->[$_] ? $self->stringify($v->[$_]) : "empty"} ($[..$tArrayDepth)
+ ) . "$shortmore";
} else {
$short = $sp . "empty array";
}
for my $num ($[ .. $tArrayDepth) {
return if $DB::signal and $self->{stopDbSignal};
print "$sp$num ";
- $self->DumpElem($v->[$num], $s);
+ if (exists $v->[$num]) {
+ $self->DumpElem($v->[$num], $s);
+ } else {
+ print "empty slot\n";
+ }
}
print "$sp empty array\n" unless @$v;
print "$sp$more" if defined $more ;
print( (' ' x $off) . "\$", &unctrl($key), " = " );
$self->DumpElem($stab, 3+$off);
}
- if (($key !~ /^_</ or $self->{dumpDBFiles}) and defined @stab) {
+ if (($key !~ /^_</ or $self->{dumpDBFiles}) and @stab) {
print( (' ' x $off) . "\@$key = (\n" );
$self->unwrap(\@stab,3+$off) ;
print( (' ' x $off) . ")\n" );
}
- if ($key ne "main::" && $key ne "DB::" && defined %stab
+ if ($key ne "main::" && $key ne "DB::" && %stab
&& ($self->{dumpPackages} or $key !~ /::$/)
&& ($key !~ /^_</ or $self->{dumpDBFiles})
&& !($package eq "Dumpvalue" and $key eq "stab")) {
}
}
+sub CvGV_name {
+ my $self = shift;
+ my $in = shift;
+ return if $self->{skipCvGV}; # Backdoor to avoid problems if XS broken...
+ $in = \&$in; # Hard reference...
+ eval {require Devel::Peek; 1} or return;
+ my $gv = Devel::Peek::CvGV($in) or return;
+ *$gv{PACKAGE} . '::' . *$gv{NAME};
+}
+
sub dumpsub {
my $self = shift;
my ($off,$sub) = @_;
+ my $ini = $sub;
+ my $s;
$sub = $1 if $sub =~ /^\{\*(.*)\}$/;
- my $subref = \&$sub;
- my $place = $DB::sub{$sub} || (($sub = $subs{"$subref"}) && $DB::sub{$sub})
- || ($self->{subdump} && ($sub = $self->findsubs("$subref"))
- && $DB::sub{$sub});
+ my $subref = defined $1 ? \&$sub : \&$ini;
+ my $place = $DB::sub{$sub} || (($s = $subs{"$subref"}) && $DB::sub{$s})
+ || (($s = $self->CvGV_name($subref)) && $DB::sub{$s})
+ || ($self->{subdump} && ($s = $self->findsubs("$subref"))
+ && $DB::sub{$s});
+ $s = $sub unless defined $s;
$place = '???' unless defined $place;
- print( (' ' x $off) . "&$sub in $place\n" );
+ print( (' ' x $off) . "&$s in $place\n" );
}
sub findsubs {
my $self = shift;
- return undef unless defined %DB::sub;
+ return undef unless %DB::sub;
my ($addr, $name, $loc);
while (($name, $loc) = each %DB::sub) {
$addr = \&$name;
next if @vars && !grep( matchvar($key, $_), @vars );
if ($self->{usageOnly}) {
$self->globUsage(\$val, $key)
- unless $package eq 'Dumpvalue' and $key eq 'stab';
+ if ($package ne 'Dumpvalue' or $key ne 'stab')
+ and ref(\$val) eq 'GLOB';
} else {
$self->dumpglob($package, 0,$key, $val);
}
sub scalarUsage {
my $self = shift;
- my $size = length($_[0]);
+ my $size;
+ if (UNIVERSAL::isa($_[0], 'ARRAY')) {
+ $size = $self->arrayUsage($_[0]);
+ } elsif (UNIVERSAL::isa($_[0], 'HASH')) {
+ $size = $self->hashUsage($_[0]);
+ } elsif (!ref($_[0])) {
+ $size = length($_[0]);
+ }
$self->{TotalStrings} += $size;
$self->{Strings}++;
$size;
local *stab = *{$_[0]};
my $total = 0;
$total += $self->scalarUsage($stab) if defined $stab;
- $total += $self->arrayUsage(\@stab, $_[1]) if defined @stab;
+ $total += $self->arrayUsage(\@stab, $_[1]) if @stab;
$total += $self->hashUsage(\%stab, $_[1])
- if defined %stab and $_[1] ne "main::" and $_[1] ne "DB::";
+ if %stab and $_[1] ne "main::" and $_[1] ne "DB::";
#and !($package eq "Dumpvalue" and $key eq "stab"));
$total;
}
Dumpvalue - provides screen dump of Perl data.
-=head1 SYNOPSYS
+=head1 SYNOPSIS
use Dumpvalue;
my $dumper = new Dumpvalue;
Recognized options:
-=over
+=over 4
=item C<arrayDepth>, C<hashDepth>
Whether to print contents of globs.
-=item C<DumpDBFiles>
+=item C<dumpDBFiles>
Dump arrays holding contents of debugged files.
-=item C<DumpPackages>
+=item C<dumpPackages>
Dump symbol tables of packages.
-=item C<DumpReused>
+=item C<dumpReused>
Dump contents of "reused" addresses.
-=item C<tick>, C<HighBit>, C<printUndef>
+=item C<tick>, C<
quoteHighBit>, C<printUndef>
Change style of string dump. Default value of C<tick> is C<auto>, one
can enable either double-quotish dump, or single-quotish by setting it
to C<"> or C<'>. By default, characters with high bit set are printed
-I<as is>.
+I<as is>. If C<quoteHighBit> is set, they will be quoted.
-=item C<UsageOnly>
+=item C<usageOnly>
-I<very> rudimentally per-package memory usage dump. If set,
+rudimentally per-package memory usage dump. If set,
C<dumpvars> calculates total size of strings in variables in the package.
=item unctrl
=head2 Methods
-=over
+=over 4
=item dumpValue
https://perl5.git.perl.org / perl5.git / blobdiff