Initial Commit
This commit is contained in:
Riley Schneider
675
database/perl/lib/Dumpvalue.pm
Normal file
675
database/perl/lib/Dumpvalue.pm
Normal file
@@ -0,0 +1,675 @@
|
||||
use 5.006_001; # for (defined ref) and $#$v and our
|
||||
package Dumpvalue;
|
||||
use strict;
|
||||
use warnings;
|
||||
our $VERSION = '1.21';
|
||||
our(%address, $stab, @stab, %stab, %subs);
|
||||
|
||||
sub ASCII { return ord('A') == 65; }
|
||||
|
||||
# This module will give incorrect results for some inputs on EBCDIC platforms
|
||||
# before v5.8
|
||||
*to_native = ($] lt "5.008")
|
||||
? sub { return shift }
|
||||
: sub { return utf8::unicode_to_native(shift) };
|
||||
|
||||
my $APC = chr to_native(0x9F);
|
||||
my $backslash_c_question = (ASCII) ? '\177' : $APC;
|
||||
|
||||
# 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
|
||||
|
||||
# Ilya Zakharevich -- patches after 5.001 (and some before ;-)
|
||||
|
||||
# Won't dump symbol tables and contents of debugged files by default
|
||||
|
||||
# (IZ) changes for objectification:
|
||||
# c) quote() renamed to method set_quote();
|
||||
# d) unctrlSet() renamed to method set_unctrl();
|
||||
# f) Compiles with 'use strict', but in two places no strict refs is needed:
|
||||
# maybe more problems are waiting...
|
||||
|
||||
my %defaults = (
|
||||
globPrint => 0,
|
||||
printUndef => 1,
|
||||
tick => "auto",
|
||||
unctrl => 'quote',
|
||||
subdump => 1,
|
||||
dumpReused => 0,
|
||||
bareStringify => 1,
|
||||
hashDepth => '',
|
||||
arrayDepth => '',
|
||||
dumpDBFiles => '',
|
||||
dumpPackages => '',
|
||||
quoteHighBit => '',
|
||||
usageOnly => '',
|
||||
compactDump => '',
|
||||
veryCompact => '',
|
||||
stopDbSignal => '',
|
||||
);
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my %opt = (%defaults, @_);
|
||||
bless \%opt, $class;
|
||||
}
|
||||
|
||||
sub set {
|
||||
my $self = shift;
|
||||
my %opt = @_;
|
||||
@$self{keys %opt} = values %opt;
|
||||
}
|
||||
|
||||
sub get {
|
||||
my $self = shift;
|
||||
wantarray ? @$self{@_} : $$self{pop @_};
|
||||
}
|
||||
|
||||
sub dumpValue {
|
||||
my $self = shift;
|
||||
die "usage: \$dumper->dumpValue(value)" unless @_ == 1;
|
||||
local %address;
|
||||
local $^W=0;
|
||||
(print "undef\n"), return unless defined $_[0];
|
||||
(print $self->stringify($_[0]), "\n"), return unless ref $_[0];
|
||||
$self->unwrap($_[0],0);
|
||||
}
|
||||
|
||||
sub dumpValues {
|
||||
my $self = shift;
|
||||
local %address;
|
||||
local $^W=0;
|
||||
(print "undef\n"), return if (@_ == 1 and not defined $_[0]);
|
||||
$self->unwrap(\@_,0);
|
||||
}
|
||||
|
||||
# This one is good for variable names:
|
||||
|
||||
sub unctrl {
|
||||
local($_) = @_;
|
||||
|
||||
return \$_ if ref \$_ eq "GLOB";
|
||||
s/([\000-\037])/'^' . chr(to_native(ord($1)^64))/eg;
|
||||
s/ $backslash_c_question /^?/xg;
|
||||
$_;
|
||||
}
|
||||
|
||||
sub stringify {
|
||||
my $self = shift;
|
||||
local $_ = shift;
|
||||
my $noticks = shift;
|
||||
my $tick = $self->{tick};
|
||||
|
||||
return 'undef' unless defined $_ or not $self->{printUndef};
|
||||
$_ = '' if not defined $_;
|
||||
return $_ . "" if ref \$_ eq 'GLOB';
|
||||
{ no strict 'refs';
|
||||
$_ = &{'overload::StrVal'}($_)
|
||||
if $self->{bareStringify} and ref $_
|
||||
and %overload:: and defined &{'overload::StrVal'};
|
||||
}
|
||||
if ($tick eq 'auto') {
|
||||
if (/[^[:^cntrl:]\n]/) { # All ASCII controls but \n get '"'
|
||||
$tick = '"';
|
||||
} else {
|
||||
$tick = "'";
|
||||
}
|
||||
}
|
||||
if ($tick eq "'") {
|
||||
s/([\'\\])/\\$1/g;
|
||||
} elsif ($self->{unctrl} eq 'unctrl') {
|
||||
s/([\"\\])/\\$1/g ;
|
||||
$_ = &unctrl($_);
|
||||
s/([[:^ascii:]])/'\\0x'.sprintf('%2X',ord($1))/eg
|
||||
if $self->{quoteHighBit};
|
||||
} elsif ($self->{unctrl} eq 'quote') {
|
||||
s/([\"\\\$\@])/\\$1/g if $tick eq '"';
|
||||
s/\e/\\e/g;
|
||||
s/([\000-\037$backslash_c_question])/'\\c'._escaped_ord($1)/eg;
|
||||
}
|
||||
s/([[:^ascii:]])/'\\'.sprintf('%3o',ord($1))/eg if $self->{quoteHighBit};
|
||||
($noticks || /^\d+(\.\d*)?\Z/)
|
||||
? $_
|
||||
: $tick . $_ . $tick;
|
||||
}
|
||||
|
||||
# Ensure a resulting \ is escaped to be \\
|
||||
sub _escaped_ord {
|
||||
my $chr = shift;
|
||||
if ($chr eq $backslash_c_question) {
|
||||
$chr = '?';
|
||||
}
|
||||
else {
|
||||
$chr = chr(to_native(ord($chr)^64));
|
||||
$chr =~ s{\\}{\\\\}g;
|
||||
}
|
||||
return $chr;
|
||||
}
|
||||
|
||||
sub DumpElem {
|
||||
my ($self, $v) = (shift, shift);
|
||||
my $short = $self->stringify($v, ref $v);
|
||||
my $shortmore = '';
|
||||
if ($self->{veryCompact} && ref $v
|
||||
&& (ref $v eq 'ARRAY' and !grep(ref $_, @$v) )) {
|
||||
my $depth = $#$v;
|
||||
($shortmore, $depth) = (' ...', $self->{arrayDepth} - 1)
|
||||
if $self->{arrayDepth} and $depth >= $self->{arrayDepth};
|
||||
my @a = map $self->stringify($_), @$v[0..$depth];
|
||||
print "0..$#{$v} @a$shortmore\n";
|
||||
} elsif ($self->{veryCompact} && ref $v
|
||||
&& (ref $v eq 'HASH') and !grep(ref $_, values %$v)) {
|
||||
my @a = sort keys %$v;
|
||||
my $depth = $#a;
|
||||
($shortmore, $depth) = (' ...', $self->{hashDepth} - 1)
|
||||
if $self->{hashDepth} and $depth >= $self->{hashDepth};
|
||||
my @b = map {$self->stringify($_) . " => " . $self->stringify($$v{$_})}
|
||||
@a[0..$depth];
|
||||
local $" = ', ';
|
||||
print "@b$shortmore\n";
|
||||
} else {
|
||||
print "$short\n";
|
||||
$self->unwrap($v,shift);
|
||||
}
|
||||
}
|
||||
|
||||
sub unwrap {
|
||||
my $self = shift;
|
||||
return if $DB::signal and $self->{stopDbSignal};
|
||||
my ($v) = shift ;
|
||||
my ($s) = shift || 0; # extra no of spaces
|
||||
my $sp;
|
||||
my (%v,@v,$address,$short,$fileno);
|
||||
|
||||
$sp = " " x $s ;
|
||||
$s += 3 ;
|
||||
|
||||
# Check for reused addresses
|
||||
if (ref $v) {
|
||||
my $val = $v;
|
||||
{ no strict 'refs';
|
||||
$val = &{'overload::StrVal'}($v)
|
||||
if %overload:: and defined &{'overload::StrVal'};
|
||||
}
|
||||
($address) = $val =~ /(0x[0-9a-f]+)\)$/ ;
|
||||
if (!$self->{dumpReused} && defined $address) {
|
||||
$address{$address}++ ;
|
||||
if ( $address{$address} > 1 ) {
|
||||
print "${sp}-> REUSED_ADDRESS\n" ;
|
||||
return ;
|
||||
}
|
||||
}
|
||||
} elsif (ref \$v eq 'GLOB') {
|
||||
$address = "$v" . ""; # To avoid a bug with globs
|
||||
$address{$address}++ ;
|
||||
if ( $address{$address} > 1 ) {
|
||||
print "${sp}*DUMPED_GLOB*\n" ;
|
||||
return ;
|
||||
}
|
||||
}
|
||||
|
||||
if (ref $v eq 'Regexp') {
|
||||
my $re = "$v";
|
||||
$re =~ s,/,\\/,g;
|
||||
print "$sp-> qr/$re/\n";
|
||||
return;
|
||||
}
|
||||
|
||||
if ( UNIVERSAL::isa($v, 'HASH') ) {
|
||||
my @sortKeys = sort keys(%$v) ;
|
||||
my $more;
|
||||
my $tHashDepth = $#sortKeys ;
|
||||
$tHashDepth = $#sortKeys < $self->{hashDepth}-1 ? $#sortKeys : $self->{hashDepth}-1
|
||||
unless $self->{hashDepth} eq '' ;
|
||||
$more = "....\n" if $tHashDepth < $#sortKeys ;
|
||||
my $shortmore = "";
|
||||
$shortmore = ", ..." if $tHashDepth < $#sortKeys ;
|
||||
$#sortKeys = $tHashDepth ;
|
||||
if ($self->{compactDump} && !grep(ref $_, values %{$v})) {
|
||||
$short = $sp;
|
||||
my @keys;
|
||||
for (@sortKeys) {
|
||||
push @keys, $self->stringify($_) . " => " . $self->stringify($v->{$_});
|
||||
}
|
||||
$short .= join ', ', @keys;
|
||||
$short .= $shortmore;
|
||||
(print "$short\n"), return if length $short <= $self->{compactDump};
|
||||
}
|
||||
for my $key (@sortKeys) {
|
||||
return if $DB::signal and $self->{stopDbSignal};
|
||||
my $value = $ {$v}{$key} ;
|
||||
print $sp, $self->stringify($key), " => ";
|
||||
$self->DumpElem($value, $s);
|
||||
}
|
||||
print "$sp empty hash\n" unless @sortKeys;
|
||||
print "$sp$more" if defined $more ;
|
||||
} elsif ( UNIVERSAL::isa($v, 'ARRAY') ) {
|
||||
my $tArrayDepth = $#{$v} ;
|
||||
my $more ;
|
||||
$tArrayDepth = $#$v < $self->{arrayDepth}-1 ? $#$v : $self->{arrayDepth}-1
|
||||
unless $self->{arrayDepth} eq '' ;
|
||||
$more = "....\n" if $tArrayDepth < $#{$v} ;
|
||||
my $shortmore = "";
|
||||
$shortmore = " ..." if $tArrayDepth < $#{$v} ;
|
||||
if ($self->{compactDump} && !grep(ref $_, @{$v})) {
|
||||
if ($#$v >= 0) {
|
||||
$short = $sp . "0..$#{$v} " .
|
||||
join(" ",
|
||||
map {defined $v->[$_] ? $self->stringify($v->[$_]) : "empty"} (0..$tArrayDepth)
|
||||
) . "$shortmore";
|
||||
} else {
|
||||
$short = $sp . "empty array";
|
||||
}
|
||||
(print "$short\n"), return if length $short <= $self->{compactDump};
|
||||
}
|
||||
for my $num (0 .. $tArrayDepth) {
|
||||
return if $DB::signal and $self->{stopDbSignal};
|
||||
print "$sp$num ";
|
||||
if (defined $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 ;
|
||||
} elsif ( UNIVERSAL::isa($v, 'SCALAR') or ref $v eq 'REF' ) {
|
||||
print "$sp-> ";
|
||||
$self->DumpElem($$v, $s);
|
||||
} elsif ( UNIVERSAL::isa($v, 'CODE') ) {
|
||||
print "$sp-> ";
|
||||
$self->dumpsub(0, $v);
|
||||
} elsif ( UNIVERSAL::isa($v, 'GLOB') ) {
|
||||
print "$sp-> ",$self->stringify($$v,1),"\n";
|
||||
if ($self->{globPrint}) {
|
||||
$s += 3;
|
||||
$self->dumpglob('', $s, "{$$v}", $$v, 1);
|
||||
} elsif (defined ($fileno = fileno($v))) {
|
||||
print( (' ' x ($s+3)) . "FileHandle({$$v}) => fileno($fileno)\n" );
|
||||
}
|
||||
} elsif (ref \$v eq 'GLOB') {
|
||||
if ($self->{globPrint}) {
|
||||
$self->dumpglob('', $s, "{$v}", $v, 1);
|
||||
} elsif (defined ($fileno = fileno(\$v))) {
|
||||
print( (' ' x $s) . "FileHandle({$v}) => fileno($fileno)\n" );
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub matchvar {
|
||||
$_[0] eq $_[1] or
|
||||
($_[1] =~ /^([!~])(.)([\x00-\xff]*)/) and
|
||||
($1 eq '!') ^ (eval {($_[2] . "::" . $_[0]) =~ /$2$3/});
|
||||
}
|
||||
|
||||
sub compactDump {
|
||||
my $self = shift;
|
||||
$self->{compactDump} = shift if @_;
|
||||
$self->{compactDump} = 6*80-1
|
||||
if $self->{compactDump} and $self->{compactDump} < 2;
|
||||
$self->{compactDump};
|
||||
}
|
||||
|
||||
sub veryCompact {
|
||||
my $self = shift;
|
||||
$self->{veryCompact} = shift if @_;
|
||||
$self->compactDump(1) if !$self->{compactDump} and $self->{veryCompact};
|
||||
$self->{veryCompact};
|
||||
}
|
||||
|
||||
sub set_unctrl {
|
||||
my $self = shift;
|
||||
if (@_) {
|
||||
my $in = shift;
|
||||
if ($in eq 'unctrl' or $in eq 'quote') {
|
||||
$self->{unctrl} = $in;
|
||||
} else {
|
||||
print "Unknown value for 'unctrl'.\n";
|
||||
}
|
||||
}
|
||||
$self->{unctrl};
|
||||
}
|
||||
|
||||
sub set_quote {
|
||||
my $self = shift;
|
||||
if (@_ and $_[0] eq '"') {
|
||||
$self->{tick} = '"';
|
||||
$self->{unctrl} = 'quote';
|
||||
} elsif (@_ and $_[0] eq 'auto') {
|
||||
$self->{tick} = 'auto';
|
||||
$self->{unctrl} = 'quote';
|
||||
} elsif (@_) { # Need to set
|
||||
$self->{tick} = "'";
|
||||
$self->{unctrl} = 'unctrl';
|
||||
}
|
||||
$self->{tick};
|
||||
}
|
||||
|
||||
sub dumpglob {
|
||||
my $self = shift;
|
||||
return if $DB::signal and $self->{stopDbSignal};
|
||||
my ($package, $off, $key, $val, $all) = @_;
|
||||
local(*stab) = $val;
|
||||
my $fileno;
|
||||
if (($key !~ /^_</ or $self->{dumpDBFiles}) and defined $stab) {
|
||||
print( (' ' x $off) . "\$", &unctrl($key), " = " );
|
||||
$self->DumpElem($stab, 3+$off);
|
||||
}
|
||||
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::" && %stab
|
||||
&& ($self->{dumpPackages} or $key !~ /::$/)
|
||||
&& ($key !~ /^_</ or $self->{dumpDBFiles})
|
||||
&& !($package eq "Dumpvalue" and $key eq "stab")) {
|
||||
print( (' ' x $off) . "\%$key = (\n" );
|
||||
$self->unwrap(\%stab,3+$off) ;
|
||||
print( (' ' x $off) . ")\n" );
|
||||
}
|
||||
if (defined ($fileno = fileno(*stab))) {
|
||||
print( (' ' x $off) . "FileHandle($key) => fileno($fileno)\n" );
|
||||
}
|
||||
if ($all) {
|
||||
if (defined &stab) {
|
||||
$self->dumpsub($off, $key);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
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) = @_;
|
||||
$off ||= 0;
|
||||
my $ini = $sub;
|
||||
my $s;
|
||||
$sub = $1 if $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) . "&$s in $place\n" );
|
||||
}
|
||||
|
||||
sub findsubs {
|
||||
my $self = shift;
|
||||
return undef unless %DB::sub;
|
||||
my ($addr, $name, $loc);
|
||||
while (($name, $loc) = each %DB::sub) {
|
||||
$addr = \&$name;
|
||||
$subs{"$addr"} = $name;
|
||||
}
|
||||
$self->{subdump} = 0;
|
||||
$subs{ shift() };
|
||||
}
|
||||
|
||||
sub dumpvars {
|
||||
my $self = shift;
|
||||
my ($package,@vars) = @_;
|
||||
local(%address,$^W);
|
||||
$package .= "::" unless $package =~ /::$/;
|
||||
*stab = *main::;
|
||||
|
||||
while ($package =~ /(\w+?::)/g) {
|
||||
*stab = defined ${stab}{$1} ? ${stab}{$1} : '';
|
||||
}
|
||||
$self->{TotalStrings} = 0;
|
||||
$self->{Strings} = 0;
|
||||
$self->{CompleteTotal} = 0;
|
||||
for my $k (keys %stab) {
|
||||
my ($key,$val) = ($k, $stab{$k});
|
||||
return if $DB::signal and $self->{stopDbSignal};
|
||||
next if @vars && !grep( matchvar($key, $_), @vars );
|
||||
if ($self->{usageOnly}) {
|
||||
$self->globUsage(\$val, $key)
|
||||
if ($package ne 'Dumpvalue' or $key ne 'stab')
|
||||
and ref(\$val) eq 'GLOB';
|
||||
} else {
|
||||
$self->dumpglob($package, 0,$key, $val);
|
||||
}
|
||||
}
|
||||
if ($self->{usageOnly}) {
|
||||
print <<EOP;
|
||||
String space: $self->{TotalStrings} bytes in $self->{Strings} strings.
|
||||
EOP
|
||||
$self->{CompleteTotal} += $self->{TotalStrings};
|
||||
print <<EOP;
|
||||
Grand total = $self->{CompleteTotal} bytes (1 level deep) + overhead.
|
||||
EOP
|
||||
}
|
||||
}
|
||||
|
||||
sub scalarUsage {
|
||||
my $self = shift;
|
||||
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;
|
||||
}
|
||||
|
||||
sub arrayUsage { # array ref, name
|
||||
my $self = shift;
|
||||
my $size = 0;
|
||||
map {$size += $self->scalarUsage($_)} @{$_[0]};
|
||||
my $len = @{$_[0]};
|
||||
print "\@$_[1] = $len item", ($len > 1 ? "s" : ""), " (data: $size bytes)\n"
|
||||
if defined $_[1];
|
||||
$self->{CompleteTotal} += $size;
|
||||
$size;
|
||||
}
|
||||
|
||||
sub hashUsage { # hash ref, name
|
||||
my $self = shift;
|
||||
my @keys = keys %{$_[0]};
|
||||
my @values = values %{$_[0]};
|
||||
my $keys = $self->arrayUsage(\@keys);
|
||||
my $values = $self->arrayUsage(\@values);
|
||||
my $len = @keys;
|
||||
my $total = $keys + $values;
|
||||
print "\%$_[1] = $len item", ($len > 1 ? "s" : ""),
|
||||
" (keys: $keys; values: $values; total: $total bytes)\n"
|
||||
if defined $_[1];
|
||||
$total;
|
||||
}
|
||||
|
||||
sub globUsage { # glob ref, name
|
||||
my $self = shift;
|
||||
local *stab = *{$_[0]};
|
||||
my $total = 0;
|
||||
$total += $self->scalarUsage($stab) if defined $stab;
|
||||
$total += $self->arrayUsage(\@stab, $_[1]) if @stab;
|
||||
$total += $self->hashUsage(\%stab, $_[1])
|
||||
if %stab and $_[1] ne "main::" and $_[1] ne "DB::";
|
||||
#and !($package eq "Dumpvalue" and $key eq "stab"));
|
||||
$total;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Dumpvalue - provides screen dump of Perl data.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Dumpvalue;
|
||||
my $dumper = Dumpvalue->new;
|
||||
$dumper->set(globPrint => 1);
|
||||
$dumper->dumpValue(\*::);
|
||||
$dumper->dumpvars('main');
|
||||
my $dump = $dumper->stringify($some_value);
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
=head2 Creation
|
||||
|
||||
A new dumper is created by a call
|
||||
|
||||
$d = Dumpvalue->new(option1 => value1, option2 => value2)
|
||||
|
||||
Recognized options:
|
||||
|
||||
=over 4
|
||||
|
||||
=item C<arrayDepth>, C<hashDepth>
|
||||
|
||||
Print only first N elements of arrays and hashes. If false, prints all the
|
||||
elements.
|
||||
|
||||
=item C<compactDump>, C<veryCompact>
|
||||
|
||||
Change style of array and hash dump. If true, short array
|
||||
may be printed on one line.
|
||||
|
||||
=item C<globPrint>
|
||||
|
||||
Whether to print contents of globs.
|
||||
|
||||
=item C<dumpDBFiles>
|
||||
|
||||
Dump arrays holding contents of debugged files.
|
||||
|
||||
=item C<dumpPackages>
|
||||
|
||||
Dump symbol tables of packages.
|
||||
|
||||
=item C<dumpReused>
|
||||
|
||||
Dump contents of "reused" addresses.
|
||||
|
||||
=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>. If C<quoteHighBit> is set, they will be quoted.
|
||||
|
||||
=item C<usageOnly>
|
||||
|
||||
rudimentary per-package memory usage dump. If set,
|
||||
C<dumpvars> calculates total size of strings in variables in the package.
|
||||
|
||||
=item unctrl
|
||||
|
||||
Changes the style of printout of strings. Possible values are
|
||||
C<unctrl> and C<quote>.
|
||||
|
||||
=item subdump
|
||||
|
||||
Whether to try to find the subroutine name given the reference.
|
||||
|
||||
=item bareStringify
|
||||
|
||||
Whether to write the non-overloaded form of the stringify-overloaded objects.
|
||||
|
||||
=item quoteHighBit
|
||||
|
||||
Whether to print chars with high bit set in binary or "as is".
|
||||
|
||||
=item stopDbSignal
|
||||
|
||||
Whether to abort printing if debugger signal flag is raised.
|
||||
|
||||
=back
|
||||
|
||||
Later in the life of the object the methods may be queries with get()
|
||||
method and set() method (which accept multiple arguments).
|
||||
|
||||
=head2 Methods
|
||||
|
||||
=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');
|
||||
$dumper->dumpvars('my_package', 'foo', '~bar$', '!......');
|
||||
|
||||
The optional arguments are considered as literal strings unless they
|
||||
start with C<~> or C<!>, in which case they are interpreted as regular
|
||||
expressions (possibly negated).
|
||||
|
||||
The second example prints entries with names C<foo>, and also entries
|
||||
with names which ends on C<bar>, or are shorter than 5 chars.
|
||||
|
||||
=item set_quote
|
||||
|
||||
$d->set_quote('"');
|
||||
|
||||
Sets C<tick> and C<unctrl> options to suitable values for printout with the
|
||||
given quote char. Possible values are C<auto>, C<'> and C<">.
|
||||
|
||||
=item set_unctrl
|
||||
|
||||
$d->set_unctrl('unctrl');
|
||||
|
||||
Sets C<unctrl> option with checking for an invalid argument.
|
||||
Possible values are C<unctrl> and C<quote>.
|
||||
|
||||
=item compactDump
|
||||
|
||||
$d->compactDump(1);
|
||||
|
||||
Sets C<compactDump> option. If the value is 1, sets to a reasonable
|
||||
big number.
|
||||
|
||||
=item veryCompact
|
||||
|
||||
$d->veryCompact(1);
|
||||
|
||||
Sets C<compactDump> and C<veryCompact> options simultaneously.
|
||||
|
||||
=item set
|
||||
|
||||
$d->set(option1 => value1, option2 => value2);
|
||||
|
||||
=item get
|
||||
|
||||
@values = $d->get('option1', 'option2');
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
Reference in New Issue
Block a user