1 ;# $Id: dump.pl,v 0.7 2000/08/03 22:04:45 ram Exp $
3 ;# Copyright (c) 1995-2000, Raphael Manfredi
5 ;# You may redistribute only under the terms of the Artistic License,
6 ;# as specified in the README file that comes with the distribution.
9 ;# Revision 0.7 2000/08/03 22:04:45 ram
10 ;# Baseline for second beta release.
15 print "not " unless $ok;
23 'SCALAR' => 'dump_scalar',
24 'ARRAY' => 'dump_array',
25 'HASH' => 'dump_hash',
29 # Given an object, dump its transitive data closure
32 croak "Not a reference!" unless ref($object);
37 &recursive_dump($object, 1);
41 # This is the root recursive dumping routine that may indirectly be
42 # called by one of the routine it calls...
43 # The link parameter is set to false when the reference passed to
44 # the routine is an internal temporay variable, implying the object's
45 # address is not to be dumped in the %dumped table since it's not a
46 # user-visible object.
48 my ($object, $link) = @_;
50 # Get something like SCALAR(0x...) or TYPE=SCALAR(0x...).
51 # Then extract the bless, ref and address parts of that string.
53 my $what = "$object"; # Stringify
54 my ($bless, $ref, $addr) = $what =~ /^(\w+)=(\w+)\((0x.*)\)$/;
55 ($ref, $addr) = $what =~ /^(\w+)\((0x.*)\)$/ unless $bless;
57 # Special case for references to references. When stringified,
58 # they appear as being scalars. However, ref() correctly pinpoints
59 # them as being references indirections. And that's it.
61 $ref = 'REF' if ref($object) eq 'REF';
63 # Make sure the object has not been already dumped before.
64 # We don't want to duplicate data. Retrieval will know how to
65 # relink from the previously seen object.
67 if ($link && $dumped{$addr}++) {
68 my $num = $object{$addr};
69 $dumped .= "OBJECT #$num seen\n";
73 my $objcount = $count++;
74 $object{$addr} = $objcount;
76 # Call the appropriate dumping routine based on the reference type.
77 # If the referenced was blessed, we bless it once the object is dumped.
78 # The retrieval code will perform the same on the last object retrieved.
80 croak "Unknown simple type '$ref'" unless defined $dump{$ref};
82 &{$dump{$ref}}($object); # Dump object
83 &bless($bless) if $bless; # Mark it as blessed, if necessary
85 $dumped .= "OBJECT $objcount\n";
88 # Indicate that current object is blessed
91 $dumped .= "BLESS $class\n";
98 unless (defined $scalar) {
102 my $len = length($scalar);
103 $dumped .= "SCALAR len=$len $scalar\n";
109 my $items = 0 + @{$aref};
110 $dumped .= "ARRAY items=$items\n";
111 foreach $item (@{$aref}) {
112 unless (defined $item) {
113 $dumped .= 'ITEM_UNDEF' . "\n";
117 &recursive_dump(\$item, 1);
124 my $items = scalar(keys %{$href});
125 $dumped .= "HASH items=$items\n";
126 foreach $key (sort keys %{$href}) {
128 &recursive_dump(\$key, undef);
129 unless (defined $href->{$key}) {
130 $dumped .= 'VALUE_UNDEF' . "\n";
134 &recursive_dump(\$href->{$key}, 1);
138 # Dump reference to reference
141 my $deref = $$rref; # Follow reference to reference
143 &recursive_dump($deref, 1); # $dref is a reference