Profile of /usr/local/lib/perl5/5.10.1/darwin-2level/Data/Dumper.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For 01.HTTP.t
Run on Tue May 4 14:17:45 2010
Reported on Tue May 4 14:18:01 2010

File | /usr/local/lib/perl5/5.10.1/darwin-2level/Data/Dumper.pm
Statements Executed | 41
Statement Execution Time | 3.56ms

Subroutines — ordered by exclusive time
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 47µs | 47µs | Data::Dumper::::BEGIN@16Data::Dumper::BEGIN@16
1 | 1 | 1 | 11µs | 16µs | Data::Dumper::::BEGIN@683Data::Dumper::BEGIN@683
1 | 1 | 1 | 11µs | 11µs | Data::Dumper::::BEGIN@22Data::Dumper::BEGIN@22
1 | 1 | 1 | 7µs | 43µs | Data::Dumper::::BEGIN@20Data::Dumper::BEGIN@20
0 | 0 | 0 | 0s | 0s | Data::Dumper::::BlessData::Dumper::Bless
0 | 0 | 0 | 0s | 0s | Data::Dumper::::DESTROYData::Dumper::DESTROY
0 | 0 | 0 | 0s | 0s | Data::Dumper::::DeepcopyData::Dumper::Deepcopy
0 | 0 | 0 | 0s | 0s | Data::Dumper::::DeparseData::Dumper::Deparse
0 | 0 | 0 | 0s | 0s | Data::Dumper::::DumpData::Dumper::Dump
0 | 0 | 0 | 0s | 0s | Data::Dumper::::DumperData::Dumper::Dumper
0 | 0 | 0 | 0s | 0s | Data::Dumper::::DumperXData::Dumper::DumperX
0 | 0 | 0 | 0s | 0s | Data::Dumper::::DumpfData::Dumper::Dumpf
0 | 0 | 0 | 0s | 0s | Data::Dumper::::DumppData::Dumper::Dumpp
0 | 0 | 0 | 0s | 0s | Data::Dumper::::DumpperlData::Dumper::Dumpperl
0 | 0 | 0 | 0s | 0s | Data::Dumper::::FreezerData::Dumper::Freezer
0 | 0 | 0 | 0s | 0s | Data::Dumper::::IndentData::Dumper::Indent
0 | 0 | 0 | 0s | 0s | Data::Dumper::::MaxdepthData::Dumper::Maxdepth
0 | 0 | 0 | 0s | 0s | Data::Dumper::::NamesData::Dumper::Names
0 | 0 | 0 | 0s | 0s | Data::Dumper::::PadData::Dumper::Pad
0 | 0 | 0 | 0s | 0s | Data::Dumper::::PairData::Dumper::Pair
0 | 0 | 0 | 0s | 0s | Data::Dumper::::PurityData::Dumper::Purity
0 | 0 | 0 | 0s | 0s | Data::Dumper::::QuotekeysData::Dumper::Quotekeys
0 | 0 | 0 | 0s | 0s | Data::Dumper::::ResetData::Dumper::Reset
0 | 0 | 0 | 0s | 0s | Data::Dumper::::SeenData::Dumper::Seen
0 | 0 | 0 | 0s | 0s | Data::Dumper::::SortkeysData::Dumper::Sortkeys
0 | 0 | 0 | 0s | 0s | Data::Dumper::::TerseData::Dumper::Terse
0 | 0 | 0 | 0s | 0s | Data::Dumper::::ToasterData::Dumper::Toaster
0 | 0 | 0 | 0s | 0s | Data::Dumper::::UseperlData::Dumper::Useperl
0 | 0 | 0 | 0s | 0s | Data::Dumper::::UseqqData::Dumper::Useqq
0 | 0 | 0 | 0s | 0s | Data::Dumper::::ValuesData::Dumper::Values
0 | 0 | 0 | 0s | 0s | Data::Dumper::::VarnameData::Dumper::Varname
0 | 0 | 0 | 0s | 0s | Data::Dumper::::__ANON__[:106]Data::Dumper::__ANON__[:106]
0 | 0 | 0 | 0s | 0s | Data::Dumper::::__ANON__[:111]Data::Dumper::__ANON__[:111]
0 | 0 | 0 | 0s | 0s | Data::Dumper::::__ANON__[:118]Data::Dumper::__ANON__[:118]
0 | 0 | 0 | 0s | 0s | Data::Dumper::::__ANON__[:123]Data::Dumper::__ANON__[:123]
0 | 0 | 0 | 0s | 0s | Data::Dumper::::_dumpData::Dumper::_dump
0 | 0 | 0 | 0s | 0s | Data::Dumper::::_quoteData::Dumper::_quote
0 | 0 | 0 | 0s | 0s | Data::Dumper::::_sortkeysData::Dumper::_sortkeys
0 | 0 | 0 | 0s | 0s | Data::Dumper::::newData::Dumper::new
0 | 0 | 0 | 0s | 0s | Data::Dumper::::qquoteData::Dumper::qquote

Call graph for these subroutines as a Graphviz dot language file.

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