X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDumpvalue.pm;h=7944e78c963fde9b0cf27bc4a52d9989d43407a2;hb=bd7017d37d1ea75ed228b98d66032e165497283f;hp=5d3a9dafc2b7561354619a756af3b797e50db3c8;hpb=4c82ae22ce2b9a6d9891a286b3b4d41b58d56d4e;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/Dumpvalue.pm b/lib/Dumpvalue.pm index 5d3a9da..7944e78 100644 --- a/lib/Dumpvalue.pm +++ b/lib/Dumpvalue.pm @@ -1,8 +1,10 @@ -use 5.005_64; # for (defined ref) and $#$v and our +use 5.006_001; # for (defined ref) and $#$v and our package Dumpvalue; use strict; +our $VERSION = '1.11'; 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 @@ -227,9 +229,9 @@ sub unwrap { 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"; } @@ -238,7 +240,11 @@ sub unwrap { 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 ; @@ -423,7 +429,14 @@ EOP 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; @@ -479,6 +492,7 @@ Dumpvalue - provides screen dump of Perl data. $dumper->set(globPrint => 1); $dumper->dumpValue(\*::); $dumper->dumpvars('main'); + my $dump = $dumper->stringify($some_value); =head1 DESCRIPTION @@ -490,7 +504,7 @@ A new dumper is created by a call Recognized options: -=over +=over 4 =item C, C @@ -506,28 +520,28 @@ may be printed on one line. Whether to print contents of globs. -=item C +=item C Dump arrays holding contents of debugged files. -=item C +=item C Dump symbol tables of packages. -=item C +=item C Dump contents of "reused" addresses. -=item C, C, C +=item C, C, C Change style of string dump. Default value of C is C, 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. +I. If C is set, they will be quoted. -=item C +=item C -I rudimentally per-package memory usage dump. If set, +rudimentally per-package memory usage dump. If set, C calculates total size of strings in variables in the package. =item unctrl @@ -558,17 +572,29 @@ method and set() method (which accept multiple arguments). =head2 Methods -=over +=over 4 =item dumpValue $dumper->dumpValue($value); $dumper->dumpValue([$value1, $value2]); +Prints a dump to the currently selected filehandle. + =item dumpValues $dumper->dumpValues($value1, $value2); +Same as C< $dumper->dumpValue([$value1, $value2]); >. + +=item stringify + + my $dump = $dumper->stringify($value [,$noticks] ); + +Returns the dump of a single scalar without printing. If the second +argument is true, the return value does not contain enclosing ticks. +Does not handle data structures. + =item dumpvars $dumper->dumpvars('my_package');