Skip to content
Newer
Older
100644 1170 lines (964 sloc) 34.8 KB
e89b156 Initial Checkin of the cPanel API Call Tracer
Matthew Dees authored Jan 5, 2011
1 #
2 # Data/Dumper.pm
3
4 ##
5 # IMPORTANT NOTE:
52ac533 Add license information to the ApiCallTracer, Update documentation
Matthew Dees authored Jan 5, 2011
6 # This is a modified version of Data::Dumper v2.12 that should only be used on cPanel systems.
7 # More Specifically, this is a version of Data::Dumper that has been modified to run in PurePerl mode only.
e89b156 Initial Checkin of the cPanel API Call Tracer
Matthew Dees authored Jan 6, 2011
8 #
52ac533 Add license information to the ApiCallTracer, Update documentation
Matthew Dees authored Jan 6, 2011
9 # It's use outside of very specific scenarios is limited, if you are needing to use Data::Dumper in a standard perl environment, you should probably refer to:
10 # http://search.cpan.org/~smueller/Data-Dumper-2.128/Dumper.pm
e89b156 Initial Checkin of the cPanel API Call Tracer
Matthew Dees authored Jan 6, 2011
11 #
52ac533 Add license information to the ApiCallTracer, Update documentation
Matthew Dees authored Jan 6, 2011
12 # This program is free software; you can redistribute it and/or modify it under the same terms as Data::Dumper v2.12 itself. (Artistic Perl License)
13 ##
e89b156 Initial Checkin of the cPanel API Call Tracer
Matthew Dees authored Jan 6, 2011
14
15 #
52ac533 Add license information to the ApiCallTracer, Update documentation
Matthew Dees authored Jan 6, 2011
16 # INSTALLATION:
17 # drop into /usr/local/cpanel/perl/Data/
e89b156 Initial Checkin of the cPanel API Call Tracer
Matthew Dees authored Jan 6, 2011
18 #
19 # Documentation at the __END__
20 #
21
22 package Data::Dumper;
23
24 $VERSION = '2.12';
25
26 #$| = 1;
27
28 use 5.006_001;
29 require overload;
30
31 use Carp;
32
33 @ISA = qw(Exporter);
34 @EXPORT = qw(Dumper);
35 @EXPORT_OK = qw(DumperX);
36
37 $Useperl = 1;
38
39 # module vars and their defaults
40 $Indent = 2 unless defined $Indent;
41 $Purity = 0 unless defined $Purity;
42 $Pad = "" unless defined $Pad;
43 $Varname = "VAR" unless defined $Varname;
44 $Useqq = 0 unless defined $Useqq;
45 $Terse = 0 unless defined $Terse;
46 $Freezer = "" unless defined $Freezer;
47 $Toaster = "" unless defined $Toaster;
48 $Deepcopy = 0 unless defined $Deepcopy;
49 $Quotekeys = 1 unless defined $Quotekeys;
50 $Bless = "bless" unless defined $Bless;
51 #$Expdepth = 0 unless defined $Expdepth;
52 $Maxdepth = 0 unless defined $Maxdepth;
53 $Sortkeys = 0 unless defined $Sortkeys;
54 $Deparse = 0 unless defined $Deparse;
55
56 #
57 # expects an arrayref of values to be dumped.
58 # can optionally pass an arrayref of names for the values.
59 # names must have leading $ sign stripped. begin the name with *
60 # to cause output of arrays and hashes rather than refs.
61 #
62 sub new {
63 my($c, $v, $n) = @_;
64
65 croak "Usage: PACKAGE->new(ARRAYREF, [ARRAYREF])"
66 unless (defined($v) && (ref($v) eq 'ARRAY'));
67 $n = [] unless (defined($n) && (ref($v) eq 'ARRAY'));
68
69 my($s) = {
70 level => 0, # current recursive depth
71 indent => $Indent, # various styles of indenting
72 pad => $Pad, # all lines prefixed by this string
73 xpad => "", # padding-per-level
74 apad => "", # added padding for hash keys n such
75 sep => "", # list separator
76 seen => {}, # local (nested) refs (id => [name, val])
77 todump => $v, # values to dump []
78 names => $n, # optional names for values []
79 varname => $Varname, # prefix to use for tagging nameless ones
80 purity => $Purity, # degree to which output is evalable
81 useqq => $Useqq, # use "" for strings (backslashitis ensues)
82 terse => $Terse, # avoid name output (where feasible)
83 freezer => $Freezer, # name of Freezer method for objects
84 toaster => $Toaster, # name of method to revive objects
85 deepcopy => $Deepcopy, # dont cross-ref, except to stop recursion
86 quotekeys => $Quotekeys, # quote hash keys
87 'bless' => $Bless, # keyword to use for "bless"
88 # expdepth => $Expdepth, # cutoff depth for explicit dumping
89 maxdepth => $Maxdepth, # depth beyond which we give up
90 useperl => $Useperl, # use the pure Perl implementation
91 sortkeys => $Sortkeys, # flag or filter for sorting hash keys
92 deparse => $Deparse, # use B::Deparse for coderefs
93 };
94
95 if ($Indent > 0) {
96 $s->{xpad} = " ";
97 $s->{sep} = "\n";
98 }
99 return bless($s, $c);
100 }
101
102 #
103 # add-to or query the table of already seen references
104 #
105 sub Seen {
106 my($s, $g) = @_;
107 if (defined($g) && (ref($g) eq 'HASH')) {
108 my($k, $v, $id);
109 while (($k, $v) = each %$g) {
110 if (defined $v and ref $v) {
111 ($id) = (overload::StrVal($v) =~ /\((.*)\)$/);
112 if ($k =~ /^[*](.*)$/) {
113 $k = (ref $v eq 'ARRAY') ? ( "\\\@" . $1 ) :
114 (ref $v eq 'HASH') ? ( "\\\%" . $1 ) :
115 (ref $v eq 'CODE') ? ( "\\\&" . $1 ) :
116 ( "\$" . $1 ) ;
117 }
118 elsif ($k !~ /^\$/) {
119 $k = "\$" . $k;
120 }
121 $s->{seen}{$id} = [$k, $v];
122 }
123 else {
124 carp "Only refs supported, ignoring non-ref item \$$k";
125 }
126 }
127 return $s;
128 }
129 else {
130 return map { @$_ } values %{$s->{seen}};
131 }
132 }
133
134 #
135 # set or query the values to be dumped
136 #
137 sub Values {
138 my($s, $v) = @_;
139 if (defined($v) && (ref($v) eq 'ARRAY')) {
140 $s->{todump} = [@$v]; # make a copy
141 return $s;
142 }
143 else {
144 return @{$s->{todump}};
145 }
146 }
147
148 #
149 # set or query the names of the values to be dumped
150 #
151 sub Names {
152 my($s, $n) = @_;
153 if (defined($n) && (ref($n) eq 'ARRAY')) {
154 $s->{names} = [@$n]; # make a copy
155 return $s;
156 }
157 else {
158 return @{$s->{names}};
159 }
160 }
161
162 sub DESTROY {}
163
164 sub Dump {
165 return &Dumpxs
166 unless $Data::Dumper::Useperl || (ref($_[0]) && $_[0]->{useperl}) ||
167 $Data::Dumper::Useqq || (ref($_[0]) && $_[0]->{useqq}) ||
168 $Data::Dumper::Deparse || (ref($_[0]) && $_[0]->{deparse});
169 return &Dumpperl;
170 }
171
172 #
173 # dump the refs in the current dumper object.
174 # expects same args as new() if called via package name.
175 #
176 sub Dumpperl {
177 my($s) = shift;
178 my(@out, $val, $name);
179 my($i) = 0;
180 local(@post);
181
182 $s = $s->new(@_) unless ref $s;
183
184 for $val (@{$s->{todump}}) {
185 my $out = "";
186 @post = ();
187 $name = $s->{names}[$i++];
188 if (defined $name) {
189 if ($name =~ /^[*](.*)$/) {
190 if (defined $val) {
191 $name = (ref $val eq 'ARRAY') ? ( "\@" . $1 ) :
192 (ref $val eq 'HASH') ? ( "\%" . $1 ) :
193 (ref $val eq 'CODE') ? ( "\*" . $1 ) :
194 ( "\$" . $1 ) ;
195 }
196 else {
197 $name = "\$" . $1;
198 }
199 }
200 elsif ($name !~ /^\$/) {
201 $name = "\$" . $name;
202 }
203 }
204 else {
205 $name = "\$" . $s->{varname} . $i;
206 }
207
208 my $valstr;
209 {
210 local($s->{apad}) = $s->{apad};
211 $s->{apad} .= ' ' x (length($name) + 3) if $s->{indent} >= 2;
212 $valstr = $s->_dump($val, $name);
213 }
214
215 $valstr = "$name = " . $valstr . ';' if @post or !$s->{terse};
216 $out .= $s->{pad} . $valstr . $s->{sep};
217 $out .= $s->{pad} . join(';' . $s->{sep} . $s->{pad}, @post)
218 . ';' . $s->{sep} if @post;
219
220 push @out, $out;
221 }
222 return wantarray ? @out : join('', @out);
223 }
224
225 #
226 # twist, toil and turn;
227 # and recurse, of course.
228 # sometimes sordidly;
229 # and curse if no recourse.
230 #
231 sub _dump {
232 my($s, $val, $name) = @_;
233 my($sname);
234 my($out, $realpack, $realtype, $type, $ipad, $id, $blesspad);
235
236 $type = ref $val;
237 $out = "";
238
239 if ($type) {
240
241 # prep it, if it looks like an object
242 if (my $freezer = $s->{freezer}) {
243 $val->$freezer() if UNIVERSAL::can($val, $freezer);
244 }
245
246 ($realpack, $realtype, $id) =
247 (overload::StrVal($val) =~ /^(?:(.*)\=)?([^=]*)\(([^\(]*)\)$/);
248
249 # if it has a name, we need to either look it up, or keep a tab
250 # on it so we know when we hit it later
251 if (defined($name) and length($name)) {
252 # keep a tab on it so that we dont fall into recursive pit
253 if (exists $s->{seen}{$id}) {
254 # if ($s->{expdepth} < $s->{level}) {
255 if ($s->{purity} and $s->{level} > 0) {
256 $out = ($realtype eq 'HASH') ? '{}' :
257 ($realtype eq 'ARRAY') ? '[]' :
258 'do{my $o}' ;
259 push @post, $name . " = " . $s->{seen}{$id}[0];
260 }
261 else {
262 $out = $s->{seen}{$id}[0];
263 if ($name =~ /^([\@\%])/) {
264 my $start = $1;
265 if ($out =~ /^\\$start/) {
266 $out = substr($out, 1);
267 }
268 else {
269 $out = $start . '{' . $out . '}';
270 }
271 }
272 }
273 return $out;
274 # }
275 }
276 else {
277 # store our name
278 $s->{seen}{$id} = [ (($name =~ /^[@%]/) ? ('\\' . $name ) :
279 ($realtype eq 'CODE' and
280 $name =~ /^[*](.*)$/) ? ('\\&' . $1 ) :
281 $name ),
282 $val ];
283 }
284 }
285
286 if ($realpack and $realpack eq 'Regexp') {
287 $out = "$val";
288 $out =~ s,/,\\/,g;
289 return "qr/$out/";
290 }
291
292 # If purity is not set and maxdepth is set, then check depth:
293 # if we have reached maximum depth, return the string
294 # representation of the thing we are currently examining
295 # at this depth (i.e., 'Foo=ARRAY(0xdeadbeef)').
296 if (!$s->{purity}
297 and $s->{maxdepth} > 0
298 and $s->{level} >= $s->{maxdepth})
299 {
300 return qq['$val'];
301 }
302
303 # we have a blessed ref
304 if ($realpack) {
305 $out = $s->{'bless'} . '( ';
306 $blesspad = $s->{apad};
307 $s->{apad} .= ' ' if ($s->{indent} >= 2);
308 }
309
310 $s->{level}++;
311 $ipad = $s->{xpad} x $s->{level};
312
313 if ($realtype eq 'SCALAR' || $realtype eq 'REF') {
314 if ($realpack) {
315 $out .= 'do{\\(my $o = ' . $s->_dump($$val, "\${$name}") . ')}';
316 }
317 else {
318 $out .= '\\' . $s->_dump($$val, "\${$name}");
319 }
320 }
321 elsif ($realtype eq 'GLOB') {
322 $out .= '\\' . $s->_dump($$val, "*{$name}");
323 }
324 elsif ($realtype eq 'ARRAY') {
325 my($v, $pad, $mname);
326 my($i) = 0;
327 $out .= ($name =~ /^\@/) ? '(' : '[';
328 $pad = $s->{sep} . $s->{pad} . $s->{apad};
329 ($name =~ /^\@(.*)$/) ? ($mname = "\$" . $1) :
330 # omit -> if $foo->[0]->{bar}, but not ${$foo->[0]}->{bar}
331 ($name =~ /^\\?[\%\@\*\$][^{].*[]}]$/) ? ($mname = $name) :
332 ($mname = $name . '->');
333 $mname .= '->' if $mname =~ /^\*.+\{[A-Z]+\}$/;
334 for $v (@$val) {
335 $sname = $mname . '[' . $i . ']';
336 $out .= $pad . $ipad . '#' . $i if $s->{indent} >= 3;
337 $out .= $pad . $ipad . $s->_dump($v, $sname);
338 $out .= "," if $i++ < $#$val;
339 }
340 $out .= $pad . ($s->{xpad} x ($s->{level} - 1)) if $i;
341 $out .= ($name =~ /^\@/) ? ')' : ']';
342 }
343 elsif ($realtype eq 'HASH') {
344 my($k, $v, $pad, $lpad, $mname);
345 $out .= ($name =~ /^\%/) ? '(' : '{';
346 $pad = $s->{sep} . $s->{pad} . $s->{apad};
347 $lpad = $s->{apad};
348 ($name =~ /^\%(.*)$/) ? ($mname = "\$" . $1) :
349 # omit -> if $foo->[0]->{bar}, but not ${$foo->[0]}->{bar}
350 ($name =~ /^\\?[\%\@\*\$][^{].*[]}]$/) ? ($mname = $name) :
351 ($mname = $name . '->');
352 $mname .= '->' if $mname =~ /^\*.+\{[A-Z]+\}$/;
353 my ($sortkeys, $keys, $key) = ("$s->{sortkeys}");
354 if ($sortkeys) {
355 if (ref($s->{sortkeys}) eq 'CODE') {
356 $keys = $s->{sortkeys}($val);
357 unless (ref($keys) eq 'ARRAY') {
358 carp "Sortkeys subroutine did not return ARRAYREF";
359 $keys = [];
360 }
361 }
362 else {
363 $keys = [ sort keys %$val ];
364 }
365 }
366 while (($k, $v) = ! $sortkeys ? (each %$val) :
367 @$keys ? ($key = shift(@$keys), $val->{$key}) :
368 () )
369 {
370 my $nk = $s->_dump($k, "");
371 $nk = $1 if !$s->{quotekeys} and $nk =~ /^[\"\']([A-Za-z_]\w*)[\"\']$/;
372 $sname = $mname . '{' . $nk . '}';
373 $out .= $pad . $ipad . $nk . " => ";
374
375 # temporarily alter apad
376 $s->{apad} .= (" " x (length($nk) + 4)) if $s->{indent} >= 2;
377 $out .= $s->_dump($val->{$k}, $sname) . ",";
378 $s->{apad} = $lpad if $s->{indent} >= 2;
379 }
380 if (substr($out, -1) eq ',') {
381 chop $out;
382 $out .= $pad . ($s->{xpad} x ($s->{level} - 1));
383 }
384 $out .= ($name =~ /^\%/) ? ')' : '}';
385 }
386 elsif ($realtype eq 'CODE') {
387 if ($s->{deparse}) {
388 require B::Deparse;
389 my $sub = 'sub ' . (B::Deparse->new)->coderef2text($val);
390 $pad = $s->{sep} . $s->{pad} . $s->{xpad} . $s->{apad} . ' ';
391 $sub =~ s/\n/$pad/gse;
392 $out .= $sub;
393 } else {
394 $out .= 'sub { "DUMMY" }';
395 carp "Encountered CODE ref, using dummy placeholder" if $s->{purity};
396 }
397 }
398 else {
399 croak "Can\'t handle $realtype type.";
400 }
401
402 if ($realpack) { # we have a blessed ref
403 $out .= ', \'' . $realpack . '\'' . ' )';
404 $out .= '->' . $s->{toaster} . '()' if $s->{toaster} ne '';
405 $s->{apad} = $blesspad;
406 }
407 $s->{level}--;
408
409 }
410 else { # simple scalar
411
412 my $ref = \$_[1];
413 # first, catalog the scalar
414 if ($name ne '') {
415 ($id) = ("$ref" =~ /\(([^\(]*)\)$/);
416 if (exists $s->{seen}{$id}) {
417 if ($s->{seen}{$id}[2]) {
418 $out = $s->{seen}{$id}[0];
419 #warn "[<$out]\n";
420 return "\${$out}";
421 }
422 }
423 else {
424 #warn "[>\\$name]\n";
425 $s->{seen}{$id} = ["\\$name", $ref];
426 }
427 }
428 if (ref($ref) eq 'GLOB' or "$ref" =~ /=GLOB\([^()]+\)$/) { # glob
429 my $name = substr($val, 1);
430 if ($name =~ /^[A-Za-z_][\w:]*$/) {
431 $name =~ s/^main::/::/;
432 $sname = $name;
433 }
434 else {
435 $sname = $s->_dump($name, "");
436 $sname = '{' . $sname . '}';
437 }
438 if ($s->{purity}) {
439 my $k;
440 local ($s->{level}) = 0;
441 for $k (qw(SCALAR ARRAY HASH)) {
442 my $gval = *$val{$k};
443 next unless defined $gval;
444 next if $k eq "SCALAR" && ! defined $$gval; # always there
445
446 # _dump can push into @post, so we hold our place using $postlen
447 my $postlen = scalar @post;
448 $post[$postlen] = "\*$sname = ";
449 local ($s->{apad}) = " " x length($post[$postlen]) if $s->{indent} >= 2;
450 $post[$postlen] .= $s->_dump($gval, "\*$sname\{$k\}");
451 }
452 }
453 $out .= '*' . $sname;
454 }
455 elsif (!defined($val)) {
456 $out .= "undef";
457 }
458 elsif ($val =~ /^(?:0|-?[1-9]\d{0,8})\z/) { # safe decimal number
459 $out .= $val;
460 }
461 else { # string
462 if ($s->{useqq} or $val =~ tr/\0-\377//c) {
463 # Fall back to qq if there's unicode
464 $out .= qquote($val, $s->{useqq});
465 }
466 else {
467 $val =~ s/([\\\'])/\\$1/g;
468 $out .= '\'' . $val . '\'';
469 }
470 }
471 }
472 if ($id) {
473 # if we made it this far, $id was added to seen list at current
474 # level, so remove it to get deep copies
475 if ($s->{deepcopy}) {
476 delete($s->{seen}{$id});
477 }
478 elsif ($name) {
479 $s->{seen}{$id}[2] = 1;
480 }
481 }
482 return $out;
483 }
484
485 #
486 # non-OO style of earlier version
487 #
488 sub Dumper {
489 return Data::Dumper->Dump([@_]);
490 }
491
492 # compat stub
493 sub DumperX {
494 return Data::Dumper->Dumpxs([@_], []);
495 }
496
497 sub Dumpf { return Data::Dumper->Dump(@_) }
498
499 sub Dumpp { print Data::Dumper->Dump(@_) }
500
501 #
502 # reset the "seen" cache
503 #
504 sub Reset {
505 my($s) = shift;
506 $s->{seen} = {};
507 return $s;
508 }
509
510 sub Indent {
511 my($s, $v) = @_;
512 if (defined($v)) {
513 if ($v == 0) {
514 $s->{xpad} = "";
515 $s->{sep} = "";
516 }
517 else {
518 $s->{xpad} = " ";
519 $s->{sep} = "\n";
520 }
521 $s->{indent} = $v;
522 return $s;
523 }
524 else {
525 return $s->{indent};
526 }
527 }
528
529 sub Pad {
530 my($s, $v) = @_;
531 defined($v) ? (($s->{pad} = $v), return $s) : $s->{pad};
532 }
533
534 sub Varname {
535 my($s, $v) = @_;
536 defined($v) ? (($s->{varname} = $v), return $s) : $s->{varname};
537 }
538
539 sub Purity {
540 my($s, $v) = @_;
541 defined($v) ? (($s->{purity} = $v), return $s) : $s->{purity};
542 }
543
544 sub Useqq {
545 my($s, $v) = @_;
546 defined($v) ? (($s->{useqq} = $v), return $s) : $s->{useqq};
547 }
548
549 sub Terse {
550 my($s, $v) = @_;
551 defined($v) ? (($s->{terse} = $v), return $s) : $s->{terse};
552 }
553
554 sub Freezer {
555 my($s, $v) = @_;
556 defined($v) ? (($s->{freezer} = $v), return $s) : $s->{freezer};
557 }
558
559 sub Toaster {
560 my($s, $v) = @_;
561 defined($v) ? (($s->{toaster} = $v), return $s) : $s->{toaster};
562 }
563
564 sub Deepcopy {
565 my($s, $v) = @_;
566 defined($v) ? (($s->{deepcopy} = $v), return $s) : $s->{deepcopy};
567 }
568
569 sub Quotekeys {
570 my($s, $v) = @_;
571 defined($v) ? (($s->{quotekeys} = $v), return $s) : $s->{quotekeys};
572 }
573
574 sub Bless {
575 my($s, $v) = @_;
576 defined($v) ? (($s->{'bless'} = $v), return $s) : $s->{'bless'};
577 }
578
579 sub Maxdepth {
580 my($s, $v) = @_;
581 defined($v) ? (($s->{'maxdepth'} = $v), return $s) : $s->{'maxdepth'};
582 }
583
584 sub Useperl {
585 my($s, $v) = @_;
586 defined($v) ? (($s->{'useperl'} = $v), return $s) : $s->{'useperl'};
587 }
588
589 sub Sortkeys {
590 my($s, $v) = @_;
591 defined($v) ? (($s->{'sortkeys'} = $v), return $s) : $s->{'sortkeys'};
592 }
593
594 sub Deparse {
595 my($s, $v) = @_;
596 defined($v) ? (($s->{'deparse'} = $v), return $s) : $s->{'deparse'};
597 }
598
599 # used by qquote below
600 my %esc = (
601 "\a" => "\\a",
602 "\b" => "\\b",
603 "\t" => "\\t",
604 "\n" => "\\n",
605 "\f" => "\\f",
606 "\r" => "\\r",
607 "\e" => "\\e",
608 );
609
610 # put a string value in double quotes
611 sub qquote {
612 local($_) = shift;
613 s/([\\\"\@\$])/\\$1/g;
614 my $bytes; { use bytes; $bytes = length }
615 s/([^\x00-\x7f])/'\x{'.sprintf("%x",ord($1)).'}'/ge if $bytes > length;
616 return qq("$_") unless
617 /[^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~]/; # fast exit
618
619 my $high = shift || "";
620 s/([\a\b\t\n\f\r\e])/$esc{$1}/g;
621
622 if (ord('^')==94) { # ascii
623 # no need for 3 digits in escape for these
624 s/([\0-\037])(?!\d)/'\\'.sprintf('%o',ord($1))/eg;
625 s/([\0-\037\177])/'\\'.sprintf('%03o',ord($1))/eg;
626 # all but last branch below not supported --BEHAVIOR SUBJECT TO CHANGE--
627 if ($high eq "iso8859") {
628 s/([\200-\240])/'\\'.sprintf('%o',ord($1))/eg;
629 } elsif ($high eq "utf8") {
630 # use utf8;
631 # $str =~ s/([^\040-\176])/sprintf "\\x{%04x}", ord($1)/ge;
632 } elsif ($high eq "8bit") {
633 # leave it as it is
634 } else {
635 s/([\200-\377])/'\\'.sprintf('%03o',ord($1))/eg;
636 s/([^\040-\176])/sprintf "\\x{%04x}", ord($1)/ge;
637 }
638 }
639 else { # ebcdic
640 s{([^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~])(?!\d)}
641 {my $v = ord($1); '\\'.sprintf(($v <= 037 ? '%o' : '%03o'), $v)}eg;
642 s{([^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~])}
643 {'\\'.sprintf('%03o',ord($1))}eg;
644 }
645
646 return qq("$_");
647 }
648
649 1;
650 __END__
651
652 =head1 NAME
653
654 Data::Dumper - stringified perl data structures, suitable for both printing and C<eval>
655
656 =head1 SYNOPSIS
657
658 use Data::Dumper;
659
660 # simple procedural interface
661 print Dumper($foo, $bar);
662
663 # extended usage with names
664 print Data::Dumper->Dump([$foo, $bar], [qw(foo *ary)]);
665
666 # configuration variables
667 {
668 local $Data::Dump::Purity = 1;
669 eval Data::Dumper->Dump([$foo, $bar], [qw(foo *ary)]);
670 }
671
672 # OO usage
673 $d = Data::Dumper->new([$foo, $bar], [qw(foo *ary)]);
674 ...
675 print $d->Dump;
676 ...
677 $d->Purity(1)->Terse(1)->Deepcopy(1);
678 eval $d->Dump;
679
680
681 =head1 DESCRIPTION
682
683 Given a list of scalars or reference variables, writes out their contents in
684 perl syntax. The references can also be objects. The contents of each
685 variable is output in a single Perl statement. Handles self-referential
686 structures correctly.
687
688 The return value can be C<eval>ed to get back an identical copy of the
689 original reference structure.
690
691 Any references that are the same as one of those passed in will be named
692 C<$VAR>I<n> (where I<n> is a numeric suffix), and other duplicate references
693 to substructures within C<$VAR>I<n> will be appropriately labeled using arrow
694 notation. You can specify names for individual values to be dumped if you
695 use the C<Dump()> method, or you can change the default C<$VAR> prefix to
696 something else. See C<$Data::Dumper::Varname> and C<$Data::Dumper::Terse>
697 below.
698
699 The default output of self-referential structures can be C<eval>ed, but the
700 nested references to C<$VAR>I<n> will be undefined, since a recursive
701 structure cannot be constructed using one Perl statement. You should set the
702 C<Purity> flag to 1 to get additional statements that will correctly fill in
703 these references.
704
705 In the extended usage form, the references to be dumped can be given
706 user-specified names. If a name begins with a C<*>, the output will
707 describe the dereferenced type of the supplied reference for hashes and
708 arrays, and coderefs. Output of names will be avoided where possible if
709 the C<Terse> flag is set.
710
711 In many cases, methods that are used to set the internal state of the
712 object will return the object itself, so method calls can be conveniently
713 chained together.
714
715 Several styles of output are possible, all controlled by setting
716 the C<Indent> flag. See L<Configuration Variables or Methods> below
717 for details.
718
719
720 =head2 Methods
721
722 =over 4
723
724 =item I<PACKAGE>->new(I<ARRAYREF [>, I<ARRAYREF]>)
725
726 Returns a newly created C<Data::Dumper> object. The first argument is an
727 anonymous array of values to be dumped. The optional second argument is an
728 anonymous array of names for the values. The names need not have a leading
729 C<$> sign, and must be comprised of alphanumeric characters. You can begin
730 a name with a C<*> to specify that the dereferenced type must be dumped
731 instead of the reference itself, for ARRAY and HASH references.
732
733 The prefix specified by C<$Data::Dumper::Varname> will be used with a
734 numeric suffix if the name for a value is undefined.
735
736 Data::Dumper will catalog all references encountered while dumping the
737 values. Cross-references (in the form of names of substructures in perl
738 syntax) will be inserted at all possible points, preserving any structural
739 interdependencies in the original set of values. Structure traversal is
740 depth-first, and proceeds in order from the first supplied value to
741 the last.
742
743 =item I<$OBJ>->Dump I<or> I<PACKAGE>->Dump(I<ARRAYREF [>, I<ARRAYREF]>)
744
745 Returns the stringified form of the values stored in the object (preserving
746 the order in which they were supplied to C<new>), subject to the
747 configuration options below. In a list context, it returns a list
748 of strings corresponding to the supplied values.
749
750 The second form, for convenience, simply calls the C<new> method on its
751 arguments before dumping the object immediately.
752
753 =item I<$OBJ>->Seen(I<[HASHREF]>)
754
755 Queries or adds to the internal table of already encountered references.
756 You must use C<Reset> to explicitly clear the table if needed. Such
757 references are not dumped; instead, their names are inserted wherever they
758 are encountered subsequently. This is useful especially for properly
759 dumping subroutine references.
760
761 Expects an anonymous hash of name => value pairs. Same rules apply for names
762 as in C<new>. If no argument is supplied, will return the "seen" list of
763 name => value pairs, in a list context. Otherwise, returns the object
764 itself.
765
766 =item I<$OBJ>->Values(I<[ARRAYREF]>)
767
768 Queries or replaces the internal array of values that will be dumped.
769 When called without arguments, returns the values. Otherwise, returns the
770 object itself.
771
772 =item I<$OBJ>->Names(I<[ARRAYREF]>)
773
774 Queries or replaces the internal array of user supplied names for the values
775 that will be dumped. When called without arguments, returns the names.
776 Otherwise, returns the object itself.
777
778 =item I<$OBJ>->Reset
779
780 Clears the internal table of "seen" references and returns the object
781 itself.
782
783 =back
784
785 =head2 Functions
786
787 =over 4
788
789 =item Dumper(I<LIST>)
790
791 Returns the stringified form of the values in the list, subject to the
792 configuration options below. The values will be named C<$VAR>I<n> in the
793 output, where I<n> is a numeric suffix. Will return a list of strings
794 in a list context.
795
796 =back
797
798 =head2 Configuration Variables or Methods
799
800 Several configuration variables can be used to control the kind of output
801 generated when using the procedural interface. These variables are usually
802 C<local>ized in a block so that other parts of the code are not affected by
803 the change.
804
805 These variables determine the default state of the object created by calling
806 the C<new> method, but cannot be used to alter the state of the object
807 thereafter. The equivalent method names should be used instead to query
808 or set the internal state of the object.
809
810 The method forms return the object itself when called with arguments,
811 so that they can be chained together nicely.
812
813 =over 4
814
815 =item $Data::Dumper::Indent I<or> I<$OBJ>->Indent(I<[NEWVAL]>)
816
817 Controls the style of indentation. It can be set to 0, 1, 2 or 3. Style 0
818 spews output without any newlines, indentation, or spaces between list
819 items. It is the most compact format possible that can still be called
820 valid perl. Style 1 outputs a readable form with newlines but no fancy
821 indentation (each level in the structure is simply indented by a fixed
822 amount of whitespace). Style 2 (the default) outputs a very readable form
823 which takes into account the length of hash keys (so the hash value lines
824 up). Style 3 is like style 2, but also annotates the elements of arrays
825 with their index (but the comment is on its own line, so array output
826 consumes twice the number of lines). Style 2 is the default.
827
828 =item $Data::Dumper::Purity I<or> I<$OBJ>->Purity(I<[NEWVAL]>)
829
830 Controls the degree to which the output can be C<eval>ed to recreate the
831 supplied reference structures. Setting it to 1 will output additional perl
832 statements that will correctly recreate nested references. The default is
833 0.
834
835 =item $Data::Dumper::Pad I<or> I<$OBJ>->Pad(I<[NEWVAL]>)
836
837 Specifies the string that will be prefixed to every line of the output.
838 Empty string by default.
839
840 =item $Data::Dumper::Varname I<or> I<$OBJ>->Varname(I<[NEWVAL]>)
841
842 Contains the prefix to use for tagging variable names in the output. The
843 default is "VAR".
844
845 =item $Data::Dumper::Useqq I<or> I<$OBJ>->Useqq(I<[NEWVAL]>)
846
847 When set, enables the use of double quotes for representing string values.
848 Whitespace other than space will be represented as C<[\n\t\r]>, "unsafe"
849 characters will be backslashed, and unprintable characters will be output as
850 quoted octal integers. Since setting this variable imposes a performance
851 penalty, the default is 0. C<Dump()> will run slower if this flag is set,
852 since the fast XSUB implementation doesn't support it yet.
853
854 =item $Data::Dumper::Terse I<or> I<$OBJ>->Terse(I<[NEWVAL]>)
855
856 When set, Data::Dumper will emit single, non-self-referential values as
857 atoms/terms rather than statements. This means that the C<$VAR>I<n> names
858 will be avoided where possible, but be advised that such output may not
859 always be parseable by C<eval>.
860
861 =item $Data::Dumper::Freezer I<or> $I<OBJ>->Freezer(I<[NEWVAL]>)
862
863 Can be set to a method name, or to an empty string to disable the feature.
864 Data::Dumper will invoke that method via the object before attempting to
865 stringify it. This method can alter the contents of the object (if, for
866 instance, it contains data allocated from C), and even rebless it in a
867 different package. The client is responsible for making sure the specified
868 method can be called via the object, and that the object ends up containing
869 only perl data types after the method has been called. Defaults to an empty
870 string.
871
872 =item $Data::Dumper::Toaster I<or> $I<OBJ>->Toaster(I<[NEWVAL]>)
873
874 Can be set to a method name, or to an empty string to disable the feature.
875 Data::Dumper will emit a method call for any objects that are to be dumped
876 using the syntax C<bless(DATA, CLASS)-E<gt>METHOD()>. Note that this means that
877 the method specified will have to perform any modifications required on the
878 object (like creating new state within it, and/or reblessing it in a
879 different package) and then return it. The client is responsible for making
880 sure the method can be called via the object, and that it returns a valid
881 object. Defaults to an empty string.
882
883 =item $Data::Dumper::Deepcopy I<or> $I<OBJ>->Deepcopy(I<[NEWVAL]>)
884
885 Can be set to a boolean value to enable deep copies of structures.
886 Cross-referencing will then only be done when absolutely essential
887 (i.e., to break reference cycles). Default is 0.
888
889 =item $Data::Dumper::Quotekeys I<or> $I<OBJ>->Quotekeys(I<[NEWVAL]>)
890
891 Can be set to a boolean value to control whether hash keys are quoted.
892 A false value will avoid quoting hash keys when it looks like a simple
893 string. Default is 1, which will always enclose hash keys in quotes.
894
895 =item $Data::Dumper::Bless I<or> $I<OBJ>->Bless(I<[NEWVAL]>)
896
897 Can be set to a string that specifies an alternative to the C<bless>
898 builtin operator used to create objects. A function with the specified
899 name should exist, and should accept the same arguments as the builtin.
900 Default is C<bless>.
901
902 =item $Data::Dumper::Maxdepth I<or> $I<OBJ>->Maxdepth(I<[NEWVAL]>)
903
904 Can be set to a positive integer that specifies the depth beyond which
905 which we don't venture into a structure. Has no effect when
906 C<Data::Dumper::Purity> is set. (Useful in debugger when we often don't
907 want to see more than enough). Default is 0, which means there is
908 no maximum depth.
909
910 =item $Data::Dumper::Useperl I<or> $I<OBJ>->Useperl(I<[NEWVAL]>)
911
912 Can be set to a boolean value which controls whether the pure Perl
913 implementation of C<Data::Dumper> is used. The C<Data::Dumper> module is
914 a dual implementation, with almost all functionality written in both
915 pure Perl and also in XS ('C'). Since the XS version is much faster, it
916 will always be used if possible. This option lets you override the
917 default behavior, usually for testing purposes only. Default is 0, which
918 means the XS implementation will be used if possible.
919
920 =item $Data::Dumper::Sortkeys I<or> $I<OBJ>->Sortkeys(I<[NEWVAL]>)
921
922 Can be set to a boolean value to control whether hash keys are dumped in
923 sorted order. A true value will cause the keys of all hashes to be
924 dumped in Perl's default sort order. Can also be set to a subroutine
925 reference which will be called for each hash that is dumped. In this
926 case C<Data::Dumper> will call the subroutine once for each hash,
927 passing it the reference of the hash. The purpose of the subroutine is
928 to return a reference to an array of the keys that will be dumped, in
929 the order that they should be dumped. Using this feature, you can
930 control both the order of the keys, and which keys are actually used. In
931 other words, this subroutine acts as a filter by which you can exclude
932 certain keys from being dumped. Default is 0, which means that hash keys
933 are not sorted.
934
935 =item $Data::Dumper::Deparse I<or> $I<OBJ>->Deparse(I<[NEWVAL]>)
936
937 Can be set to a boolean value to control whether code references are
938 turned into perl source code. If set to a true value, C<B::Deparse>
939 will be used to get the source of the code reference. Using this option
940 will force using the Perl implementation of the dumper, since the fast
941 XSUB implementation doesn't support it.
942
943 Caution : use this option only if you know that your coderefs will be
944 properly reconstructed by C<B::Deparse>.
945
946 =back
947
948 =head2 Exports
949
950 =over 4
951
952 =item Dumper
953
954 =back
955
956 =head1 EXAMPLES
957
958 Run these code snippets to get a quick feel for the behavior of this
959 module. When you are through with these examples, you may want to
960 add or change the various configuration variables described above,
961 to see their behavior. (See the testsuite in the Data::Dumper
962 distribution for more examples.)
963
964
965 use Data::Dumper;
966
967 package Foo;
968 sub new {bless {'a' => 1, 'b' => sub { return "foo" }}, $_[0]};
969
970 package Fuz; # a weird REF-REF-SCALAR object
971 sub new {bless \($_ = \ 'fu\'z'), $_[0]};
972
973 package main;
974 $foo = Foo->new;
975 $fuz = Fuz->new;
976 $boo = [ 1, [], "abcd", \*foo,
977 {1 => 'a', 023 => 'b', 0x45 => 'c'},
978 \\"p\q\'r", $foo, $fuz];
979
980 ########
981 # simple usage
982 ########
983
984 $bar = eval(Dumper($boo));
985 print($@) if $@;
986 print Dumper($boo), Dumper($bar); # pretty print (no array indices)
987
988 $Data::Dumper::Terse = 1; # don't output names where feasible
989 $Data::Dumper::Indent = 0; # turn off all pretty print
990 print Dumper($boo), "\n";
991
992 $Data::Dumper::Indent = 1; # mild pretty print
993 print Dumper($boo);
994
995 $Data::Dumper::Indent = 3; # pretty print with array indices
996 print Dumper($boo);
997
998 $Data::Dumper::Useqq = 1; # print strings in double quotes
999 print Dumper($boo);
1000
1001
1002 ########
1003 # recursive structures
1004 ########
1005
1006 @c = ('c');
1007 $c = \@c;
1008 $b = {};
1009 $a = [1, $b, $c];
1010 $b->{a} = $a;
1011 $b->{b} = $a->[1];
1012 $b->{c} = $a->[2];
1013 print Data::Dumper->Dump([$a,$b,$c], [qw(a b c)]);
1014
1015
1016 $Data::Dumper::Purity = 1; # fill in the holes for eval
1017 print Data::Dumper->Dump([$a, $b], [qw(*a b)]); # print as @a
1018 print Data::Dumper->Dump([$b, $a], [qw(*b a)]); # print as %b
1019
1020
1021 $Data::Dumper::Deepcopy = 1; # avoid cross-refs
1022 print Data::Dumper->Dump([$b, $a], [qw(*b a)]);
1023
1024
1025 $Data::Dumper::Purity = 0; # avoid cross-refs
1026 print Data::Dumper->Dump([$b, $a], [qw(*b a)]);
1027
1028 ########
1029 # deep structures
1030 ########
1031
1032 $a = "pearl";
1033 $b = [ $a ];
1034 $c = { 'b' => $b };
1035 $d = [ $c ];
1036 $e = { 'd' => $d };
1037 $f = { 'e' => $e };
1038 print Data::Dumper->Dump([$f], [qw(f)]);
1039
1040 $Data::Dumper::Maxdepth = 3; # no deeper than 3 refs down
1041 print Data::Dumper->Dump([$f], [qw(f)]);
1042
1043
1044 ########
1045 # object-oriented usage
1046 ########
1047
1048 $d = Data::Dumper->new([$a,$b], [qw(a b)]);
1049 $d->Seen({'*c' => $c}); # stash a ref without printing it
1050 $d->Indent(3);
1051 print $d->Dump;
1052 $d->Reset->Purity(0); # empty the seen cache
1053 print join "----\n", $d->Dump;
1054
1055
1056 ########
1057 # persistence
1058 ########
1059
1060 package Foo;
1061 sub new { bless { state => 'awake' }, shift }
1062 sub Freeze {
1063 my $s = shift;
1064 print STDERR "preparing to sleep\n";
1065 $s->{state} = 'asleep';
1066 return bless $s, 'Foo::ZZZ';
1067 }
1068
1069 package Foo::ZZZ;
1070 sub Thaw {
1071 my $s = shift;
1072 print STDERR "waking up\n";
1073 $s->{state} = 'awake';
1074 return bless $s, 'Foo';
1075 }
1076
1077 package Foo;
1078 use Data::Dumper;
1079 $a = Foo->new;
1080 $b = Data::Dumper->new([$a], ['c']);
1081 $b->Freezer('Freeze');
1082 $b->Toaster('Thaw');
1083 $c = $b->Dump;
1084 print $c;
1085 $d = eval $c;
1086 print Data::Dumper->Dump([$d], ['d']);
1087
1088
1089 ########
1090 # symbol substitution (useful for recreating CODE refs)
1091 ########
1092
1093 sub foo { print "foo speaking\n" }
1094 *other = \&foo;
1095 $bar = [ \&other ];
1096 $d = Data::Dumper->new([\&other,$bar],['*other','bar']);
1097 $d->Seen({ '*foo' => \&foo });
1098 print $d->Dump;
1099
1100
1101 ########
1102 # sorting and filtering hash keys
1103 ########
1104
1105 $Data::Dumper::Sortkeys = \&my_filter;
1106 my $foo = { map { (ord, "$_$_$_") } 'I'..'Q' };
1107 my $bar = { %$foo };
1108 my $baz = { reverse %$foo };
1109 print Dumper [ $foo, $bar, $baz ];
1110
1111 sub my_filter {
1112 my ($hash) = @_;
1113 # return an array ref containing the hash keys to dump
1114 # in the order that you want them to be dumped
1115 return [
1116 # Sort the keys of %$foo in reverse numeric order
1117 $hash eq $foo ? (sort {$b <=> $a} keys %$hash) :
1118 # Only dump the odd number keys of %$bar
1119 $hash eq $bar ? (grep {$_ % 2} keys %$hash) :
1120 # Sort keys in default order for all other hashes
1121 (sort keys %$hash)
1122 ];
1123 }
1124
1125 =head1 BUGS
1126
1127 Due to limitations of Perl subroutine call semantics, you cannot pass an
1128 array or hash. Prepend it with a C<\> to pass its reference instead. This
1129 will be remedied in time, now that Perl has subroutine prototypes.
1130 For now, you need to use the extended usage form, and prepend the
1131 name with a C<*> to output it as a hash or array.
1132
1133 C<Data::Dumper> cheats with CODE references. If a code reference is
1134 encountered in the structure being processed (and if you haven't set
1135 the C<Deparse> flag), an anonymous subroutine that
1136 contains the string '"DUMMY"' will be inserted in its place, and a warning
1137 will be printed if C<Purity> is set. You can C<eval> the result, but bear
1138 in mind that the anonymous sub that gets created is just a placeholder.
1139 Someday, perl will have a switch to cache-on-demand the string
1140 representation of a compiled piece of code, I hope. If you have prior
1141 knowledge of all the code refs that your data structures are likely
1142 to have, you can use the C<Seen> method to pre-seed the internal reference
1143 table and make the dumped output point to them, instead. See L<EXAMPLES>
1144 above.
1145
1146 The C<Useqq> and C<Deparse> flags makes Dump() run slower, since the
1147 XSUB implementation does not support them.
1148
1149 SCALAR objects have the weirdest looking C<bless> workaround.
1150
1151
1152 =head1 AUTHOR
1153
1154 Gurusamy Sarathy gsar@activestate.com
1155
1156 Copyright (c) 1996-98 Gurusamy Sarathy. All rights reserved.
1157 This program is free software; you can redistribute it and/or
1158 modify it under the same terms as Perl itself.
1159
1160
1161 =head1 VERSION
1162
1163 Version 2.12 (unreleased)
1164
1165 =head1 SEE ALSO
1166
1167 perl(1)
1168
1169 =cut
Something went wrong with that request. Please try again.