| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
package Data::TreeDumper ; |
|
3
|
|
|
|
|
|
|
|
|
4
|
1
|
|
|
1
|
|
537558
|
use 5.006 ; |
|
|
1
|
|
|
|
|
5
|
|
|
|
1
|
|
|
|
|
59
|
|
|
5
|
1
|
|
|
1
|
|
6
|
use strict ; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
41
|
|
|
6
|
1
|
|
|
1
|
|
7
|
use warnings ; |
|
|
1
|
|
|
|
|
8
|
|
|
|
1
|
|
|
|
|
56
|
|
|
7
|
1
|
|
|
1
|
|
6
|
use Carp ; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
100
|
|
|
8
|
1
|
|
|
1
|
|
1925
|
use Check::ISA ; |
|
|
1
|
|
|
|
|
21631
|
|
|
|
1
|
|
|
|
|
7
|
|
|
9
|
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
require Exporter ; |
|
11
|
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
our @ISA = qw(Exporter) ; |
|
13
|
|
|
|
|
|
|
our %EXPORT_TAGS = ('all' => [ qw() ]) ; |
|
14
|
|
|
|
|
|
|
our @EXPORT_OK = ( @{$EXPORT_TAGS{'all'} } ) ; |
|
15
|
|
|
|
|
|
|
our @EXPORT = qw(DumpTree PrintTree DumpTrees CreateChainingFilter); |
|
16
|
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
our $VERSION = '0.40' ; |
|
18
|
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
my $WIN32_CONSOLE ; |
|
20
|
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
BEGIN |
|
22
|
|
|
|
|
|
|
{ |
|
23
|
1
|
50
|
|
1
|
|
633
|
if($^O ne 'MSWin32') |
|
24
|
|
|
|
|
|
|
{ |
|
25
|
1
|
|
|
1
|
|
81
|
eval "use Term::Size;" ; |
|
|
1
|
|
|
|
|
2303
|
|
|
|
1
|
|
|
|
|
3414015
|
|
|
|
1
|
|
|
|
|
84
|
|
|
26
|
1
|
50
|
|
|
|
67
|
die $@ if $@ ; |
|
27
|
|
|
|
|
|
|
} |
|
28
|
|
|
|
|
|
|
else |
|
29
|
|
|
|
|
|
|
{ |
|
30
|
0
|
|
|
|
|
0
|
eval "use Win32::Console;" ; |
|
31
|
0
|
0
|
|
|
|
0
|
die $@ if $@ ; |
|
32
|
|
|
|
|
|
|
|
|
33
|
0
|
|
|
|
|
0
|
$WIN32_CONSOLE= new Win32::Console; |
|
34
|
|
|
|
|
|
|
} |
|
35
|
|
|
|
|
|
|
} |
|
36
|
|
|
|
|
|
|
|
|
37
|
1
|
|
|
1
|
|
1504
|
use Text::Wrap ; |
|
|
1
|
|
|
|
|
3409
|
|
|
|
1
|
|
|
|
|
70
|
|
|
38
|
1
|
|
|
1
|
|
1867
|
use Class::ISA ; |
|
|
1
|
|
|
|
|
3109
|
|
|
|
1
|
|
|
|
|
31
|
|
|
39
|
1
|
|
|
1
|
|
2966
|
use Sort::Naturally ; |
|
|
1
|
|
|
|
|
5000
|
|
|
|
1
|
|
|
|
|
443241
|
|
|
40
|
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
our %setup = |
|
46
|
|
|
|
|
|
|
( |
|
47
|
|
|
|
|
|
|
FILTER => undef |
|
48
|
|
|
|
|
|
|
, FILTER_ARGUMENT => undef |
|
49
|
|
|
|
|
|
|
, LEVEL_FILTERS => undef |
|
50
|
|
|
|
|
|
|
, TYPE_FILTERS => undef |
|
51
|
|
|
|
|
|
|
, USE_ASCII => 1 |
|
52
|
|
|
|
|
|
|
, MAX_DEPTH => -1 |
|
53
|
|
|
|
|
|
|
, INDENTATION => '' |
|
54
|
|
|
|
|
|
|
, NO_OUTPUT => 0 |
|
55
|
|
|
|
|
|
|
, START_LEVEL => 1 |
|
56
|
|
|
|
|
|
|
, VIRTUAL_WIDTH => 120 |
|
57
|
|
|
|
|
|
|
, DISPLAY_ROOT_ADDRESS => 0 |
|
58
|
|
|
|
|
|
|
, DISPLAY_ADDRESS => 1 |
|
59
|
|
|
|
|
|
|
, DISPLAY_PATH => 0 |
|
60
|
|
|
|
|
|
|
, DISPLAY_OBJECT_TYPE => 1 |
|
61
|
|
|
|
|
|
|
, DISPLAY_INHERITANCE => 0 |
|
62
|
|
|
|
|
|
|
, DISPLAY_TIE => 0 |
|
63
|
|
|
|
|
|
|
, DISPLAY_AUTOLOAD => 0 |
|
64
|
|
|
|
|
|
|
, DISPLAY_PERL_SIZE => 0 |
|
65
|
|
|
|
|
|
|
, DISPLAY_PERL_ADDRESS => 0 |
|
66
|
|
|
|
|
|
|
, NUMBER_LEVELS => 0 |
|
67
|
|
|
|
|
|
|
, COLOR_LEVELS => undef |
|
68
|
|
|
|
|
|
|
, GLYPHS => ['| ', '|- ', '`- ', ' '] |
|
69
|
|
|
|
|
|
|
, QUOTE_HASH_KEYS => 0 |
|
70
|
|
|
|
|
|
|
, QUOTE_VALUES => 0 |
|
71
|
|
|
|
|
|
|
, REPLACEMENT_LIST => [ ["\n" => '[\n]'], ["\r" => '[\r]'], ["\t" => '[\t]'] ] |
|
72
|
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
, DISPLAY_NUMBER_OF_ELEMENTS_OVER_MAX_DEPTH => 0 |
|
74
|
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
, DISPLAY_CALLER_LOCATION=> 0 |
|
76
|
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
, __DATA_PATH => '' |
|
78
|
|
|
|
|
|
|
, __PATH_ELEMENTS => [] |
|
79
|
|
|
|
|
|
|
, __TYPE_SEPARATORS => { |
|
80
|
|
|
|
|
|
|
'' => ['<SCALAR:', '>'] |
|
81
|
|
|
|
|
|
|
, 'REF' => ['<', '>'] |
|
82
|
|
|
|
|
|
|
, 'CODE' => ['<CODE:', '>'] |
|
83
|
|
|
|
|
|
|
, 'HASH' => ['{\'', '\'}'] |
|
84
|
|
|
|
|
|
|
, 'ARRAY' => ['[', ']'] |
|
85
|
|
|
|
|
|
|
, 'SCALAR' => ['<SCALAR_REF:', '>'] |
|
86
|
|
|
|
|
|
|
} |
|
87
|
|
|
|
|
|
|
) ; |
|
88
|
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
our $Filter = $setup{FILTER} ; |
|
94
|
|
|
|
|
|
|
our $Filterarguments = $setup{FILTER_ARGUMENT} ; |
|
95
|
|
|
|
|
|
|
our $Levelfilters = $setup{LEVEL_FILTERS} ; |
|
96
|
|
|
|
|
|
|
our $Typefilters = $setup{TYPE_FILTERS} ; |
|
97
|
|
|
|
|
|
|
our $Useascii = $setup{USE_ASCII} ; |
|
98
|
|
|
|
|
|
|
our $Maxdepth = $setup{MAX_DEPTH} ; |
|
99
|
|
|
|
|
|
|
our $Indentation = $setup{INDENTATION} ; |
|
100
|
|
|
|
|
|
|
our $Nooutput = $setup{NO_OUTPUT} ; |
|
101
|
|
|
|
|
|
|
our $Startlevel = $setup{START_LEVEL} ; |
|
102
|
|
|
|
|
|
|
our $Virtualwidth = $setup{VIRTUAL_WIDTH} ; |
|
103
|
|
|
|
|
|
|
our $Displayrootaddress = $setup{DISPLAY_ROOT_ADDRESS} ; |
|
104
|
|
|
|
|
|
|
our $Displayaddress = $setup{DISPLAY_ADDRESS} ; |
|
105
|
|
|
|
|
|
|
our $Displaypath = $setup{DISPLAY_PATH} ; |
|
106
|
|
|
|
|
|
|
our $Displayobjecttype = $setup{DISPLAY_OBJECT_TYPE} ; |
|
107
|
|
|
|
|
|
|
our $Displayinheritance = $setup{DISPLAY_INHERITANCE} ; |
|
108
|
|
|
|
|
|
|
our $Displaytie = $setup{DISPLAY_TIE} ; |
|
109
|
|
|
|
|
|
|
our $Displayautoload = $setup{DISPLAY_AUTOLOAD} ; |
|
110
|
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
our $Displayperlsize = $setup{DISPLAY_PERL_SIZE} ; |
|
112
|
|
|
|
|
|
|
our $Displayperladdress = $setup{DISPLAY_PERL_ADDRESS} ; |
|
113
|
|
|
|
|
|
|
our $Numberlevels = $setup{NUMBER_LEVELS} ; |
|
114
|
|
|
|
|
|
|
our $Colorlevels = $setup{COLOR_LEVELS} ; |
|
115
|
|
|
|
|
|
|
our $Glyphs = [@{$setup{GLYPHS}}] ; |
|
116
|
|
|
|
|
|
|
our $Quotehashkeys = $setup{QUOTE_HASH} ; |
|
117
|
|
|
|
|
|
|
our $Quotevalues = $setup{QUOTE_VALUES} ; |
|
118
|
|
|
|
|
|
|
our $ReplacementList = [@{$setup{REPLACEMENT_LIST}}] ; |
|
119
|
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
our $Displaynumberofelementsovermaxdepth = $setup{DISPLAY_NUMBER_OF_ELEMENTS_OVER_MAX_DEPTH} ; |
|
121
|
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
our $Displaycallerlocation= $setup{DISPLAY_CALLER_LOCATION} ; |
|
123
|
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
sub GetPackageSetup |
|
126
|
|
|
|
|
|
|
{ |
|
127
|
|
|
|
|
|
|
return |
|
128
|
|
|
|
|
|
|
( |
|
129
|
0
|
|
|
0
|
0
|
|
FILTER => $Data::TreeDumper::Filter |
|
130
|
|
|
|
|
|
|
, FILTER_ARGUMENT => $Data::TreeDumper::Filterarguments |
|
131
|
|
|
|
|
|
|
, LEVEL_FILTERS => $Data::TreeDumper::Levelfilters |
|
132
|
|
|
|
|
|
|
, TYPE_FILTERS => $Data::TreeDumper::Typefilters |
|
133
|
|
|
|
|
|
|
, USE_ASCII => $Data::TreeDumper::Useascii |
|
134
|
|
|
|
|
|
|
, MAX_DEPTH => $Data::TreeDumper::Maxdepth |
|
135
|
|
|
|
|
|
|
, INDENTATION => $Data::TreeDumper::Indentation |
|
136
|
|
|
|
|
|
|
, NO_OUTPUT => $Data::TreeDumper::Nooutput |
|
137
|
|
|
|
|
|
|
, START_LEVEL => $Data::TreeDumper::Startlevel |
|
138
|
|
|
|
|
|
|
, VIRTUAL_WIDTH => $Data::TreeDumper::Virtualwidth |
|
139
|
|
|
|
|
|
|
, DISPLAY_ROOT_ADDRESS => $Data::TreeDumper::Displayrootaddress |
|
140
|
|
|
|
|
|
|
, DISPLAY_ADDRESS => $Data::TreeDumper::Displayaddress |
|
141
|
|
|
|
|
|
|
, DISPLAY_PATH => $Data::TreeDumper::Displaypath |
|
142
|
|
|
|
|
|
|
, DISPLAY_OBJECT_TYPE => $Data::TreeDumper::Displayobjecttype |
|
143
|
|
|
|
|
|
|
, DISPLAY_INHERITANCE => $Data::TreeDumper::Displayinheritance |
|
144
|
|
|
|
|
|
|
, DISPLAY_TIE => $Data::TreeDumper::Displaytie |
|
145
|
|
|
|
|
|
|
, DISPLAY_AUTOLOAD => $Data::TreeDumper::Displayautoload |
|
146
|
|
|
|
|
|
|
, DISPLAY_PERL_SIZE => $Data::TreeDumper::Displayperlsize |
|
147
|
|
|
|
|
|
|
, DISPLAY_PERL_ADDRESS => $Data::TreeDumper::Displayperladdress |
|
148
|
|
|
|
|
|
|
, NUMBER_LEVELS => $Data::TreeDumper::Numberlevels |
|
149
|
|
|
|
|
|
|
, COLOR_LEVELS => $Data::TreeDumper::Colorlevels |
|
150
|
|
|
|
|
|
|
, GLYPHS => $Data::TreeDumper::Glyphs |
|
151
|
|
|
|
|
|
|
, QUOTE_HASH_KEYS => $Data::TreeDumper::Quotehashkeys |
|
152
|
|
|
|
|
|
|
, REPLACEMENT_LIST => $Data::TreeDumper::ReplacementList |
|
153
|
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
, DISPLAY_NUMBER_OF_ELEMENTS_OVER_MAX_DEPTH => $Displaynumberofelementsovermaxdepth |
|
155
|
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
, DISPLAY_CALLER_LOCATION=> $Displaycallerlocation |
|
157
|
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
, __DATA_PATH => '' |
|
159
|
|
|
|
|
|
|
, __PATH_ELEMENTS => [] |
|
160
|
|
|
|
|
|
|
, __TYPE_SEPARATORS => $setup{__TYPE_SEPARATORS} |
|
161
|
|
|
|
|
|
|
) ; |
|
162
|
|
|
|
|
|
|
} |
|
163
|
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
sub PrintTree |
|
169
|
|
|
|
|
|
|
{ |
|
170
|
0
|
|
|
0
|
0
|
|
my ($package, $file_name, $line) = caller() ; |
|
171
|
0
|
|
|
|
|
|
print DumpTree(@_, DUMPER_NAME => "PrintTree at '$file_name:$line'") ; |
|
172
|
|
|
|
|
|
|
} |
|
173
|
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
sub DumpTree |
|
175
|
|
|
|
|
|
|
{ |
|
176
|
0
|
|
|
0
|
0
|
|
my $structure_to_dump = shift ; |
|
177
|
0
|
|
|
|
|
|
my $title = shift ; |
|
178
|
0
|
|
|
|
|
|
my %overrides = @_ ; |
|
179
|
|
|
|
|
|
|
|
|
180
|
0
|
0
|
|
|
|
|
$title = defined $title ? $title : '' ; |
|
181
|
|
|
|
|
|
|
|
|
182
|
0
|
|
|
|
|
|
my ($package, $file_name, $line) = caller() ; |
|
183
|
|
|
|
|
|
|
|
|
184
|
0
|
|
|
|
|
|
my $location = '' ; |
|
185
|
|
|
|
|
|
|
|
|
186
|
0
|
0
|
|
|
|
|
if($Displaycallerlocation) |
|
187
|
|
|
|
|
|
|
{ |
|
188
|
0
|
0
|
|
|
|
|
$location = defined $overrides{DUMPER_NAME} ? $overrides{DUMPER_NAME} : "DumpTree at '$file_name:$line'" ; |
|
189
|
|
|
|
|
|
|
} |
|
190
|
|
|
|
|
|
|
|
|
191
|
0
|
0
|
|
|
|
|
unless(defined $structure_to_dump) |
|
192
|
|
|
|
|
|
|
{ |
|
193
|
0
|
|
|
|
|
|
return("$title (undefined variable) $location\n") ; |
|
194
|
|
|
|
|
|
|
} |
|
195
|
|
|
|
|
|
|
|
|
196
|
0
|
0
|
|
|
|
|
if('' eq ref $structure_to_dump) |
|
197
|
|
|
|
|
|
|
{ |
|
198
|
0
|
|
|
|
|
|
return("$title $structure_to_dump (scalar variable) $location\n"); |
|
199
|
|
|
|
|
|
|
} |
|
200
|
|
|
|
|
|
|
|
|
201
|
0
|
0
|
|
|
|
|
if($Displaycallerlocation) |
|
202
|
|
|
|
|
|
|
{ |
|
203
|
0
|
|
|
|
|
|
print "$location\n" ; |
|
204
|
|
|
|
|
|
|
} |
|
205
|
|
|
|
|
|
|
|
|
206
|
0
|
|
|
|
|
|
my %local_setup ; |
|
207
|
|
|
|
|
|
|
|
|
208
|
0
|
0
|
0
|
|
|
|
if(exists $overrides{NO_PACKAGE_SETUP} && $overrides{NO_PACKAGE_SETUP}) |
|
209
|
|
|
|
|
|
|
{ |
|
210
|
0
|
|
|
|
|
|
%local_setup = (%setup, %overrides) ; |
|
211
|
|
|
|
|
|
|
} |
|
212
|
|
|
|
|
|
|
else |
|
213
|
|
|
|
|
|
|
{ |
|
214
|
0
|
|
|
|
|
|
%local_setup = (GetPackageSetup(), %overrides) ; |
|
215
|
|
|
|
|
|
|
} |
|
216
|
|
|
|
|
|
|
|
|
217
|
0
|
0
|
|
|
|
|
unless (exists $local_setup{TYPE_FILTERS}{Regexp}) |
|
218
|
|
|
|
|
|
|
{ |
|
219
|
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
$local_setup{TYPE_FILTERS}{Regexp} = |
|
221
|
|
|
|
|
|
|
sub |
|
222
|
|
|
|
|
|
|
{ |
|
223
|
0
|
|
|
0
|
|
|
my ($regexp) = @_ ; |
|
224
|
0
|
|
|
|
|
|
return ('HASH', {REGEXP=> "$regexp"}, 'REGEXP') ; |
|
225
|
0
|
|
|
|
|
|
} ; |
|
226
|
|
|
|
|
|
|
} |
|
227
|
|
|
|
|
|
|
|
|
228
|
0
|
|
|
|
|
|
return(TreeDumper($structure_to_dump, {TITLE => $title, %local_setup})) ; |
|
229
|
|
|
|
|
|
|
} |
|
230
|
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
sub DumpTrees |
|
234
|
|
|
|
|
|
|
{ |
|
235
|
0
|
|
|
0
|
0
|
|
my @trees = grep {'ARRAY' eq ref $_} @_ ; |
|
|
0
|
|
|
|
|
|
|
|
236
|
0
|
|
|
|
|
|
my %global_overrides = grep {'ARRAY' ne ref $_} @_ ; |
|
|
0
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
|
|
238
|
0
|
|
|
|
|
|
my $dump = '' ; |
|
239
|
|
|
|
|
|
|
|
|
240
|
0
|
|
|
|
|
|
for my $tree (@trees) |
|
241
|
|
|
|
|
|
|
{ |
|
242
|
0
|
|
|
|
|
|
my ($structure_to_dump, $title, %overrides) = @{$tree} ; |
|
|
0
|
|
|
|
|
|
|
|
243
|
0
|
0
|
|
|
|
|
$title = defined $title ? $title : '' ; |
|
244
|
|
|
|
|
|
|
|
|
245
|
0
|
0
|
|
|
|
|
if(defined $structure_to_dump) |
|
246
|
|
|
|
|
|
|
{ |
|
247
|
0
|
|
|
|
|
|
$dump .= DumpTree($structure_to_dump, $title, %global_overrides, %overrides) ; |
|
248
|
|
|
|
|
|
|
} |
|
249
|
|
|
|
|
|
|
else |
|
250
|
|
|
|
|
|
|
{ |
|
251
|
0
|
|
|
|
|
|
my ($package, $file_name, $line) = caller() ; |
|
252
|
0
|
|
|
|
|
|
$dump .= "DumpTrees can't dump 'undef' with title: '$title' @ '$file_name:$line'.\n" ; |
|
253
|
|
|
|
|
|
|
} |
|
254
|
|
|
|
|
|
|
} |
|
255
|
|
|
|
|
|
|
|
|
256
|
0
|
|
|
|
|
|
return($dump) ; |
|
257
|
|
|
|
|
|
|
} |
|
258
|
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
sub TreeDumper |
|
263
|
|
|
|
|
|
|
{ |
|
264
|
0
|
|
|
0
|
0
|
|
my $tree = shift ; |
|
265
|
0
|
|
|
|
|
|
my $setup = shift ; |
|
266
|
0
|
|
0
|
|
|
|
my $level = shift || 0 ; |
|
267
|
0
|
|
0
|
|
|
|
my $levels_left = shift || [] ; |
|
268
|
|
|
|
|
|
|
|
|
269
|
0
|
|
|
|
|
|
my $tree_type = ref $tree ; |
|
270
|
0
|
0
|
|
|
|
|
confess "TreeDumper can only display objects passed by reference!\n" if('' eq $tree_type) ; |
|
271
|
|
|
|
|
|
|
|
|
272
|
0
|
|
0
|
|
|
|
my $already_displayed_nodes = shift || {$tree => GetReferenceType($tree) . 'O', NEXT_INDEX => 1} ; |
|
273
|
|
|
|
|
|
|
|
|
274
|
0
|
0
|
|
|
|
|
return('') if ($setup->{MAX_DEPTH} == $level) ; |
|
275
|
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
|
|
279
|
0
|
0
|
|
|
|
|
if($level == 0) |
|
280
|
|
|
|
|
|
|
{ |
|
281
|
0
|
|
|
|
|
|
eval 'use Devel::Size qw(size total_size) ;' ; |
|
282
|
|
|
|
|
|
|
|
|
283
|
0
|
0
|
|
|
|
|
if($@) |
|
284
|
|
|
|
|
|
|
{ |
|
285
|
|
|
|
|
|
|
|
|
286
|
0
|
|
|
|
|
|
delete $setup->{DISPLAY_PERL_SIZE} ; |
|
287
|
|
|
|
|
|
|
} |
|
288
|
|
|
|
|
|
|
} |
|
289
|
|
|
|
|
|
|
|
|
290
|
0
|
0
|
|
|
|
|
local $Devel::Size::warn = 0 if($level == 0) ; |
|
291
|
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
|
|
295
|
0
|
|
|
|
|
|
my ($filter_sub, $filter_argument) = GetFilter($setup, $level, ref $tree) ; |
|
296
|
|
|
|
|
|
|
|
|
297
|
0
|
|
|
|
|
|
my ($replacement_tree, @nodes_to_display) ; |
|
298
|
0
|
0
|
|
|
|
|
if(defined $filter_sub) |
|
299
|
|
|
|
|
|
|
{ |
|
300
|
0
|
|
|
|
|
|
($tree_type, $replacement_tree, @nodes_to_display) |
|
301
|
|
|
|
|
|
|
= $filter_sub->($tree, $level, $setup->{__DATA_PATH}, undef, $setup, $filter_argument) ; |
|
302
|
|
|
|
|
|
|
|
|
303
|
0
|
0
|
|
|
|
|
$tree = $replacement_tree if(defined $replacement_tree) ; |
|
304
|
|
|
|
|
|
|
} |
|
305
|
|
|
|
|
|
|
else |
|
306
|
|
|
|
|
|
|
{ |
|
307
|
0
|
|
|
|
|
|
($tree_type, undef, @nodes_to_display) = DefaultNodesToDisplay($tree) ; |
|
308
|
|
|
|
|
|
|
} |
|
309
|
|
|
|
|
|
|
|
|
310
|
0
|
0
|
|
|
|
|
return('') unless defined $tree_type ; |
|
311
|
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
|
|
313
|
0
|
|
|
|
|
|
my @node_names ; |
|
314
|
|
|
|
|
|
|
|
|
315
|
0
|
|
|
|
|
|
for my $node (@nodes_to_display) |
|
316
|
|
|
|
|
|
|
{ |
|
317
|
0
|
0
|
|
|
|
|
if(ref $node eq 'ARRAY') |
|
318
|
|
|
|
|
|
|
{ |
|
319
|
0
|
|
|
|
|
|
push @node_names, $node->[1] ; |
|
320
|
0
|
|
|
|
|
|
$node = $node->[0] ; |
|
321
|
|
|
|
|
|
|
} |
|
322
|
|
|
|
|
|
|
else |
|
323
|
|
|
|
|
|
|
{ |
|
324
|
0
|
|
|
|
|
|
push @node_names, $node ; |
|
325
|
|
|
|
|
|
|
} |
|
326
|
|
|
|
|
|
|
} |
|
327
|
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
|
|
331
|
0
|
|
|
|
|
|
my $output = '' ; |
|
332
|
0
|
0
|
|
|
|
|
$output .= RenderRoot($tree, $setup) if($level == 0) ; |
|
333
|
|
|
|
|
|
|
|
|
334
|
0
|
|
|
|
|
|
my ($opening_bracket, $closing_bracket) = GetBrackets($setup, $tree_type) ; |
|
335
|
|
|
|
|
|
|
|
|
336
|
0
|
|
|
|
|
|
for (my $node_index = 0 ; $node_index < @nodes_to_display ; $node_index++) |
|
337
|
|
|
|
|
|
|
{ |
|
338
|
0
|
|
|
|
|
|
my $nodes_left = (@nodes_to_display - 1) - $node_index ; |
|
339
|
|
|
|
|
|
|
|
|
340
|
0
|
|
|
|
|
|
$levels_left->[$level] = $nodes_left ; |
|
341
|
|
|
|
|
|
|
|
|
342
|
0
|
|
|
|
|
|
my @separator_data = GetSeparator |
|
343
|
|
|
|
|
|
|
( |
|
344
|
|
|
|
|
|
|
$level |
|
345
|
|
|
|
|
|
|
, $nodes_left |
|
346
|
|
|
|
|
|
|
, $levels_left |
|
347
|
|
|
|
|
|
|
, $setup->{START_LEVEL} |
|
348
|
|
|
|
|
|
|
, $setup->{GLYPHS} |
|
349
|
|
|
|
|
|
|
, $setup->{COLOR_LEVELS} |
|
350
|
|
|
|
|
|
|
) ; |
|
351
|
|
|
|
|
|
|
|
|
352
|
0
|
|
|
|
|
|
my ($element, $element_name, $element_address, $element_id) |
|
353
|
|
|
|
|
|
|
= GetElement($tree, $tree_type, \@nodes_to_display, \@node_names, $node_index, $setup); |
|
354
|
|
|
|
|
|
|
|
|
355
|
0
|
|
|
|
|
|
my $is_terminal_node = IsTerminalNode |
|
356
|
|
|
|
|
|
|
( |
|
357
|
|
|
|
|
|
|
$element |
|
358
|
|
|
|
|
|
|
, $element_name |
|
359
|
|
|
|
|
|
|
, $level |
|
360
|
|
|
|
|
|
|
, $setup |
|
361
|
|
|
|
|
|
|
) ; |
|
362
|
|
|
|
|
|
|
|
|
363
|
0
|
0
|
0
|
|
|
|
if(! $is_terminal_node && exists $already_displayed_nodes->{$element_address}) |
|
364
|
|
|
|
|
|
|
{ |
|
365
|
0
|
|
|
|
|
|
$is_terminal_node = 1 ; |
|
366
|
|
|
|
|
|
|
} |
|
367
|
|
|
|
|
|
|
|
|
368
|
0
|
0
|
|
|
|
|
my $element_name_rendering = |
|
369
|
|
|
|
|
|
|
defined $tree |
|
370
|
|
|
|
|
|
|
? RenderElementName |
|
371
|
|
|
|
|
|
|
( |
|
372
|
|
|
|
|
|
|
\@separator_data |
|
373
|
|
|
|
|
|
|
, $element, $element_name, $element_address, $element_id |
|
374
|
|
|
|
|
|
|
, $level |
|
375
|
|
|
|
|
|
|
, $levels_left |
|
376
|
|
|
|
|
|
|
, $already_displayed_nodes |
|
377
|
|
|
|
|
|
|
, $setup |
|
378
|
|
|
|
|
|
|
) |
|
379
|
|
|
|
|
|
|
: '' ; |
|
380
|
|
|
|
|
|
|
|
|
381
|
0
|
0
|
|
|
|
|
unless($is_terminal_node) |
|
382
|
|
|
|
|
|
|
{ |
|
383
|
0
|
|
|
|
|
|
local $setup->{__DATA_PATH} = "$setup->{__DATA_PATH}$opening_bracket$element_name$closing_bracket" ; |
|
384
|
|
|
|
|
|
|
|
|
385
|
0
|
|
|
|
|
|
push @{$setup->{__PATH_ELEMENTS}}, [$tree_type, $element_name, $tree] ; |
|
|
0
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
|
|
387
|
0
|
|
|
|
|
|
my $sub_tree_dump = TreeDumper($element, $setup, $level + 1, $levels_left, $already_displayed_nodes) ; |
|
388
|
|
|
|
|
|
|
|
|
389
|
0
|
|
|
|
|
|
$output .= $element_name_rendering .$sub_tree_dump ; |
|
390
|
|
|
|
|
|
|
|
|
391
|
0
|
|
|
|
|
|
pop @{$setup->{__PATH_ELEMENTS}} ; |
|
|
0
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
} |
|
393
|
|
|
|
|
|
|
else |
|
394
|
|
|
|
|
|
|
{ |
|
395
|
0
|
|
|
|
|
|
$output .= $element_name_rendering ; |
|
396
|
|
|
|
|
|
|
} |
|
397
|
|
|
|
|
|
|
} |
|
398
|
|
|
|
|
|
|
|
|
399
|
0
|
0
|
|
|
|
|
RenderEnd(\$output, $setup) if($level == 0) ; |
|
400
|
|
|
|
|
|
|
|
|
401
|
0
|
|
|
|
|
|
return($output) ; |
|
402
|
|
|
|
|
|
|
} |
|
403
|
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
sub GetFilter |
|
407
|
|
|
|
|
|
|
{ |
|
408
|
0
|
|
|
0
|
0
|
|
my ($setup, $level, $type) = @_ ; |
|
409
|
|
|
|
|
|
|
|
|
410
|
0
|
|
|
|
|
|
my $filter_sub = $setup->{FILTER} ; |
|
411
|
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
|
|
413
|
0
|
|
|
|
|
|
my $level_filters = $setup->{LEVEL_FILTERS} ; |
|
414
|
0
|
0
|
0
|
|
|
|
$filter_sub = $level_filters->{$level} if(defined $level_filters && exists $level_filters->{$level}) ; |
|
415
|
|
|
|
|
|
|
|
|
416
|
0
|
|
|
|
|
|
my $type_filters = $setup->{TYPE_FILTERS} ; |
|
417
|
0
|
0
|
0
|
|
|
|
$filter_sub = $type_filters->{$type} if(defined $type_filters && exists $type_filters->{$type}) ; |
|
418
|
|
|
|
|
|
|
|
|
419
|
0
|
0
|
0
|
|
|
|
unless ('CODE' eq ref $filter_sub || ! defined $filter_sub) |
|
420
|
|
|
|
|
|
|
{ |
|
421
|
0
|
|
|
|
|
|
my ($package, $file_name, $line) = caller(2) ; |
|
422
|
|
|
|
|
|
|
|
|
423
|
0
|
|
|
|
|
|
die "DumpTree: FILTER must be sub reference at '$file_name:$line'" ; |
|
424
|
|
|
|
|
|
|
} |
|
425
|
|
|
|
|
|
|
|
|
426
|
0
|
|
|
|
|
|
return($filter_sub, $setup->{FILTER_ARGUMENT}) ; |
|
427
|
|
|
|
|
|
|
} |
|
428
|
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
sub GetElement |
|
432
|
|
|
|
|
|
|
{ |
|
433
|
0
|
|
|
0
|
0
|
|
my ($tree, $tree_type, $nodes_to_display, $node_names, $node_index, $setup) = @_ ; |
|
434
|
|
|
|
|
|
|
|
|
435
|
0
|
|
|
|
|
|
my ($element, $element_name, $element_address, $element_id) ; |
|
436
|
|
|
|
|
|
|
|
|
437
|
0
|
|
|
|
|
|
for($tree) |
|
438
|
|
|
|
|
|
|
{ |
|
439
|
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
($tree_type eq 'HASH' || obj($tree, 'HASH')) and do |
|
441
|
0
|
0
|
0
|
|
|
|
{ |
|
442
|
0
|
|
|
|
|
|
$element = $tree->{$nodes_to_display->[$node_index]} ; |
|
443
|
0
|
0
|
|
|
|
|
$element_address = "$element" if defined $element ; |
|
444
|
|
|
|
|
|
|
|
|
445
|
0
|
0
|
|
|
|
|
if($setup->{QUOTE_HASH_KEYS}) |
|
446
|
|
|
|
|
|
|
{ |
|
447
|
0
|
|
|
|
|
|
$element_name = "'$node_names->[$node_index]'" ; |
|
448
|
|
|
|
|
|
|
} |
|
449
|
|
|
|
|
|
|
else |
|
450
|
|
|
|
|
|
|
{ |
|
451
|
0
|
|
|
|
|
|
$element_name = $node_names->[$node_index] ; |
|
452
|
|
|
|
|
|
|
} |
|
453
|
|
|
|
|
|
|
|
|
454
|
0
|
|
|
|
|
|
$element_id = \($tree->{$nodes_to_display->[$node_index]}) ; |
|
455
|
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
last |
|
457
|
0
|
|
|
|
|
|
} ; |
|
458
|
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
($tree_type eq 'ARRAY' || obj($tree, 'ARRAY')) and do |
|
460
|
0
|
0
|
0
|
|
|
|
{ |
|
461
|
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
|
|
470
|
0
|
|
|
|
|
|
$element = $tree->[$nodes_to_display->[$node_index]] ; |
|
471
|
0
|
0
|
|
|
|
|
$element_address = "$element" if defined $element ; |
|
472
|
0
|
|
|
|
|
|
$element_name = $node_names->[$node_index] ; |
|
473
|
0
|
|
|
|
|
|
$element_id = \($tree->[$nodes_to_display->[$node_index]]) ; |
|
474
|
0
|
|
|
|
|
|
last ; |
|
475
|
|
|
|
|
|
|
} ; |
|
476
|
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
($tree_type eq 'REF' || obj($tree, 'REF')) and do |
|
478
|
0
|
0
|
0
|
|
|
|
{ |
|
479
|
0
|
|
|
|
|
|
$element = $$tree ; |
|
480
|
0
|
0
|
|
|
|
|
$element_address = "$element" if defined $element ; |
|
481
|
|
|
|
|
|
|
|
|
482
|
0
|
|
|
|
|
|
my $sub_type = '?' ; |
|
483
|
0
|
|
|
|
|
|
for($element) |
|
484
|
|
|
|
|
|
|
{ |
|
485
|
0
|
|
|
|
|
|
my $element_type = ref $element; |
|
486
|
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
($element_type eq '' || obj($element, 'HASH')) and do |
|
488
|
0
|
0
|
0
|
|
|
|
{ |
|
489
|
0
|
|
|
|
|
|
$sub_type = 'scalar' ; |
|
490
|
0
|
|
|
|
|
|
last ; |
|
491
|
|
|
|
|
|
|
} ; |
|
492
|
|
|
|
|
|
|
($element_type eq 'HASH' || obj($element, 'HASH')) and do |
|
493
|
0
|
0
|
0
|
|
|
|
{ |
|
494
|
0
|
|
|
|
|
|
$sub_type = 'HASH' ; |
|
495
|
0
|
|
|
|
|
|
last ; |
|
496
|
|
|
|
|
|
|
} ; |
|
497
|
|
|
|
|
|
|
($element_type eq 'ARRAY' || obj($element, 'ARRAY')) and do |
|
498
|
0
|
0
|
0
|
|
|
|
{ |
|
499
|
0
|
|
|
|
|
|
$sub_type = 'ARRAY' ; |
|
500
|
0
|
|
|
|
|
|
last ; |
|
501
|
|
|
|
|
|
|
} ; |
|
502
|
|
|
|
|
|
|
($element_type eq 'REF' || obj($element, 'REF')) and do |
|
503
|
0
|
0
|
0
|
|
|
|
{ |
|
504
|
0
|
|
|
|
|
|
$sub_type = 'REF' ; |
|
505
|
0
|
|
|
|
|
|
last ; |
|
506
|
|
|
|
|
|
|
} ; |
|
507
|
|
|
|
|
|
|
($element_type eq 'CODE' || obj($element, 'CODE')) and do |
|
508
|
0
|
0
|
0
|
|
|
|
{ |
|
509
|
0
|
|
|
|
|
|
$sub_type = 'CODE' ; |
|
510
|
0
|
|
|
|
|
|
last ; |
|
511
|
|
|
|
|
|
|
} ; |
|
512
|
|
|
|
|
|
|
($element_type eq 'SCALAR' || obj($element, 'SCALAR')) and do |
|
513
|
0
|
0
|
0
|
|
|
|
{ |
|
514
|
0
|
|
|
|
|
|
$sub_type = 'SCALAR REF' ; |
|
515
|
0
|
|
|
|
|
|
last ; |
|
516
|
|
|
|
|
|
|
} ; |
|
517
|
|
|
|
|
|
|
} |
|
518
|
|
|
|
|
|
|
|
|
519
|
0
|
|
|
|
|
|
$element_name = "$tree to $sub_type" ; |
|
520
|
0
|
|
|
|
|
|
$element_id = $tree ; |
|
521
|
0
|
|
|
|
|
|
last ; |
|
522
|
|
|
|
|
|
|
} ; |
|
523
|
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
($tree_type eq 'CODE' || obj($tree, 'CODE')) and do |
|
525
|
0
|
0
|
0
|
|
|
|
{ |
|
526
|
0
|
|
|
|
|
|
$element = $tree ; |
|
527
|
0
|
0
|
|
|
|
|
$element_address = "$element" if defined $element ; |
|
528
|
0
|
|
|
|
|
|
$element_name = $tree ; |
|
529
|
0
|
|
|
|
|
|
$element_id = $tree ; |
|
530
|
0
|
|
|
|
|
|
last ; |
|
531
|
|
|
|
|
|
|
} ; |
|
532
|
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
($tree_type eq 'SCALAR' || obj($tree, 'SCALAR')) and do |
|
534
|
|
|
|
|
|
|
|
|
535
|
0
|
0
|
0
|
|
|
|
{ |
|
536
|
0
|
|
|
|
|
|
$element = $$tree ; |
|
537
|
0
|
0
|
|
|
|
|
$element_address = "$element" if defined $element ; |
|
538
|
0
|
|
|
|
|
|
$element_name = '?' ; |
|
539
|
0
|
|
|
|
|
|
$element_id = $tree ; |
|
540
|
0
|
|
|
|
|
|
last ; |
|
541
|
|
|
|
|
|
|
} ; |
|
542
|
|
|
|
|
|
|
} |
|
543
|
|
|
|
|
|
|
|
|
544
|
0
|
|
|
|
|
|
return ($element, $element_name, $element_address, $element_id) ; |
|
545
|
|
|
|
|
|
|
} |
|
546
|
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
sub RenderElementName |
|
550
|
|
|
|
|
|
|
{ |
|
551
|
|
|
|
|
|
|
my |
|
552
|
|
|
|
|
|
|
( |
|
553
|
0
|
|
|
0
|
0
|
|
$separator_data |
|
554
|
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
, $element, $element_name, $element_address, $element_id |
|
556
|
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
, $level |
|
558
|
|
|
|
|
|
|
, $levels_left |
|
559
|
|
|
|
|
|
|
, $already_displayed_nodes |
|
560
|
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
, $setup |
|
562
|
|
|
|
|
|
|
) = @_ ; |
|
563
|
|
|
|
|
|
|
|
|
564
|
0
|
|
|
|
|
|
my @rendering_elements = GetElementInfo |
|
565
|
|
|
|
|
|
|
( |
|
566
|
|
|
|
|
|
|
$element |
|
567
|
|
|
|
|
|
|
, $element_name |
|
568
|
|
|
|
|
|
|
, $element_address |
|
569
|
|
|
|
|
|
|
, $element_id |
|
570
|
|
|
|
|
|
|
, $level |
|
571
|
|
|
|
|
|
|
, $already_displayed_nodes |
|
572
|
|
|
|
|
|
|
, $setup |
|
573
|
|
|
|
|
|
|
) ; |
|
574
|
|
|
|
|
|
|
|
|
575
|
0
|
|
|
|
|
|
my $output = RenderNode |
|
576
|
|
|
|
|
|
|
( |
|
577
|
|
|
|
|
|
|
$element |
|
578
|
|
|
|
|
|
|
, $element_name |
|
579
|
|
|
|
|
|
|
, $level |
|
580
|
|
|
|
|
|
|
, @$separator_data |
|
581
|
|
|
|
|
|
|
, @rendering_elements |
|
582
|
|
|
|
|
|
|
, $setup |
|
583
|
|
|
|
|
|
|
) ; |
|
584
|
|
|
|
|
|
|
|
|
585
|
0
|
|
|
|
|
|
return($output) ; |
|
586
|
|
|
|
|
|
|
} |
|
587
|
|
|
|
|
|
|
|
|
588
|
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
sub GetBrackets |
|
591
|
|
|
|
|
|
|
{ |
|
592
|
0
|
|
|
0
|
0
|
|
my ($setup, $tree_type) = @_ ; |
|
593
|
0
|
|
|
|
|
|
my ($opening_bracket, $closing_bracket) ; |
|
594
|
|
|
|
|
|
|
|
|
595
|
0
|
0
|
|
|
|
|
if(exists $setup->{__TYPE_SEPARATORS}{$tree_type}) |
|
596
|
|
|
|
|
|
|
{ |
|
597
|
0
|
|
|
|
|
|
($opening_bracket, $closing_bracket) = @{$setup->{__TYPE_SEPARATORS}{$tree_type}} ; |
|
|
0
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
} |
|
599
|
|
|
|
|
|
|
else |
|
600
|
|
|
|
|
|
|
{ |
|
601
|
0
|
|
|
|
|
|
($opening_bracket, $closing_bracket) = ('<Unknown type!', '>') ; |
|
602
|
|
|
|
|
|
|
} |
|
603
|
|
|
|
|
|
|
|
|
604
|
0
|
|
|
|
|
|
return($opening_bracket, $closing_bracket) ; |
|
605
|
|
|
|
|
|
|
} |
|
606
|
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
sub RenderEnd |
|
610
|
|
|
|
|
|
|
{ |
|
611
|
0
|
|
|
0
|
0
|
|
my ($output_ref, $setup) = @_ ; |
|
612
|
|
|
|
|
|
|
|
|
613
|
0
|
0
|
|
|
|
|
return('') if $setup->{NO_OUTPUT} ; |
|
614
|
|
|
|
|
|
|
|
|
615
|
0
|
0
|
|
|
|
|
if(defined $setup->{RENDERER}{END}) |
|
616
|
|
|
|
|
|
|
{ |
|
617
|
0
|
|
|
|
|
|
$$output_ref .= $setup->{RENDERER}{END}($setup) ; |
|
618
|
|
|
|
|
|
|
} |
|
619
|
|
|
|
|
|
|
else |
|
620
|
|
|
|
|
|
|
{ |
|
621
|
0
|
0
|
|
|
|
|
unless ($setup->{USE_ASCII}) |
|
622
|
|
|
|
|
|
|
{ |
|
623
|
|
|
|
|
|
|
|
|
624
|
0
|
|
|
|
|
|
$$output_ref =~ s/\| /\033(0\170 \033(B/g ; |
|
625
|
0
|
|
|
|
|
|
$$output_ref =~ s/\|- /\033(0\164\161 \033(B/g ; |
|
626
|
0
|
|
|
|
|
|
$$output_ref =~ s/\`- /\033(0\155\161 \033(B/g ; |
|
627
|
|
|
|
|
|
|
} |
|
628
|
|
|
|
|
|
|
} |
|
629
|
|
|
|
|
|
|
} |
|
630
|
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
sub RenderRoot |
|
634
|
|
|
|
|
|
|
{ |
|
635
|
0
|
|
|
0
|
0
|
|
my ($tree, $setup) = @_ ; |
|
636
|
0
|
|
|
|
|
|
my $output = '' ; |
|
637
|
|
|
|
|
|
|
|
|
638
|
0
|
0
|
0
|
|
|
|
if(defined $setup->{RENDERER} && '' eq ref $setup->{RENDERER}) |
|
639
|
|
|
|
|
|
|
{ |
|
640
|
0
|
|
|
|
|
|
eval <<EOE ; |
|
641
|
|
|
|
|
|
|
use Data::TreeDumper::Renderer::$setup->{RENDERER} ; |
|
642
|
|
|
|
|
|
|
\$setup->{RENDERER} = Data::TreeDumper::Renderer::$setup->{RENDERER}::GetRenderer() ; |
|
643
|
|
|
|
|
|
|
EOE |
|
644
|
|
|
|
|
|
|
|
|
645
|
0
|
0
|
|
|
|
|
die "Data::TreeDumper couldn't load renderer '$setup->{RENDERER}':\n$@" if $@ ; |
|
646
|
|
|
|
|
|
|
} |
|
647
|
|
|
|
|
|
|
|
|
648
|
0
|
0
|
|
|
|
|
if(defined $setup->{RENDERER}{NAME}) |
|
649
|
|
|
|
|
|
|
{ |
|
650
|
0
|
|
|
|
|
|
eval <<EOE ; |
|
651
|
|
|
|
|
|
|
use Data::TreeDumper::Renderer::$setup->{RENDERER}{NAME} ; |
|
652
|
|
|
|
|
|
|
\$setup->{RENDERER} = {%{\$setup->{RENDERER}}, %{Data::TreeDumper::Renderer::$setup->{RENDERER}{NAME}::GetRenderer()}} ; |
|
653
|
|
|
|
|
|
|
EOE |
|
654
|
|
|
|
|
|
|
|
|
655
|
0
|
0
|
|
|
|
|
die "Data::TreeDumper couldn't load renderer '$setup->{RENDERER}{NAME}':\n$@" if $@ ; |
|
656
|
|
|
|
|
|
|
} |
|
657
|
|
|
|
|
|
|
|
|
658
|
0
|
0
|
|
|
|
|
unless($setup->{NO_OUTPUT}) |
|
659
|
|
|
|
|
|
|
{ |
|
660
|
0
|
|
|
|
|
|
my $root_tie_and_class = GetElementTieAndClass($setup, $tree) ; |
|
661
|
|
|
|
|
|
|
|
|
662
|
0
|
0
|
|
|
|
|
if(defined $setup->{RENDERER}{BEGIN}) |
|
663
|
|
|
|
|
|
|
{ |
|
664
|
0
|
|
|
|
|
|
my $root_address = '' ; |
|
665
|
0
|
0
|
|
|
|
|
$root_address = GetReferenceType($tree) . 'O' if($setup->{DISPLAY_ROOT_ADDRESS}) ; |
|
666
|
|
|
|
|
|
|
|
|
667
|
0
|
|
|
|
|
|
my $perl_address = '' ; |
|
668
|
0
|
0
|
|
|
|
|
$perl_address = $tree if($setup->{DISPLAY_PERL_ADDRESS}) ; |
|
669
|
|
|
|
|
|
|
|
|
670
|
0
|
|
|
|
|
|
my $perl_size = '' ; |
|
671
|
0
|
0
|
|
|
|
|
$perl_size = total_size($tree) if($setup->{DISPLAY_PERL_SIZE}) ; |
|
672
|
|
|
|
|
|
|
|
|
673
|
0
|
|
|
|
|
|
$output .= $setup->{RENDERER}{BEGIN}($setup->{TITLE} . $root_tie_and_class, $root_address, $tree, $perl_size, $perl_address, $setup) ; |
|
674
|
|
|
|
|
|
|
} |
|
675
|
|
|
|
|
|
|
else |
|
676
|
|
|
|
|
|
|
{ |
|
677
|
0
|
|
|
|
|
|
$output .= $setup->{INDENTATION} ; |
|
678
|
|
|
|
|
|
|
|
|
679
|
0
|
0
|
|
|
|
|
$output .= defined $setup->{TITLE} ? $setup->{TITLE} : '' ; |
|
680
|
0
|
|
|
|
|
|
$output .= $root_tie_and_class ; |
|
681
|
0
|
0
|
|
|
|
|
$output .= ' [' . GetReferenceType($tree) . "0]" if($setup->{DISPLAY_ROOT_ADDRESS}) ; |
|
682
|
0
|
0
|
|
|
|
|
$output .= " $tree" if($setup->{DISPLAY_PERL_ADDRESS}) ; |
|
683
|
0
|
0
|
|
|
|
|
$output .= " <" . total_size($tree) . ">" if($setup->{DISPLAY_PERL_SIZE}) ; |
|
684
|
0
|
|
|
|
|
|
$output .= "\n" ; |
|
685
|
|
|
|
|
|
|
} |
|
686
|
|
|
|
|
|
|
} |
|
687
|
|
|
|
|
|
|
|
|
688
|
0
|
|
|
|
|
|
return($output) ; |
|
689
|
|
|
|
|
|
|
} |
|
690
|
|
|
|
|
|
|
|
|
691
|
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
sub RenderNode |
|
694
|
|
|
|
|
|
|
{ |
|
695
|
|
|
|
|
|
|
|
|
696
|
|
|
|
|
|
|
my |
|
697
|
|
|
|
|
|
|
( |
|
698
|
0
|
|
|
0
|
0
|
|
$element |
|
699
|
|
|
|
|
|
|
, $element_name |
|
700
|
|
|
|
|
|
|
, $level |
|
701
|
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
, $previous_level_separator |
|
704
|
|
|
|
|
|
|
, $separator |
|
705
|
|
|
|
|
|
|
, $subsequent_separator |
|
706
|
|
|
|
|
|
|
, $separator_size |
|
707
|
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
, $is_terminal_node |
|
709
|
|
|
|
|
|
|
, $perl_size |
|
710
|
|
|
|
|
|
|
, $perl_address |
|
711
|
|
|
|
|
|
|
, $tag |
|
712
|
|
|
|
|
|
|
, $element_value |
|
713
|
|
|
|
|
|
|
, $default_element_rendering |
|
714
|
|
|
|
|
|
|
, $dtd_address |
|
715
|
|
|
|
|
|
|
, $address_field |
|
716
|
|
|
|
|
|
|
, $address_link |
|
717
|
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
, $setup |
|
719
|
|
|
|
|
|
|
) = @_ ; |
|
720
|
|
|
|
|
|
|
|
|
721
|
0
|
|
|
|
|
|
my $output = '' ; |
|
722
|
|
|
|
|
|
|
|
|
723
|
0
|
0
|
|
|
|
|
return('') if $setup->{NO_OUTPUT} ; |
|
724
|
|
|
|
|
|
|
|
|
725
|
0
|
0
|
|
|
|
|
if(defined $setup->{RENDERER}{NODE}) |
|
726
|
|
|
|
|
|
|
{ |
|
727
|
|
|
|
|
|
|
|
|
728
|
0
|
|
|
|
|
|
$output .= $setup->{RENDERER}{NODE} |
|
729
|
|
|
|
|
|
|
( |
|
730
|
|
|
|
|
|
|
$element |
|
731
|
|
|
|
|
|
|
, $level |
|
732
|
|
|
|
|
|
|
, $is_terminal_node |
|
733
|
|
|
|
|
|
|
, $previous_level_separator |
|
734
|
|
|
|
|
|
|
, $separator |
|
735
|
|
|
|
|
|
|
, $element_name |
|
736
|
|
|
|
|
|
|
, $element_value |
|
737
|
|
|
|
|
|
|
, $dtd_address |
|
738
|
|
|
|
|
|
|
, $address_link |
|
739
|
|
|
|
|
|
|
, $perl_size |
|
740
|
|
|
|
|
|
|
, $perl_address |
|
741
|
|
|
|
|
|
|
, $setup |
|
742
|
|
|
|
|
|
|
) ; |
|
743
|
|
|
|
|
|
|
} |
|
744
|
|
|
|
|
|
|
else |
|
745
|
|
|
|
|
|
|
{ |
|
746
|
|
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
|
|
749
|
0
|
|
|
|
|
|
my $level_text = GetLevelText($element, $level, $setup) ; |
|
750
|
0
|
|
|
|
|
|
my $tree_header = $setup->{INDENTATION} . $level_text . $previous_level_separator . $separator ; |
|
751
|
0
|
|
|
|
|
|
my $tree_subsequent_header = $setup->{INDENTATION} . $level_text . $previous_level_separator . $subsequent_separator ; |
|
752
|
|
|
|
|
|
|
|
|
753
|
0
|
|
|
|
|
|
my $element_description = $element_name . $default_element_rendering ; |
|
754
|
|
|
|
|
|
|
|
|
755
|
0
|
0
|
|
|
|
|
$perl_size = " <$perl_size> " unless $perl_size eq '' ; |
|
756
|
|
|
|
|
|
|
|
|
757
|
0
|
|
|
|
|
|
$element_description .= " $address_field$perl_size$perl_address\n" ; |
|
758
|
|
|
|
|
|
|
|
|
759
|
0
|
0
|
|
|
|
|
if($setup->{NO_WRAP}) |
|
760
|
|
|
|
|
|
|
{ |
|
761
|
0
|
|
|
|
|
|
$output .= $tree_header ; |
|
762
|
0
|
|
|
|
|
|
$output .= $element_description ; |
|
763
|
|
|
|
|
|
|
} |
|
764
|
|
|
|
|
|
|
else |
|
765
|
|
|
|
|
|
|
{ |
|
766
|
0
|
|
|
|
|
|
my ($columns, $rows) = ('', '') ; |
|
767
|
|
|
|
|
|
|
|
|
768
|
0
|
0
|
|
|
|
|
if(defined $setup->{WRAP_WIDTH}) |
|
769
|
|
|
|
|
|
|
{ |
|
770
|
0
|
|
|
|
|
|
$columns = $setup->{WRAP_WIDTH} ; |
|
771
|
|
|
|
|
|
|
} |
|
772
|
|
|
|
|
|
|
else |
|
773
|
|
|
|
|
|
|
{ |
|
774
|
0
|
0
|
|
|
|
|
if(defined $^O) |
|
775
|
|
|
|
|
|
|
{ |
|
776
|
0
|
0
|
|
|
|
|
if($^O ne 'MSWin32') |
|
777
|
|
|
|
|
|
|
{ |
|
778
|
0
|
|
|
|
|
|
eval "(\$columns, \$rows) = Term::Size::chars *STDOUT{IO} ;" ; |
|
779
|
|
|
|
|
|
|
} |
|
780
|
|
|
|
|
|
|
else |
|
781
|
|
|
|
|
|
|
{ |
|
782
|
0
|
|
|
|
|
|
($columns, $rows) = $WIN32_CONSOLE->Size(); |
|
783
|
|
|
|
|
|
|
} |
|
784
|
|
|
|
|
|
|
} |
|
785
|
|
|
|
|
|
|
|
|
786
|
0
|
0
|
|
|
|
|
if($columns eq '') |
|
787
|
|
|
|
|
|
|
{ |
|
788
|
0
|
|
|
|
|
|
$columns = $setup->{VIRTUAL_WIDTH} ; |
|
789
|
|
|
|
|
|
|
} |
|
790
|
|
|
|
|
|
|
} |
|
791
|
|
|
|
|
|
|
|
|
792
|
0
|
|
|
|
|
|
local $Text::Wrap::columns = $columns ; |
|
793
|
0
|
|
|
|
|
|
local $Text::Wrap::unexpand = 0 ; |
|
794
|
|
|
|
|
|
|
|
|
795
|
0
|
0
|
0
|
|
|
|
if(length($tree_header) + length($element_description) > $columns && ! $setup->{NO_WRAP}) |
|
796
|
|
|
|
|
|
|
{ |
|
797
|
0
|
|
|
|
|
|
$output .= wrap |
|
798
|
|
|
|
|
|
|
( |
|
799
|
|
|
|
|
|
|
$tree_header |
|
800
|
|
|
|
|
|
|
, $tree_subsequent_header |
|
801
|
|
|
|
|
|
|
, $element_description |
|
802
|
|
|
|
|
|
|
) ; |
|
803
|
|
|
|
|
|
|
} |
|
804
|
|
|
|
|
|
|
else |
|
805
|
|
|
|
|
|
|
{ |
|
806
|
0
|
|
|
|
|
|
$output .= $tree_header ; |
|
807
|
0
|
|
|
|
|
|
$output .= $element_description ; |
|
808
|
|
|
|
|
|
|
} |
|
809
|
|
|
|
|
|
|
} |
|
810
|
|
|
|
|
|
|
} |
|
811
|
|
|
|
|
|
|
|
|
812
|
0
|
|
|
|
|
|
return($output) ; |
|
813
|
|
|
|
|
|
|
} |
|
814
|
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
|
|
817
|
|
|
|
|
|
|
sub GetElementInfo |
|
818
|
|
|
|
|
|
|
{ |
|
819
|
|
|
|
|
|
|
my |
|
820
|
|
|
|
|
|
|
( |
|
821
|
0
|
|
|
0
|
0
|
|
$element |
|
822
|
|
|
|
|
|
|
, $element_name |
|
823
|
|
|
|
|
|
|
, $element_address |
|
824
|
|
|
|
|
|
|
, $element_id |
|
825
|
|
|
|
|
|
|
, $level |
|
826
|
|
|
|
|
|
|
, $already_displayed_nodes |
|
827
|
|
|
|
|
|
|
, $setup |
|
828
|
|
|
|
|
|
|
) = @_ ; |
|
829
|
|
|
|
|
|
|
|
|
830
|
0
|
|
|
|
|
|
my $perl_size = '' ; |
|
831
|
|
|
|
|
|
|
|
|
832
|
0
|
0
|
|
|
|
|
$perl_size = total_size($element) if($setup->{DISPLAY_PERL_SIZE}) ; |
|
833
|
|
|
|
|
|
|
|
|
834
|
0
|
|
|
|
|
|
my $perl_address = "" ; |
|
835
|
0
|
|
|
|
|
|
my $tag = '' ; |
|
836
|
0
|
|
|
|
|
|
my $element_value = '' ; |
|
837
|
0
|
|
|
|
|
|
my $is_terminal_node = 0 ; |
|
838
|
0
|
|
|
|
|
|
my $default_element_rendering = '' ; |
|
839
|
|
|
|
|
|
|
|
|
840
|
0
|
|
|
|
|
|
for(ref $element) |
|
841
|
|
|
|
|
|
|
{ |
|
842
|
|
|
|
|
|
|
'' eq $_ and do |
|
843
|
0
|
0
|
|
|
|
|
{ |
|
844
|
0
|
|
|
|
|
|
$is_terminal_node++ ; |
|
845
|
0
|
|
|
|
|
|
$tag = 'S' ; |
|
846
|
|
|
|
|
|
|
|
|
847
|
0
|
|
|
|
|
|
$element_address = $already_displayed_nodes->{NEXT_INDEX} ; |
|
848
|
|
|
|
|
|
|
|
|
849
|
0
|
0
|
|
|
|
|
my $value = defined $element ? $element : 'undef' ; |
|
850
|
0
|
|
|
|
|
|
$element_value = "$value" ; |
|
851
|
|
|
|
|
|
|
|
|
852
|
0
|
|
|
|
|
|
my $replacement_list = $setup->{REPLACEMENT_LIST} ; |
|
853
|
0
|
0
|
|
|
|
|
if(defined $replacement_list) |
|
854
|
|
|
|
|
|
|
{ |
|
855
|
0
|
|
|
|
|
|
for my $replacement (@$replacement_list) |
|
856
|
|
|
|
|
|
|
{ |
|
857
|
0
|
|
|
|
|
|
my $find = $replacement->[0] ; |
|
858
|
0
|
|
|
|
|
|
my $replace = $replacement->[1] ; |
|
859
|
0
|
|
|
|
|
|
$element_value =~ s/$find/$replace/g ; |
|
860
|
|
|
|
|
|
|
} |
|
861
|
|
|
|
|
|
|
} |
|
862
|
|
|
|
|
|
|
|
|
863
|
0
|
0
|
0
|
|
|
|
if($setup->{QUOTE_VALUES} && defined $element) |
|
864
|
|
|
|
|
|
|
{ |
|
865
|
0
|
|
|
|
|
|
$default_element_rendering = " = '$element_value'" ; |
|
866
|
|
|
|
|
|
|
} |
|
867
|
|
|
|
|
|
|
else |
|
868
|
|
|
|
|
|
|
{ |
|
869
|
0
|
|
|
|
|
|
$default_element_rendering = " = $element_value" ; |
|
870
|
|
|
|
|
|
|
} |
|
871
|
|
|
|
|
|
|
|
|
872
|
0
|
0
|
|
|
|
|
$perl_address = "$element_id" if($setup->{DISPLAY_PERL_ADDRESS}) ; |
|
873
|
|
|
|
|
|
|
|
|
874
|
|
|
|
|
|
|
|
|
875
|
0
|
|
|
|
|
|
last ; |
|
876
|
|
|
|
|
|
|
} ; |
|
877
|
|
|
|
|
|
|
|
|
878
|
|
|
|
|
|
|
'HASH' eq $_ and do |
|
879
|
0
|
0
|
|
|
|
|
{ |
|
880
|
0
|
|
|
|
|
|
$is_terminal_node = IsTerminalNode |
|
881
|
|
|
|
|
|
|
( |
|
882
|
|
|
|
|
|
|
$element |
|
883
|
|
|
|
|
|
|
, $element_name |
|
884
|
|
|
|
|
|
|
, $level |
|
885
|
|
|
|
|
|
|
, $setup |
|
886
|
|
|
|
|
|
|
) ; |
|
887
|
|
|
|
|
|
|
|
|
888
|
0
|
|
|
|
|
|
$tag = 'H' ; |
|
889
|
0
|
0
|
|
|
|
|
$perl_address = "$element" if($setup->{DISPLAY_PERL_ADDRESS}) ; |
|
890
|
|
|
|
|
|
|
|
|
891
|
0
|
0
|
0
|
|
|
|
if(! %{$element} && ! $setup->{NO_NO_ELEMENTS}) |
|
|
0
|
|
|
|
|
|
|
|
892
|
|
|
|
|
|
|
{ |
|
893
|
0
|
|
|
|
|
|
$default_element_rendering = $element_value = ' (no elements)' ; |
|
894
|
|
|
|
|
|
|
} |
|
895
|
|
|
|
|
|
|
|
|
896
|
0
|
0
|
0
|
|
|
|
if |
|
|
|
|
0
|
|
|
|
|
|
897
|
|
|
|
|
|
|
( |
|
898
|
0
|
|
|
|
|
|
%{$element} |
|
899
|
|
|
|
|
|
|
&& |
|
900
|
|
|
|
|
|
|
( |
|
901
|
|
|
|
|
|
|
(($setup->{MAX_DEPTH} == $level + 1) && $setup->{DISPLAY_NUMBER_OF_ELEMENTS_OVER_MAX_DEPTH}) |
|
902
|
|
|
|
|
|
|
|| $setup->{DISPLAY_NUMBER_OF_ELEMENTS} |
|
903
|
|
|
|
|
|
|
) |
|
904
|
|
|
|
|
|
|
) |
|
905
|
|
|
|
|
|
|
{ |
|
906
|
0
|
|
|
|
|
|
my $number_of_elements = keys %{$element} ; |
|
|
0
|
|
|
|
|
|
|
|
907
|
0
|
0
|
|
|
|
|
my $plural = $number_of_elements > 1 ? 's' : '' ; |
|
908
|
0
|
|
|
|
|
|
my $elements = ' (' . $number_of_elements . ' element' . $plural . ')' ; |
|
909
|
|
|
|
|
|
|
|
|
910
|
0
|
|
|
|
|
|
$default_element_rendering .= $elements ; |
|
911
|
0
|
|
|
|
|
|
$element_value .= $elements ; |
|
912
|
|
|
|
|
|
|
} |
|
913
|
|
|
|
|
|
|
|
|
914
|
0
|
0
|
0
|
|
|
|
if($setup->{DISPLAY_TIE} && (my $tie = tied %$element)) |
|
915
|
|
|
|
|
|
|
{ |
|
916
|
0
|
|
|
|
|
|
$tie =~ s/=.*$// ; |
|
917
|
0
|
|
|
|
|
|
my $tie = " (tied to '$tie')" ; |
|
918
|
0
|
|
|
|
|
|
$default_element_rendering .= $tie ; |
|
919
|
0
|
|
|
|
|
|
$element_value .= $tie ; |
|
920
|
|
|
|
|
|
|
} |
|
921
|
|
|
|
|
|
|
|
|
922
|
0
|
|
|
|
|
|
last ; |
|
923
|
|
|
|
|
|
|
} ; |
|
924
|
|
|
|
|
|
|
|
|
925
|
|
|
|
|
|
|
'ARRAY' eq $_ and do |
|
926
|
0
|
0
|
|
|
|
|
{ |
|
927
|
0
|
|
|
|
|
|
$is_terminal_node = IsTerminalNode |
|
928
|
|
|
|
|
|
|
( |
|
929
|
|
|
|
|
|
|
$element |
|
930
|
|
|
|
|
|
|
, $element_name |
|
931
|
|
|
|
|
|
|
, $level |
|
932
|
|
|
|
|
|
|
, $setup |
|
933
|
|
|
|
|
|
|
) ; |
|
934
|
|
|
|
|
|
|
|
|
935
|
0
|
|
|
|
|
|
$tag = 'A' ; |
|
936
|
0
|
0
|
|
|
|
|
$perl_address = "$element" if($setup->{DISPLAY_PERL_ADDRESS}) ; |
|
937
|
|
|
|
|
|
|
|
|
938
|
0
|
0
|
0
|
|
|
|
if(! @{$element} && ! $setup->{NO_NO_ELEMENTS}) |
|
|
0
|
|
|
|
|
|
|
|
939
|
|
|
|
|
|
|
{ |
|
940
|
0
|
|
|
|
|
|
$default_element_rendering = $element_value .= ' (no elements)' ; |
|
941
|
|
|
|
|
|
|
} |
|
942
|
|
|
|
|
|
|
|
|
943
|
0
|
0
|
0
|
|
|
|
if |
|
|
|
|
0
|
|
|
|
|
|
944
|
|
|
|
|
|
|
( |
|
945
|
0
|
|
|
|
|
|
@{$element} |
|
946
|
|
|
|
|
|
|
&& |
|
947
|
|
|
|
|
|
|
( |
|
948
|
|
|
|
|
|
|
(($setup->{MAX_DEPTH} == $level + 1) && $setup->{DISPLAY_NUMBER_OF_ELEMENTS_OVER_MAX_DEPTH}) |
|
949
|
|
|
|
|
|
|
|| $setup->{DISPLAY_NUMBER_OF_ELEMENTS} |
|
950
|
|
|
|
|
|
|
) |
|
951
|
|
|
|
|
|
|
) |
|
952
|
|
|
|
|
|
|
{ |
|
953
|
0
|
0
|
|
|
|
|
my $plural = scalar(@{$element}) ? 's' : '' ; |
|
|
0
|
|
|
|
|
|
|
|
954
|
0
|
|
|
|
|
|
my $elements = ' (' . @{$element} . ' element' . $plural . ')' ; |
|
|
0
|
|
|
|
|
|
|
|
955
|
|
|
|
|
|
|
|
|
956
|
0
|
|
|
|
|
|
$default_element_rendering .= $elements ; |
|
957
|
0
|
|
|
|
|
|
$element_value .= $elements ; |
|
958
|
|
|
|
|
|
|
} |
|
959
|
|
|
|
|
|
|
|
|
960
|
0
|
0
|
0
|
|
|
|
if($setup->{DISPLAY_TIE} && (my $tie = tied @$element)) |
|
961
|
|
|
|
|
|
|
{ |
|
962
|
0
|
|
|
|
|
|
$tie =~ s/=.*$// ; |
|
963
|
0
|
|
|
|
|
|
my $tie = " (tied to '$tie')" ; |
|
964
|
0
|
|
|
|
|
|
$default_element_rendering .= $tie ; |
|
965
|
0
|
|
|
|
|
|
$element_value .= $tie ; |
|
966
|
|
|
|
|
|
|
} |
|
967
|
0
|
|
|
|
|
|
last ; |
|
968
|
|
|
|
|
|
|
} ; |
|
969
|
|
|
|
|
|
|
|
|
970
|
|
|
|
|
|
|
'CODE' eq $_ and do |
|
971
|
0
|
0
|
|
|
|
|
{ |
|
972
|
0
|
|
|
|
|
|
$is_terminal_node++ ; |
|
973
|
0
|
|
|
|
|
|
$tag = 'C' ; |
|
974
|
|
|
|
|
|
|
|
|
975
|
|
|
|
|
|
|
|
|
976
|
|
|
|
|
|
|
|
|
977
|
|
|
|
|
|
|
|
|
978
|
0
|
|
|
|
|
|
$element_value = "$element" ; |
|
979
|
0
|
|
|
|
|
|
$default_element_rendering= " = $element_value" ; |
|
980
|
0
|
0
|
|
|
|
|
$perl_address = "$element_id" if($setup->{DISPLAY_PERL_ADDRESS}) ; |
|
981
|
0
|
|
|
|
|
|
last ; |
|
982
|
|
|
|
|
|
|
} ; |
|
983
|
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
'SCALAR' eq $_ and do |
|
985
|
0
|
0
|
|
|
|
|
{ |
|
986
|
0
|
|
|
|
|
|
$is_terminal_node = 0 ; |
|
987
|
0
|
|
|
|
|
|
$tag = 'RS' ; |
|
988
|
0
|
|
|
|
|
|
$element_address = $element_id ; |
|
989
|
0
|
0
|
|
|
|
|
$perl_address = "$element_id" if($setup->{DISPLAY_PERL_ADDRESS}) ; |
|
990
|
0
|
|
|
|
|
|
last ; |
|
991
|
|
|
|
|
|
|
} ; |
|
992
|
|
|
|
|
|
|
|
|
993
|
|
|
|
|
|
|
'GLOB' eq $_ and do |
|
994
|
0
|
0
|
|
|
|
|
{ |
|
995
|
0
|
|
|
|
|
|
$is_terminal_node++ ; |
|
996
|
0
|
|
|
|
|
|
$tag = 'G' ; |
|
997
|
0
|
0
|
|
|
|
|
$perl_address = "$element" if($setup->{DISPLAY_PERL_ADDRESS}) ; |
|
998
|
0
|
|
|
|
|
|
last ; |
|
999
|
|
|
|
|
|
|
} ; |
|
1000
|
|
|
|
|
|
|
|
|
1001
|
|
|
|
|
|
|
'REF' eq $_ and do |
|
1002
|
0
|
0
|
|
|
|
|
{ |
|
1003
|
0
|
|
|
|
|
|
$is_terminal_node = 0 ; |
|
1004
|
0
|
|
|
|
|
|
$tag = 'R' ; |
|
1005
|
0
|
0
|
|
|
|
|
$perl_address = $element if($setup->{DISPLAY_PERL_ADDRESS}) ; |
|
1006
|
0
|
|
|
|
|
|
last ; |
|
1007
|
|
|
|
|
|
|
} ; |
|
1008
|
|
|
|
|
|
|
|
|
1009
|
|
|
|
|
|
|
|
|
1010
|
0
|
|
|
|
|
|
$tag = 'O' ; |
|
1011
|
0
|
|
|
|
|
|
my $object_elements = '' ; |
|
1012
|
|
|
|
|
|
|
|
|
1013
|
0
|
0
|
|
|
|
|
if( obj($element, 'HASH') ) |
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
1014
|
|
|
|
|
|
|
{ |
|
1015
|
0
|
|
|
|
|
|
$tag = 'OH' ; |
|
1016
|
0
|
0
|
0
|
|
|
|
if |
|
|
|
|
0
|
|
|
|
|
|
1017
|
|
|
|
|
|
|
( |
|
1018
|
0
|
|
|
|
|
|
%{$element} |
|
1019
|
|
|
|
|
|
|
&& |
|
1020
|
|
|
|
|
|
|
( |
|
1021
|
|
|
|
|
|
|
(($setup->{MAX_DEPTH} == $level + 1) && $setup->{DISPLAY_NUMBER_OF_ELEMENTS_OVER_MAX_DEPTH}) |
|
1022
|
|
|
|
|
|
|
|| $setup->{DISPLAY_NUMBER_OF_ELEMENTS} |
|
1023
|
|
|
|
|
|
|
) |
|
1024
|
|
|
|
|
|
|
) |
|
1025
|
|
|
|
|
|
|
{ |
|
1026
|
0
|
|
|
|
|
|
my $number_of_elements = keys %{$element} ; |
|
|
0
|
|
|
|
|
|
|
|
1027
|
0
|
0
|
|
|
|
|
my $plural = $number_of_elements > 1 ? 's' : '' ; |
|
1028
|
0
|
|
|
|
|
|
$object_elements = ' (' . $number_of_elements . ' element' . $plural . ')' ; |
|
1029
|
|
|
|
|
|
|
} |
|
1030
|
|
|
|
|
|
|
} |
|
1031
|
|
|
|
|
|
|
elsif(obj($element, 'ARRAY')) |
|
1032
|
|
|
|
|
|
|
{ |
|
1033
|
0
|
|
|
|
|
|
$tag = 'OA' ; |
|
1034
|
0
|
0
|
0
|
|
|
|
if |
|
|
|
|
0
|
|
|
|
|
|
1035
|
|
|
|
|
|
|
( |
|
1036
|
0
|
|
|
|
|
|
@{$element} |
|
1037
|
|
|
|
|
|
|
&& |
|
1038
|
|
|
|
|
|
|
( |
|
1039
|
|
|
|
|
|
|
(($setup->{MAX_DEPTH} == $level + 1) && $setup->{DISPLAY_NUMBER_OF_ELEMENTS_OVER_MAX_DEPTH}) |
|
1040
|
|
|
|
|
|
|
|| $setup->{DISPLAY_NUMBER_OF_ELEMENTS} |
|
1041
|
|
|
|
|
|
|
) |
|
1042
|
|
|
|
|
|
|
) |
|
1043
|
|
|
|
|
|
|
{ |
|
1044
|
0
|
0
|
|
|
|
|
my $plural = scalar(@{$element}) ? 's' : '' ; |
|
|
0
|
|
|
|
|
|
|
|
1045
|
0
|
|
|
|
|
|
$object_elements = ' (' . @{$element} . ' element' . $plural . ')' ; |
|
|
0
|
|
|
|
|
|
|
|
1046
|
|
|
|
|
|
|
} |
|
1047
|
|
|
|
|
|
|
} |
|
1048
|
|
|
|
|
|
|
elsif(obj($element, 'GLOB')) |
|
1049
|
|
|
|
|
|
|
{ |
|
1050
|
0
|
|
|
|
|
|
$tag = 'OG' ; |
|
1051
|
|
|
|
|
|
|
} |
|
1052
|
|
|
|
|
|
|
elsif(obj($element, 'SCALAR')) |
|
1053
|
|
|
|
|
|
|
{ |
|
1054
|
0
|
|
|
|
|
|
$tag = 'OS' ; |
|
1055
|
|
|
|
|
|
|
} |
|
1056
|
|
|
|
|
|
|
|
|
1057
|
0
|
0
|
|
|
|
|
$perl_address = "$element" if($setup->{DISPLAY_PERL_ADDRESS}) ; |
|
1058
|
|
|
|
|
|
|
|
|
1059
|
0
|
|
|
|
|
|
($is_terminal_node, my $element_value) |
|
1060
|
|
|
|
|
|
|
= IsTerminalNode |
|
1061
|
|
|
|
|
|
|
( |
|
1062
|
|
|
|
|
|
|
$element |
|
1063
|
|
|
|
|
|
|
, $element_name |
|
1064
|
|
|
|
|
|
|
, $level |
|
1065
|
|
|
|
|
|
|
, $setup |
|
1066
|
|
|
|
|
|
|
) ; |
|
1067
|
|
|
|
|
|
|
|
|
1068
|
0
|
0
|
|
|
|
|
if($setup->{DISPLAY_OBJECT_TYPE}) |
|
1069
|
|
|
|
|
|
|
{ |
|
1070
|
0
|
|
|
|
|
|
$element_value .= GetElementTieAndClass($setup, $element) ; |
|
1071
|
0
|
|
|
|
|
|
$default_element_rendering = " = $element_value" ; |
|
1072
|
|
|
|
|
|
|
} |
|
1073
|
|
|
|
|
|
|
|
|
1074
|
0
|
|
|
|
|
|
$default_element_rendering .= $object_elements ; |
|
1075
|
|
|
|
|
|
|
} |
|
1076
|
|
|
|
|
|
|
|
|
1077
|
|
|
|
|
|
|
|
|
1078
|
0
|
|
|
|
|
|
my $dtd_address = $tag . $already_displayed_nodes->{NEXT_INDEX} ; |
|
1079
|
|
|
|
|
|
|
|
|
1080
|
0
|
|
|
|
|
|
my $address_field = '' ; |
|
1081
|
0
|
|
|
|
|
|
my $address_link ; |
|
1082
|
|
|
|
|
|
|
|
|
1083
|
0
|
0
|
|
|
|
|
if(exists $already_displayed_nodes->{$element_address}) |
|
1084
|
|
|
|
|
|
|
{ |
|
1085
|
0
|
|
|
|
|
|
$already_displayed_nodes->{NEXT_INDEX}++ ; |
|
1086
|
|
|
|
|
|
|
|
|
1087
|
0
|
0
|
|
|
|
|
$address_field = " [$dtd_address -> $already_displayed_nodes->{$element_address}]" if $setup->{DISPLAY_ADDRESS} ; |
|
1088
|
0
|
|
|
|
|
|
$address_link = $already_displayed_nodes->{$element_address} ; |
|
1089
|
0
|
|
|
|
|
|
$is_terminal_node = 1 ; |
|
1090
|
|
|
|
|
|
|
} |
|
1091
|
|
|
|
|
|
|
else |
|
1092
|
|
|
|
|
|
|
{ |
|
1093
|
0
|
|
|
|
|
|
$already_displayed_nodes->{$element_address} = $dtd_address ; |
|
1094
|
0
|
0
|
|
|
|
|
$already_displayed_nodes->{$element_address} .= " /$setup->{__DATA_PATH}" if $setup->{DISPLAY_PATH}; |
|
1095
|
0
|
|
|
|
|
|
$already_displayed_nodes->{NEXT_INDEX}++ ; |
|
1096
|
|
|
|
|
|
|
|
|
1097
|
0
|
0
|
|
|
|
|
$address_field = " [$dtd_address]" if $setup->{DISPLAY_ADDRESS} ; |
|
1098
|
|
|
|
|
|
|
} |
|
1099
|
|
|
|
|
|
|
|
|
1100
|
|
|
|
|
|
|
|
|
1101
|
|
|
|
|
|
|
return |
|
1102
|
|
|
|
|
|
|
( |
|
1103
|
0
|
|
|
|
|
|
$is_terminal_node |
|
1104
|
|
|
|
|
|
|
, $perl_size |
|
1105
|
|
|
|
|
|
|
, $perl_address |
|
1106
|
|
|
|
|
|
|
, $tag |
|
1107
|
|
|
|
|
|
|
, $element_value |
|
1108
|
|
|
|
|
|
|
, $default_element_rendering |
|
1109
|
|
|
|
|
|
|
, $dtd_address |
|
1110
|
|
|
|
|
|
|
, $address_field |
|
1111
|
|
|
|
|
|
|
, $address_link |
|
1112
|
|
|
|
|
|
|
) ; |
|
1113
|
|
|
|
|
|
|
} |
|
1114
|
|
|
|
|
|
|
|
|
1115
|
|
|
|
|
|
|
|
|
1116
|
|
|
|
|
|
|
|
|
1117
|
|
|
|
|
|
|
sub IsTerminalNode |
|
1118
|
|
|
|
|
|
|
{ |
|
1119
|
|
|
|
|
|
|
my |
|
1120
|
|
|
|
|
|
|
( |
|
1121
|
0
|
|
|
0
|
0
|
|
$element |
|
1122
|
|
|
|
|
|
|
, $element_name |
|
1123
|
|
|
|
|
|
|
, $level |
|
1124
|
|
|
|
|
|
|
, $setup |
|
1125
|
|
|
|
|
|
|
) = @_ ; |
|
1126
|
|
|
|
|
|
|
|
|
1127
|
0
|
|
|
|
|
|
my $is_terminal_node = 0 ; |
|
1128
|
0
|
|
|
|
|
|
my $element_value = '' ; |
|
1129
|
|
|
|
|
|
|
|
|
1130
|
0
|
|
|
|
|
|
my ($filter_sub, $filter_argument) = GetFilter($setup, $level, ref $element) ; |
|
1131
|
|
|
|
|
|
|
|
|
1132
|
0
|
|
|
|
|
|
for(ref $element) |
|
1133
|
|
|
|
|
|
|
{ |
|
1134
|
|
|
|
|
|
|
'' eq $_ and do |
|
1135
|
0
|
0
|
|
|
|
|
{ |
|
1136
|
0
|
|
|
|
|
|
$is_terminal_node = 1 ; |
|
1137
|
0
|
|
|
|
|
|
last ; |
|
1138
|
|
|
|
|
|
|
} ; |
|
1139
|
|
|
|
|
|
|
|
|
1140
|
|
|
|
|
|
|
'HASH' eq $_ and do |
|
1141
|
0
|
0
|
|
|
|
|
{ |
|
1142
|
|
|
|
|
|
|
|
|
1143
|
0
|
0
|
|
|
|
|
$is_terminal_node++ unless %$element ; |
|
1144
|
|
|
|
|
|
|
|
|
1145
|
|
|
|
|
|
|
|
|
1146
|
0
|
0
|
0
|
|
|
|
if(!$is_terminal_node && defined $setup->{RENDERER}{NODE}) |
|
1147
|
|
|
|
|
|
|
{ |
|
1148
|
0
|
0
|
|
|
|
|
if(defined $filter_sub) |
|
1149
|
|
|
|
|
|
|
{ |
|
1150
|
0
|
|
|
|
|
|
my @children_nodes_to_display ; |
|
1151
|
|
|
|
|
|
|
|
|
1152
|
0
|
|
|
|
|
|
local $setup->{__DATA_PATH} = "$setup->{__DATA_PATH}\{$element_name\}" ; |
|
1153
|
0
|
|
|
|
|
|
(undef, undef, @children_nodes_to_display) |
|
1154
|
|
|
|
|
|
|
= $filter_sub->($element, $level + 1, $setup->{__DATA_PATH}, undef, $setup, $filter_argument) ; |
|
1155
|
|
|
|
|
|
|
|
|
1156
|
0
|
0
|
|
|
|
|
$is_terminal_node++ unless @children_nodes_to_display ; |
|
1157
|
|
|
|
|
|
|
} |
|
1158
|
|
|
|
|
|
|
} |
|
1159
|
0
|
|
|
|
|
|
last ; |
|
1160
|
|
|
|
|
|
|
} ; |
|
1161
|
|
|
|
|
|
|
|
|
1162
|
|
|
|
|
|
|
'ARRAY' eq $_ and do |
|
1163
|
0
|
0
|
|
|
|
|
{ |
|
1164
|
|
|
|
|
|
|
|
|
1165
|
0
|
0
|
|
|
|
|
$is_terminal_node++ unless(@$element) ; |
|
1166
|
|
|
|
|
|
|
|
|
1167
|
|
|
|
|
|
|
|
|
1168
|
0
|
0
|
0
|
|
|
|
if(!$is_terminal_node && defined $setup->{RENDERER}{NODE}) |
|
1169
|
|
|
|
|
|
|
{ |
|
1170
|
0
|
0
|
|
|
|
|
if(defined $filter_sub) |
|
1171
|
|
|
|
|
|
|
{ |
|
1172
|
0
|
|
|
|
|
|
my @children_nodes_to_display ; |
|
1173
|
|
|
|
|
|
|
|
|
1174
|
0
|
|
|
|
|
|
local $setup->{__DATA_PATH} = "$setup->{__DATA_PATH}\[$element_name\]" ; |
|
1175
|
0
|
|
|
|
|
|
(undef, undef, @children_nodes_to_display) |
|
1176
|
|
|
|
|
|
|
= $filter_sub->($element, $level + 1, $setup->{__DATA_PATH}, undef, $setup, $filter_argument) ; |
|
1177
|
|
|
|
|
|
|
|
|
1178
|
0
|
0
|
|
|
|
|
$is_terminal_node++ unless @children_nodes_to_display ; |
|
1179
|
|
|
|
|
|
|
} |
|
1180
|
|
|
|
|
|
|
} |
|
1181
|
0
|
|
|
|
|
|
last ; |
|
1182
|
|
|
|
|
|
|
} ; |
|
1183
|
|
|
|
|
|
|
|
|
1184
|
|
|
|
|
|
|
'CODE' eq $_ and do |
|
1185
|
0
|
0
|
|
|
|
|
{ |
|
1186
|
0
|
|
|
|
|
|
$is_terminal_node = 1 ; |
|
1187
|
0
|
|
|
|
|
|
last ; |
|
1188
|
|
|
|
|
|
|
} ; |
|
1189
|
|
|
|
|
|
|
|
|
1190
|
|
|
|
|
|
|
'SCALAR' eq $_ and do |
|
1191
|
0
|
0
|
|
|
|
|
{ |
|
1192
|
0
|
|
|
|
|
|
$is_terminal_node = 0 ; |
|
1193
|
0
|
|
|
|
|
|
last ; |
|
1194
|
|
|
|
|
|
|
} ; |
|
1195
|
|
|
|
|
|
|
|
|
1196
|
|
|
|
|
|
|
'GLOB' eq $_ and do |
|
1197
|
0
|
0
|
|
|
|
|
{ |
|
1198
|
0
|
|
|
|
|
|
$is_terminal_node = 1 ; |
|
1199
|
0
|
|
|
|
|
|
last ; |
|
1200
|
|
|
|
|
|
|
} ; |
|
1201
|
|
|
|
|
|
|
|
|
1202
|
|
|
|
|
|
|
'REF' eq $_ and do |
|
1203
|
0
|
0
|
|
|
|
|
{ |
|
1204
|
0
|
|
|
|
|
|
$is_terminal_node = 0 ; |
|
1205
|
0
|
|
|
|
|
|
last ; |
|
1206
|
|
|
|
|
|
|
} ; |
|
1207
|
|
|
|
|
|
|
|
|
1208
|
|
|
|
|
|
|
|
|
1209
|
|
|
|
|
|
|
|
|
1210
|
0
|
|
|
|
|
|
for($element) |
|
1211
|
|
|
|
|
|
|
{ |
|
1212
|
|
|
|
|
|
|
obj($_, 'HASH') and do |
|
1213
|
0
|
0
|
|
|
|
|
{ |
|
1214
|
0
|
0
|
|
|
|
|
unless(%$element) |
|
1215
|
|
|
|
|
|
|
{ |
|
1216
|
0
|
|
|
|
|
|
$is_terminal_node++ ; |
|
1217
|
|
|
|
|
|
|
|
|
1218
|
0
|
0
|
|
|
|
|
unless($setup->{NO_NO_ELEMENTS}) |
|
1219
|
|
|
|
|
|
|
{ |
|
1220
|
0
|
|
|
|
|
|
$element_value = "(Hash, empty) $element_value" ; |
|
1221
|
|
|
|
|
|
|
} |
|
1222
|
|
|
|
|
|
|
} |
|
1223
|
0
|
|
|
|
|
|
last ; |
|
1224
|
|
|
|
|
|
|
} ; |
|
1225
|
|
|
|
|
|
|
|
|
1226
|
|
|
|
|
|
|
obj($_, 'ARRAY/') and do |
|
1227
|
0
|
0
|
|
|
|
|
{ |
|
1228
|
0
|
0
|
|
|
|
|
unless(@$element) |
|
1229
|
|
|
|
|
|
|
{ |
|
1230
|
0
|
|
|
|
|
|
$is_terminal_node++ ; |
|
1231
|
|
|
|
|
|
|
|
|
1232
|
0
|
0
|
|
|
|
|
unless($setup->{NO_NO_ELEMENTS}) |
|
1233
|
|
|
|
|
|
|
{ |
|
1234
|
0
|
|
|
|
|
|
$element_value = "(Array, empty) $element_value" ; |
|
1235
|
|
|
|
|
|
|
} |
|
1236
|
|
|
|
|
|
|
} |
|
1237
|
0
|
|
|
|
|
|
last ; |
|
1238
|
|
|
|
|
|
|
} ; |
|
1239
|
|
|
|
|
|
|
} |
|
1240
|
|
|
|
|
|
|
} |
|
1241
|
|
|
|
|
|
|
|
|
1242
|
0
|
0
|
|
|
|
|
return($is_terminal_node, $element_value) if wantarray ; |
|
1243
|
0
|
|
|
|
|
|
return($is_terminal_node) ; |
|
1244
|
|
|
|
|
|
|
} |
|
1245
|
|
|
|
|
|
|
|
|
1246
|
|
|
|
|
|
|
|
|
1247
|
|
|
|
|
|
|
|
|
1248
|
|
|
|
|
|
|
sub GetElementTieAndClass |
|
1249
|
|
|
|
|
|
|
{ |
|
1250
|
|
|
|
|
|
|
|
|
1251
|
0
|
|
|
0
|
0
|
|
my ($setup, $element) = @_ ; |
|
1252
|
0
|
|
|
|
|
|
my $element_type = '' ; |
|
1253
|
|
|
|
|
|
|
|
|
1254
|
0
|
0
|
|
|
|
|
if($setup->{DISPLAY_TIE}) |
|
1255
|
|
|
|
|
|
|
{ |
|
1256
|
0
|
0
|
0
|
|
|
|
if(obj($element, 'HASH') && (my $tie_hash = tied %$element)) |
|
|
|
0
|
0
|
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
1257
|
|
|
|
|
|
|
{ |
|
1258
|
0
|
|
|
|
|
|
$tie_hash =~ s/=.*$// ; |
|
1259
|
0
|
|
|
|
|
|
$element_type .= " (tied to '$tie_hash' [H])" |
|
1260
|
|
|
|
|
|
|
} |
|
1261
|
|
|
|
|
|
|
elsif(obj($element, 'ARRAY') && (my $tie_array = tied @$element)) |
|
1262
|
|
|
|
|
|
|
{ |
|
1263
|
0
|
|
|
|
|
|
$tie_array =~ s/=.*$// ; |
|
1264
|
0
|
|
|
|
|
|
$element_type .= " (tied to '$tie_array' [A])" |
|
1265
|
|
|
|
|
|
|
} |
|
1266
|
|
|
|
|
|
|
elsif(obj($element, 'SCALAR') && (my $tie_scalar = tied $$element)) |
|
1267
|
|
|
|
|
|
|
{ |
|
1268
|
0
|
|
|
|
|
|
$tie_scalar =~ s/=.*$// ; |
|
1269
|
0
|
|
|
|
|
|
$element_type .= " (tied to '$tie_scalar' [RS])" |
|
1270
|
|
|
|
|
|
|
} |
|
1271
|
|
|
|
|
|
|
elsif(obj($element, 'GLOB') && (my $tie_glob = tied *$element)) |
|
1272
|
|
|
|
|
|
|
{ |
|
1273
|
0
|
|
|
|
|
|
$tie_glob =~ s/=.*$// ; |
|
1274
|
0
|
|
|
|
|
|
$element_type .= " (tied to '$tie_glob' [G])" |
|
1275
|
|
|
|
|
|
|
} |
|
1276
|
|
|
|
|
|
|
} |
|
1277
|
|
|
|
|
|
|
|
|
1278
|
0
|
|
|
|
|
|
for(ref $element) |
|
1279
|
|
|
|
|
|
|
{ |
|
1280
|
|
|
|
|
|
|
'' eq $_ || 'HASH' eq $_ || 'ARRAY' eq $_ || 'CODE' eq $_ || 'SCALAR' eq $_ || 'GLOB' eq $_ || 'REF' eq $_ and do |
|
1281
|
0
|
0
|
0
|
|
|
|
{ |
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1282
|
0
|
|
|
|
|
|
last ; |
|
1283
|
|
|
|
|
|
|
} ; |
|
1284
|
|
|
|
|
|
|
|
|
1285
|
|
|
|
|
|
|
|
|
1286
|
0
|
0
|
|
|
|
|
if($setup->{DISPLAY_OBJECT_TYPE}) |
|
1287
|
|
|
|
|
|
|
{ |
|
1288
|
0
|
|
|
|
|
|
my $class = ref($element) ; |
|
1289
|
0
|
0
|
|
|
|
|
my $has_autoload = $class->can("AUTOLOAD") ? '[AL]' : '' ; |
|
1290
|
|
|
|
|
|
|
|
|
1291
|
0
|
|
|
|
|
|
$element_type .= " blessed in '$has_autoload$class'" ; |
|
1292
|
|
|
|
|
|
|
|
|
1293
|
0
|
0
|
|
|
|
|
if($setup->{DISPLAY_INHERITANCE}) |
|
1294
|
|
|
|
|
|
|
{ |
|
1295
|
0
|
|
|
|
|
|
for my $base_class (Class::ISA::super_path(ref($element))) |
|
1296
|
|
|
|
|
|
|
{ |
|
1297
|
0
|
0
|
|
|
|
|
if($setup->{DISPLAY_AUTOLOAD}) |
|
1298
|
|
|
|
|
|
|
{ |
|
1299
|
1
|
|
|
1
|
|
20
|
no warnings ; |
|
|
1
|
|
|
|
|
3
|
|
|
|
1
|
|
|
|
|
3649
|
|
|
1300
|
0
|
|
|
|
|
|
eval "\$has_autoload = *${base_class}::AUTOLOAD{CODE} ;" ; |
|
1301
|
|
|
|
|
|
|
|
|
1302
|
0
|
0
|
|
|
|
|
if($has_autoload) |
|
1303
|
|
|
|
|
|
|
{ |
|
1304
|
0
|
|
|
|
|
|
$element_type .= " <- [AL]$base_class " ; |
|
1305
|
|
|
|
|
|
|
} |
|
1306
|
|
|
|
|
|
|
else |
|
1307
|
|
|
|
|
|
|
{ |
|
1308
|
0
|
|
|
|
|
|
$element_type .= " <- $base_class " ; |
|
1309
|
|
|
|
|
|
|
} |
|
1310
|
|
|
|
|
|
|
} |
|
1311
|
|
|
|
|
|
|
else |
|
1312
|
|
|
|
|
|
|
{ |
|
1313
|
0
|
|
|
|
|
|
$element_type .= " <- $base_class " ; |
|
1314
|
|
|
|
|
|
|
} |
|
1315
|
|
|
|
|
|
|
} |
|
1316
|
|
|
|
|
|
|
} |
|
1317
|
|
|
|
|
|
|
} |
|
1318
|
|
|
|
|
|
|
} |
|
1319
|
|
|
|
|
|
|
|
|
1320
|
0
|
|
|
|
|
|
return($element_type) ; |
|
1321
|
|
|
|
|
|
|
} |
|
1322
|
|
|
|
|
|
|
|
|
1323
|
|
|
|
|
|
|
|
|
1324
|
|
|
|
|
|
|
|
|
1325
|
|
|
|
|
|
|
|
|
1326
|
|
|
|
|
|
|
|
|
1327
|
|
|
|
|
|
|
sub DefaultNodesToDisplay |
|
1328
|
|
|
|
|
|
|
{ |
|
1329
|
0
|
|
|
0
|
0
|
|
my ($tree, undef, undef, $keys) = @_ ; |
|
1330
|
|
|
|
|
|
|
|
|
1331
|
0
|
0
|
|
|
|
|
return('', undef) if '' eq ref $tree ; |
|
1332
|
|
|
|
|
|
|
|
|
1333
|
0
|
|
|
|
|
|
my $tree_type = ref $tree ; |
|
1334
|
|
|
|
|
|
|
|
|
1335
|
0
|
0
|
|
|
|
|
if('HASH' eq $tree_type) |
|
1336
|
|
|
|
|
|
|
{ |
|
1337
|
0
|
0
|
|
|
|
|
return('HASH', undef, @$keys) if(defined $keys) ; |
|
1338
|
0
|
|
|
|
|
|
return('HASH', undef, nsort keys %$tree) ; |
|
1339
|
|
|
|
|
|
|
} |
|
1340
|
|
|
|
|
|
|
|
|
1341
|
0
|
0
|
|
|
|
|
if('ARRAY' eq $tree_type) |
|
1342
|
|
|
|
|
|
|
{ |
|
1343
|
0
|
0
|
|
|
|
|
return('ARRAY', undef, @$keys) if(defined $keys) ; |
|
1344
|
0
|
|
|
|
|
|
return('ARRAY', undef, (0 .. @$tree - 1)) ; |
|
1345
|
|
|
|
|
|
|
} |
|
1346
|
|
|
|
|
|
|
|
|
1347
|
0
|
0
|
|
|
|
|
return('SCALAR', undef, (0)) if('SCALAR' eq $tree_type) ; |
|
1348
|
0
|
0
|
|
|
|
|
return('REF', undef, (0)) if('REF' eq $tree_type) ; |
|
1349
|
0
|
0
|
|
|
|
|
return('CODE', undef, (0)) if('CODE' eq $tree_type) ; |
|
1350
|
|
|
|
|
|
|
|
|
1351
|
0
|
|
|
|
|
|
my @nodes_to_display ; |
|
1352
|
0
|
|
|
|
|
|
undef $tree_type ; |
|
1353
|
|
|
|
|
|
|
|
|
1354
|
0
|
|
|
|
|
|
for($tree) |
|
1355
|
|
|
|
|
|
|
{ |
|
1356
|
|
|
|
|
|
|
obj($_, 'HASH') and do |
|
1357
|
0
|
0
|
|
|
|
|
{ |
|
1358
|
0
|
|
|
|
|
|
@nodes_to_display = nsort keys %$tree ; |
|
1359
|
0
|
|
|
|
|
|
$tree_type = 'HASH' ; |
|
1360
|
0
|
|
|
|
|
|
last ; |
|
1361
|
|
|
|
|
|
|
} ; |
|
1362
|
|
|
|
|
|
|
|
|
1363
|
|
|
|
|
|
|
obj($_, 'ARRAY') and do |
|
1364
|
0
|
0
|
|
|
|
|
{ |
|
1365
|
0
|
|
|
|
|
|
@nodes_to_display = (0 .. @$tree - 1) ; |
|
1366
|
0
|
|
|
|
|
|
$tree_type = 'ARRAY' ; |
|
1367
|
0
|
|
|
|
|
|
last ; |
|
1368
|
|
|
|
|
|
|
} ; |
|
1369
|
|
|
|
|
|
|
|
|
1370
|
|
|
|
|
|
|
obj($_, 'GLOB') and do |
|
1371
|
0
|
0
|
|
|
|
|
{ |
|
1372
|
0
|
|
|
|
|
|
@nodes_to_display = (0) ; |
|
1373
|
0
|
|
|
|
|
|
$tree_type = 'REF' ; |
|
1374
|
0
|
|
|
|
|
|
last ; |
|
1375
|
|
|
|
|
|
|
} ; |
|
1376
|
|
|
|
|
|
|
|
|
1377
|
|
|
|
|
|
|
obj($_, 'SCALAR') and do |
|
1378
|
0
|
0
|
|
|
|
|
{ |
|
1379
|
0
|
|
|
|
|
|
@nodes_to_display = (0) ; |
|
1380
|
0
|
|
|
|
|
|
$tree_type = 'REF' ; |
|
1381
|
0
|
|
|
|
|
|
last ; |
|
1382
|
|
|
|
|
|
|
} ; |
|
1383
|
|
|
|
|
|
|
|
|
1384
|
0
|
|
|
|
|
|
warn "TreeDumper: Unsupported underlying type for $tree.\n" ; |
|
1385
|
|
|
|
|
|
|
} |
|
1386
|
|
|
|
|
|
|
|
|
1387
|
0
|
|
|
|
|
|
return($tree_type, undef, @nodes_to_display) ; |
|
1388
|
|
|
|
|
|
|
} |
|
1389
|
|
|
|
|
|
|
|
|
1390
|
|
|
|
|
|
|
|
|
1391
|
|
|
|
|
|
|
|
|
1392
|
|
|
|
|
|
|
sub CreateChainingFilter |
|
1393
|
|
|
|
|
|
|
{ |
|
1394
|
0
|
|
|
0
|
0
|
|
my @filters = @_ ; |
|
1395
|
|
|
|
|
|
|
|
|
1396
|
|
|
|
|
|
|
return sub |
|
1397
|
|
|
|
|
|
|
{ |
|
1398
|
0
|
|
|
0
|
|
|
my ($tree, $level, $path, $keys) = @_ ; |
|
1399
|
|
|
|
|
|
|
|
|
1400
|
0
|
|
|
|
|
|
my ($tree_type, $replacement_tree); |
|
1401
|
|
|
|
|
|
|
|
|
1402
|
0
|
|
|
|
|
|
for my $filter (@filters) |
|
1403
|
|
|
|
|
|
|
{ |
|
1404
|
0
|
|
|
|
|
|
($tree_type, $replacement_tree, @$keys) = $filter->($tree, $level, $path, $keys) ; |
|
1405
|
0
|
0
|
|
|
|
|
$tree = $replacement_tree if (defined $replacement_tree) ; |
|
1406
|
|
|
|
|
|
|
} |
|
1407
|
|
|
|
|
|
|
|
|
1408
|
0
|
|
|
|
|
|
return ($tree_type, $replacement_tree, @$keys) ; |
|
1409
|
|
|
|
|
|
|
} |
|
1410
|
0
|
|
|
|
|
|
} ; |
|
1411
|
|
|
|
|
|
|
|
|
1412
|
|
|
|
|
|
|
|
|
1413
|
|
|
|
|
|
|
|
|
1414
|
|
|
|
|
|
|
|
|
1415
|
|
|
|
|
|
|
|
|
1416
|
|
|
|
|
|
|
{ |
|
1417
|
|
|
|
|
|
|
my %types = |
|
1418
|
|
|
|
|
|
|
( |
|
1419
|
|
|
|
|
|
|
'' => 'SCALAR! not a reference!' |
|
1420
|
|
|
|
|
|
|
, 'REF' => 'R' |
|
1421
|
|
|
|
|
|
|
, 'CODE' => 'C' |
|
1422
|
|
|
|
|
|
|
, 'HASH' => 'H' |
|
1423
|
|
|
|
|
|
|
, 'ARRAY' => 'A' |
|
1424
|
|
|
|
|
|
|
, 'SCALAR' => 'RS' |
|
1425
|
|
|
|
|
|
|
) ; |
|
1426
|
|
|
|
|
|
|
|
|
1427
|
|
|
|
|
|
|
sub GetReferenceType |
|
1428
|
|
|
|
|
|
|
{ |
|
1429
|
0
|
|
|
0
|
0
|
|
my $element = shift ; |
|
1430
|
0
|
|
|
|
|
|
my $reference = ref $element ; |
|
1431
|
|
|
|
|
|
|
|
|
1432
|
0
|
0
|
|
|
|
|
if(exists $types{$reference}) |
|
1433
|
|
|
|
|
|
|
{ |
|
1434
|
0
|
|
|
|
|
|
return($types{$reference}) ; |
|
1435
|
|
|
|
|
|
|
} |
|
1436
|
|
|
|
|
|
|
else |
|
1437
|
|
|
|
|
|
|
{ |
|
1438
|
0
|
|
|
|
|
|
my $tag = 'O?' ; |
|
1439
|
|
|
|
|
|
|
|
|
1440
|
0
|
0
|
|
|
|
|
if($element =~ /=HASH/ ) |
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
1441
|
|
|
|
|
|
|
{ |
|
1442
|
0
|
|
|
|
|
|
$tag = 'OH' ; |
|
1443
|
|
|
|
|
|
|
} |
|
1444
|
|
|
|
|
|
|
elsif($element =~ /=ARRAY/) |
|
1445
|
|
|
|
|
|
|
{ |
|
1446
|
0
|
|
|
|
|
|
$tag = 'OA' ; |
|
1447
|
|
|
|
|
|
|
} |
|
1448
|
|
|
|
|
|
|
elsif($element =~ /=GLOB/) |
|
1449
|
|
|
|
|
|
|
{ |
|
1450
|
0
|
|
|
|
|
|
$tag = 'OG' ; |
|
1451
|
|
|
|
|
|
|
} |
|
1452
|
|
|
|
|
|
|
elsif($element =~ /=SCALAR/) |
|
1453
|
|
|
|
|
|
|
{ |
|
1454
|
0
|
|
|
|
|
|
$tag = 'OS' ; |
|
1455
|
|
|
|
|
|
|
} |
|
1456
|
|
|
|
|
|
|
|
|
1457
|
0
|
|
|
|
|
|
return($tag) ; |
|
1458
|
|
|
|
|
|
|
} |
|
1459
|
|
|
|
|
|
|
} |
|
1460
|
|
|
|
|
|
|
|
|
1461
|
|
|
|
|
|
|
} |
|
1462
|
|
|
|
|
|
|
|
|
1463
|
|
|
|
|
|
|
|
|
1464
|
|
|
|
|
|
|
|
|
1465
|
|
|
|
|
|
|
sub GetLevelText |
|
1466
|
|
|
|
|
|
|
{ |
|
1467
|
0
|
|
|
0
|
0
|
|
my ($element, $level, $setup) = @_ ; |
|
1468
|
0
|
|
|
|
|
|
my $level_text = '' ; |
|
1469
|
|
|
|
|
|
|
|
|
1470
|
0
|
0
|
|
|
|
|
if($setup->{NUMBER_LEVELS}) |
|
1471
|
|
|
|
|
|
|
{ |
|
1472
|
0
|
0
|
|
|
|
|
if('CODE' eq ref $setup->{NUMBER_LEVELS}) |
|
1473
|
|
|
|
|
|
|
{ |
|
1474
|
0
|
|
|
|
|
|
$level_text = $setup->{NUMBER_LEVELS}->($element, $level, $setup) ; |
|
1475
|
|
|
|
|
|
|
} |
|
1476
|
|
|
|
|
|
|
else |
|
1477
|
|
|
|
|
|
|
{ |
|
1478
|
0
|
|
|
|
|
|
my $color_levels = $setup->{COLOR_LEVELS} ; |
|
1479
|
0
|
|
|
|
|
|
my ($color_start, $color_end) = ('', '') ; |
|
1480
|
|
|
|
|
|
|
|
|
1481
|
0
|
0
|
|
|
|
|
if($color_levels) |
|
1482
|
|
|
|
|
|
|
{ |
|
1483
|
0
|
0
|
|
|
|
|
if('ARRAY' eq ref $color_levels) |
|
1484
|
|
|
|
|
|
|
{ |
|
1485
|
0
|
|
|
|
|
|
my $color_index = $level % @{$color_levels->[0]} ; |
|
|
0
|
|
|
|
|
|
|
|
1486
|
0
|
|
|
|
|
|
($color_start, $color_end) = ($color_levels->[0][$color_index] , $color_levels->[1]) ; |
|
1487
|
|
|
|
|
|
|
} |
|
1488
|
|
|
|
|
|
|
else |
|
1489
|
|
|
|
|
|
|
{ |
|
1490
|
|
|
|
|
|
|
|
|
1491
|
0
|
|
|
|
|
|
($color_start, $color_end) = $color_levels->($level) ; |
|
1492
|
|
|
|
|
|
|
} |
|
1493
|
|
|
|
|
|
|
} |
|
1494
|
|
|
|
|
|
|
|
|
1495
|
0
|
|
|
|
|
|
$level_text = sprintf("$color_start%$setup->{NUMBER_LEVELS}d$color_end ", ($level + 1)) ; |
|
1496
|
|
|
|
|
|
|
} |
|
1497
|
|
|
|
|
|
|
} |
|
1498
|
|
|
|
|
|
|
|
|
1499
|
0
|
|
|
|
|
|
return($level_text) ; |
|
1500
|
|
|
|
|
|
|
} |
|
1501
|
|
|
|
|
|
|
|
|
1502
|
|
|
|
|
|
|
|
|
1503
|
|
|
|
|
|
|
|
|
1504
|
|
|
|
|
|
|
sub GetSeparator |
|
1505
|
|
|
|
|
|
|
{ |
|
1506
|
|
|
|
|
|
|
my |
|
1507
|
|
|
|
|
|
|
( |
|
1508
|
0
|
|
|
0
|
0
|
|
$level |
|
1509
|
|
|
|
|
|
|
, $is_last_in_level |
|
1510
|
|
|
|
|
|
|
, $levels_left |
|
1511
|
|
|
|
|
|
|
, $start_level |
|
1512
|
|
|
|
|
|
|
, $glyphs |
|
1513
|
|
|
|
|
|
|
, $colors |
|
1514
|
|
|
|
|
|
|
) = @_ ; |
|
1515
|
|
|
|
|
|
|
|
|
1516
|
0
|
|
|
|
|
|
my $separator_size = 0 ; |
|
1517
|
0
|
|
|
|
|
|
my $previous_level_separator = '' ; |
|
1518
|
0
|
|
|
|
|
|
my ($color_start, $color_end) = ('', '') ; |
|
1519
|
|
|
|
|
|
|
|
|
1520
|
0
|
|
|
|
|
|
for my $current_level ((1 - $start_level) .. ($level - 1)) |
|
1521
|
|
|
|
|
|
|
{ |
|
1522
|
0
|
|
|
|
|
|
$separator_size += 3 ; |
|
1523
|
|
|
|
|
|
|
|
|
1524
|
0
|
0
|
|
|
|
|
if($colors) |
|
1525
|
|
|
|
|
|
|
{ |
|
1526
|
0
|
0
|
|
|
|
|
if('ARRAY' eq ref $colors) |
|
1527
|
|
|
|
|
|
|
{ |
|
1528
|
0
|
|
|
|
|
|
my $color_index = $current_level % @{$colors->[0]} ; |
|
|
0
|
|
|
|
|
|
|
|
1529
|
0
|
|
|
|
|
|
($color_start, $color_end) = ($colors->[0][$color_index] , $colors->[1]) ; |
|
1530
|
|
|
|
|
|
|
} |
|
1531
|
|
|
|
|
|
|
else |
|
1532
|
|
|
|
|
|
|
{ |
|
1533
|
0
|
0
|
|
|
|
|
if('CODE' eq ref $colors) |
|
1534
|
|
|
|
|
|
|
{ |
|
1535
|
0
|
|
|
|
|
|
($color_start, $color_end) = $colors->($current_level) ; |
|
1536
|
|
|
|
|
|
|
} |
|
1537
|
|
|
|
|
|
|
|
|
1538
|
|
|
|
|
|
|
|
|
1539
|
|
|
|
|
|
|
} |
|
1540
|
|
|
|
|
|
|
} |
|
1541
|
|
|
|
|
|
|
|
|
1542
|
0
|
0
|
0
|
|
|
|
if(! defined $levels_left->[$current_level] || $levels_left->[$current_level] == 0) |
|
1543
|
|
|
|
|
|
|
{ |
|
1544
|
|
|
|
|
|
|
|
|
1545
|
0
|
|
|
|
|
|
$previous_level_separator .= "$color_start$glyphs->[3]$color_end" ; |
|
1546
|
|
|
|
|
|
|
} |
|
1547
|
|
|
|
|
|
|
else |
|
1548
|
|
|
|
|
|
|
{ |
|
1549
|
|
|
|
|
|
|
|
|
1550
|
0
|
|
|
|
|
|
$previous_level_separator .= "$color_start$glyphs->[0]$color_end" ; |
|
1551
|
|
|
|
|
|
|
} |
|
1552
|
|
|
|
|
|
|
} |
|
1553
|
|
|
|
|
|
|
|
|
1554
|
0
|
|
|
|
|
|
my $separator = '' ; |
|
1555
|
0
|
|
|
|
|
|
my $subsequent_separator = '' ; |
|
1556
|
|
|
|
|
|
|
|
|
1557
|
0
|
|
|
|
|
|
$separator_size += 3 ; |
|
1558
|
|
|
|
|
|
|
|
|
1559
|
0
|
0
|
0
|
|
|
|
if($level > 0 || $start_level) |
|
1560
|
|
|
|
|
|
|
{ |
|
1561
|
0
|
0
|
|
|
|
|
if($colors) |
|
1562
|
|
|
|
|
|
|
{ |
|
1563
|
0
|
0
|
|
|
|
|
if('ARRAY' eq ref $colors) |
|
1564
|
|
|
|
|
|
|
{ |
|
1565
|
0
|
|
|
|
|
|
my $color_index = $level % @{$colors->[0]} ; |
|
|
0
|
|
|
|
|
|
|
|
1566
|
0
|
|
|
|
|
|
($color_start, $color_end) = ($colors->[0][$color_index] , $colors->[1]) ; |
|
1567
|
|
|
|
|
|
|
} |
|
1568
|
|
|
|
|
|
|
else |
|
1569
|
|
|
|
|
|
|
{ |
|
1570
|
|
|
|
|
|
|
|
|
1571
|
0
|
|
|
|
|
|
($color_start, $color_end) = $colors->($level) ; |
|
1572
|
|
|
|
|
|
|
} |
|
1573
|
|
|
|
|
|
|
} |
|
1574
|
|
|
|
|
|
|
|
|
1575
|
0
|
0
|
|
|
|
|
if($is_last_in_level == 0) |
|
1576
|
|
|
|
|
|
|
{ |
|
1577
|
|
|
|
|
|
|
|
|
1578
|
|
|
|
|
|
|
|
|
1579
|
0
|
|
|
|
|
|
$separator = "$color_start$glyphs->[2]$color_end" ; |
|
1580
|
0
|
|
|
|
|
|
$subsequent_separator = "$color_start$glyphs->[3]$color_end" ; |
|
1581
|
|
|
|
|
|
|
} |
|
1582
|
|
|
|
|
|
|
else |
|
1583
|
|
|
|
|
|
|
{ |
|
1584
|
|
|
|
|
|
|
|
|
1585
|
|
|
|
|
|
|
|
|
1586
|
0
|
|
|
|
|
|
$separator = "$color_start$glyphs->[1]$color_end" ; |
|
1587
|
0
|
|
|
|
|
|
$subsequent_separator = "$color_start$glyphs->[0]$color_end" ; |
|
1588
|
|
|
|
|
|
|
} |
|
1589
|
|
|
|
|
|
|
} |
|
1590
|
|
|
|
|
|
|
|
|
1591
|
|
|
|
|
|
|
return |
|
1592
|
|
|
|
|
|
|
( |
|
1593
|
0
|
|
|
|
|
|
$previous_level_separator |
|
1594
|
|
|
|
|
|
|
, $separator |
|
1595
|
|
|
|
|
|
|
, $subsequent_separator |
|
1596
|
|
|
|
|
|
|
, $separator_size |
|
1597
|
|
|
|
|
|
|
) ; |
|
1598
|
|
|
|
|
|
|
} |
|
1599
|
|
|
|
|
|
|
|
|
1600
|
|
|
|
|
|
|
|
|
1601
|
|
|
|
|
|
|
|
|
1602
|
|
|
|
|
|
|
1 ; |
|
1603
|
|
|
|
|
|
|
|
|
1604
|
|
|
|
|
|
|
__END__ |
|
1605
|
|
|
|
|
|
|
=head1 NAME |
|
1606
|
|
|
|
|
|
|
|
|
1607
|
|
|
|
|
|
|
Data::TreeDumper - Improved replacement for Data::Dumper. Powerful filtering capability. |
|
1608
|
|
|
|
|
|
|
|
|
1609
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
1610
|
|
|
|
|
|
|
|
|
1611
|
|
|
|
|
|
|
use Data::TreeDumper ; |
|
1612
|
|
|
|
|
|
|
|
|
1613
|
|
|
|
|
|
|
my $sub = sub {} ; |
|
1614
|
|
|
|
|
|
|
|
|
1615
|
|
|
|
|
|
|
my $s = |
|
1616
|
|
|
|
|
|
|
{ |
|
1617
|
|
|
|
|
|
|
A => |
|
1618
|
|
|
|
|
|
|
{ |
|
1619
|
|
|
|
|
|
|
a => |
|
1620
|
|
|
|
|
|
|
{ |
|
1621
|
|
|
|
|
|
|
} |
|
1622
|
|
|
|
|
|
|
, bbbbbb => $sub |
|
1623
|
|
|
|
|
|
|
, c123 => $sub |
|
1624
|
|
|
|
|
|
|
, d => \$sub |
|
1625
|
|
|
|
|
|
|
} |
|
1626
|
|
|
|
|
|
|
|
|
1627
|
|
|
|
|
|
|
, C => |
|
1628
|
|
|
|
|
|
|
{ |
|
1629
|
|
|
|
|
|
|
b => |
|
1630
|
|
|
|
|
|
|
{ |
|
1631
|
|
|
|
|
|
|
a => |
|
1632
|
|
|
|
|
|
|
{ |
|
1633
|
|
|
|
|
|
|
a => |
|
1634
|
|
|
|
|
|
|
{ |
|
1635
|
|
|
|
|
|
|
} |
|
1636
|
|
|
|
|
|
|
|
|
1637
|
|
|
|
|
|
|
, b => sub |
|
1638
|
|
|
|
|
|
|
{ |
|
1639
|
|
|
|
|
|
|
} |
|
1640
|
|
|
|
|
|
|
, c => 42 |
|
1641
|
|
|
|
|
|
|
} |
|
1642
|
|
|
|
|
|
|
|
|
1643
|
|
|
|
|
|
|
} |
|
1644
|
|
|
|
|
|
|
} |
|
1645
|
|
|
|
|
|
|
, ARRAY => [qw(elment_1 element_2 element_3)] |
|
1646
|
|
|
|
|
|
|
} ; |
|
1647
|
|
|
|
|
|
|
|
|
1648
|
|
|
|
|
|
|
|
|
1649
|
|
|
|
|
|
|
#------------------------------------------------------------------- |
|
1650
|
|
|
|
|
|
|
# package setup data |
|
1651
|
|
|
|
|
|
|
#------------------------------------------------------------------- |
|
1652
|
|
|
|
|
|
|
|
|
1653
|
|
|
|
|
|
|
$Data::TreeDumper::Useascii = 0 ; |
|
1654
|
|
|
|
|
|
|
$Data::TreeDumper::Maxdepth = 2 ; |
|
1655
|
|
|
|
|
|
|
|
|
1656
|
|
|
|
|
|
|
print DumpTree($s, 'title') ; |
|
1657
|
|
|
|
|
|
|
print DumpTree($s, 'title', MAX_DEPTH => 1) ; |
|
1658
|
|
|
|
|
|
|
print DumpTrees |
|
1659
|
|
|
|
|
|
|
( |
|
1660
|
|
|
|
|
|
|
[$s, "title", MAX_DEPTH => 1] |
|
1661
|
|
|
|
|
|
|
, [$s2, "other_title", DISPLAY_ADDRESS => 0] |
|
1662
|
|
|
|
|
|
|
, USE_ASCII => 1 |
|
1663
|
|
|
|
|
|
|
, MAX_DEPTH => 5 |
|
1664
|
|
|
|
|
|
|
) ; |
|
1665
|
|
|
|
|
|
|
|
|
1666
|
|
|
|
|
|
|
=head1 Output |
|
1667
|
|
|
|
|
|
|
|
|
1668
|
|
|
|
|
|
|
title: |
|
1669
|
|
|
|
|
|
|
|- A [H1] |
|
1670
|
|
|
|
|
|
|
| |- a [H2] |
|
1671
|
|
|
|
|
|
|
| |- bbbbbb = CODE(0x8139fa0) [C3] |
|
1672
|
|
|
|
|
|
|
| |- c123 [C4 -> C3] |
|
1673
|
|
|
|
|
|
|
| `- d [R5] |
|
1674
|
|
|
|
|
|
|
| `- REF(0x8139fb8) [R5 -> C3] |
|
1675
|
|
|
|
|
|
|
|- ARRAY [A6] |
|
1676
|
|
|
|
|
|
|
| |- 0 [S7] = elment_1 |
|
1677
|
|
|
|
|
|
|
| |- 1 [S8] = element_2 |
|
1678
|
|
|
|
|
|
|
| `- 2 [S9] = element_3 |
|
1679
|
|
|
|
|
|
|
`- C [H10] |
|
1680
|
|
|
|
|
|
|
`- b [H11] |
|
1681
|
|
|
|
|
|
|
`- a [H12] |
|
1682
|
|
|
|
|
|
|
|- a [H13] |
|
1683
|
|
|
|
|
|
|
|- b = CODE(0x81ab130) [C14] |
|
1684
|
|
|
|
|
|
|
`- c [S15] = 42 |
|
1685
|
|
|
|
|
|
|
|
|
1686
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
1687
|
|
|
|
|
|
|
|
|
1688
|
|
|
|
|
|
|
Data::Dumper and other modules do a great job of dumping data |
|
1689
|
|
|
|
|
|
|
structures. Their output, however, often takes more brain power to |
|
1690
|
|
|
|
|
|
|
understand than the data itself. When dumping large amounts of data, |
|
1691
|
|
|
|
|
|
|
the output can be overwhelming and it can be difficult to see the |
|
1692
|
|
|
|
|
|
|
relationship between each piece of the dumped data. |
|
1693
|
|
|
|
|
|
|
|
|
1694
|
|
|
|
|
|
|
Data::TreeDumper also dumps data in a tree-like fashion but I<hopefully> |
|
1695
|
|
|
|
|
|
|
in a format more easily understood. |
|
1696
|
|
|
|
|
|
|
|
|
1697
|
|
|
|
|
|
|
=head2 Label |
|
1698
|
|
|
|
|
|
|
|
|
1699
|
|
|
|
|
|
|
Each node in the tree has a label. The label contains a type and an address. The label is displayed to |
|
1700
|
|
|
|
|
|
|
the right of the entry name within square brackets. |
|
1701
|
|
|
|
|
|
|
|
|
1702
|
|
|
|
|
|
|
| |- bbbbbb = CODE(0x8139fa0) [C3] |
|
1703
|
|
|
|
|
|
|
| |- c123 [C4 -> C3] |
|
1704
|
|
|
|
|
|
|
| `- d [R5] |
|
1705
|
|
|
|
|
|
|
| `- REF(0x8139fb8) [R5 -> C3] |
|
1706
|
|
|
|
|
|
|
|
|
1707
|
|
|
|
|
|
|
=head3 Address |
|
1708
|
|
|
|
|
|
|
|
|
1709
|
|
|
|
|
|
|
The addresses are linearly incremented which should make it easier to locate data. |
|
1710
|
|
|
|
|
|
|
If the entry is a reference to data already displayed, a B<->> followed with the address of the already displayed data is appended |
|
1711
|
|
|
|
|
|
|
within the label. |
|
1712
|
|
|
|
|
|
|
|
|
1713
|
|
|
|
|
|
|
ex: c123 [C4 -> C3] |
|
1714
|
|
|
|
|
|
|
^ ^ |
|
1715
|
|
|
|
|
|
|
| | address of the data refered to |
|
1716
|
|
|
|
|
|
|
| |
|
1717
|
|
|
|
|
|
|
| current element address |
|
1718
|
|
|
|
|
|
|
|
|
1719
|
|
|
|
|
|
|
=head3 Types |
|
1720
|
|
|
|
|
|
|
|
|
1721
|
|
|
|
|
|
|
B<S>: Scalar, |
|
1722
|
|
|
|
|
|
|
B<H>: Hash, |
|
1723
|
|
|
|
|
|
|
B<A>: Array, |
|
1724
|
|
|
|
|
|
|
B<C>: Code, |
|
1725
|
|
|
|
|
|
|
|
|
1726
|
|
|
|
|
|
|
B<R>: Reference, |
|
1727
|
|
|
|
|
|
|
B<RS>: Scalar reference. |
|
1728
|
|
|
|
|
|
|
B<Ox>: Object, where x is the object undelying type |
|
1729
|
|
|
|
|
|
|
|
|
1730
|
|
|
|
|
|
|
=head2 Empty Hash or Array |
|
1731
|
|
|
|
|
|
|
|
|
1732
|
|
|
|
|
|
|
No structure is displayed for empty hashes or arrays, the string "no elements" is added to the display. |
|
1733
|
|
|
|
|
|
|
|
|
1734
|
|
|
|
|
|
|
|- A [S10] = string |
|
1735
|
|
|
|
|
|
|
|- EMPTY_ARRAY (no elements) [A11] |
|
1736
|
|
|
|
|
|
|
|- B [S12] = 123 |
|
1737
|
|
|
|
|
|
|
|
|
1738
|
|
|
|
|
|
|
=head1 Configuration and Overrides |
|
1739
|
|
|
|
|
|
|
|
|
1740
|
|
|
|
|
|
|
Data::TreeDumper has configuration options you can set to modify the output it |
|
1741
|
|
|
|
|
|
|
generates. I<DumpTree> and I<PrintTree> take overrides as trailing arguments. Those |
|
1742
|
|
|
|
|
|
|
overrides are active within the current dump call only. |
|
1743
|
|
|
|
|
|
|
|
|
1744
|
|
|
|
|
|
|
ex: |
|
1745
|
|
|
|
|
|
|
$Data::TreeDumper::Maxdepth = 2 ; |
|
1746
|
|
|
|
|
|
|
|
|
1747
|
|
|
|
|
|
|
# maximum depth set to 1 for the duration of the call only |
|
1748
|
|
|
|
|
|
|
print DumpTree($s, 'title', MAX_DEPTH => 1) ; |
|
1749
|
|
|
|
|
|
|
PrintTree($s, 'title', MAX_DEPTH => 1) ; # shortcut for the above call |
|
1750
|
|
|
|
|
|
|
|
|
1751
|
|
|
|
|
|
|
# maximum depth is 2 |
|
1752
|
|
|
|
|
|
|
print DumpTree($s, 'title') ; |
|
1753
|
|
|
|
|
|
|
|
|
1754
|
|
|
|
|
|
|
=head2 $Data::TreeDumper::Displaycallerlocation |
|
1755
|
|
|
|
|
|
|
|
|
1756
|
|
|
|
|
|
|
This package variable is very usefull when you use B<Data::TreeDumper> and don't know where you called |
|
1757
|
|
|
|
|
|
|
B<PrintTree> or B<DumpTree>, ie when debugging. It displays the filename and line of call on STDOUT. |
|
1758
|
|
|
|
|
|
|
It can't also be set as an override, DISPLAY_CALLER_LOCATION => 1. |
|
1759
|
|
|
|
|
|
|
|
|
1760
|
|
|
|
|
|
|
=head2 NO_PACKAGE_SETUP |
|
1761
|
|
|
|
|
|
|
|
|
1762
|
|
|
|
|
|
|
Sometimes, the package setup you have is not what you want to use. resetting the variable, |
|
1763
|
|
|
|
|
|
|
making a call and setting the variables back is borring. You can set B<NO_PACKAGE_SETUP> to |
|
1764
|
|
|
|
|
|
|
1 and I<DumpTree> will ignore the package setup for the call. |
|
1765
|
|
|
|
|
|
|
|
|
1766
|
|
|
|
|
|
|
print Data::TreeDumper::DumpTree($s, "Using package data") ; |
|
1767
|
|
|
|
|
|
|
print Data::TreeDumper::DumpTree($s, "Not Using package data", NO_PACKAGE_SETUP => 1) ; |
|
1768
|
|
|
|
|
|
|
|
|
1769
|
|
|
|
|
|
|
=head2 DISPLAY_ROOT_ADDRESS |
|
1770
|
|
|
|
|
|
|
|
|
1771
|
|
|
|
|
|
|
By default, B<Data::TreeDumper> doesn't display the address of the root. |
|
1772
|
|
|
|
|
|
|
|
|
1773
|
|
|
|
|
|
|
DISPLAY_ROOT_ADDRESS => 1 # show the root address |
|
1774
|
|
|
|
|
|
|
|
|
1775
|
|
|
|
|
|
|
=head2 DISPLAY_ADDRESS |
|
1776
|
|
|
|
|
|
|
|
|
1777
|
|
|
|
|
|
|
When the dumped data is not self-referential, displaying the address of each node clutters the display. You can |
|
1778
|
|
|
|
|
|
|
direct B<Data::TreeDumper> to not display the node address by using: |
|
1779
|
|
|
|
|
|
|
|
|
1780
|
|
|
|
|
|
|
DISPLAY_ADDRESS => 0 |
|
1781
|
|
|
|
|
|
|
|
|
1782
|
|
|
|
|
|
|
=head2 DISPLAY_PATH |
|
1783
|
|
|
|
|
|
|
|
|
1784
|
|
|
|
|
|
|
Add the path of the element to the its address. |
|
1785
|
|
|
|
|
|
|
|
|
1786
|
|
|
|
|
|
|
DISPLAY_PATH => 1 |
|
1787
|
|
|
|
|
|
|
|
|
1788
|
|
|
|
|
|
|
ex: '- CopyOfARRAY [A39 -> A18 /{'ARRAY'}] |
|
1789
|
|
|
|
|
|
|
|
|
1790
|
|
|
|
|
|
|
=head2 DISPLAY_OBJECT_TYPE |
|
1791
|
|
|
|
|
|
|
|
|
1792
|
|
|
|
|
|
|
B<Data::TreeDumper> displays the package in which an object is blessed. You |
|
1793
|
|
|
|
|
|
|
can suppress this display by using: |
|
1794
|
|
|
|
|
|
|
|
|
1795
|
|
|
|
|
|
|
DISPLAY_OBJECT_TYPE => 0 |
|
1796
|
|
|
|
|
|
|
|
|
1797
|
|
|
|
|
|
|
=head2 DISPLAY_INHERITANCE |
|
1798
|
|
|
|
|
|
|
|
|
1799
|
|
|
|
|
|
|
B<Data::TreeDumper> will display the inheritance hierarchy for the object: |
|
1800
|
|
|
|
|
|
|
|
|
1801
|
|
|
|
|
|
|
|- object = blessed in 'SuperObject' <- Potatoe [OH55] |
|
1802
|
|
|
|
|
|
|
| `- Data = 0 [S56] |
|
1803
|
|
|
|
|
|
|
|
|
1804
|
|
|
|
|
|
|
=head2 DISPLAY_AUTOLOAD |
|
1805
|
|
|
|
|
|
|
|
|
1806
|
|
|
|
|
|
|
if set, B<Data::TreeDumper> will tag the object type with '[A]' if the package has an AUTOLOAD function. |
|
1807
|
|
|
|
|
|
|
|
|
1808
|
|
|
|
|
|
|
|- object_with_autoload = blessed in '[A]SuperObjectWithAutoload' <- Potatoe <- [A] Vegetable [O58] |
|
1809
|
|
|
|
|
|
|
| `- Data = 0 [S56] |
|
1810
|
|
|
|
|
|
|
|
|
1811
|
|
|
|
|
|
|
=head2 DISPLAY_TIE |
|
1812
|
|
|
|
|
|
|
|
|
1813
|
|
|
|
|
|
|
if DISPLAY_TIE is set, B<Data::TreeDumper> will display which packae the variable is tied to. This works for |
|
1814
|
|
|
|
|
|
|
hashes and arrays as well as for object which are based on hashes and arrays. |
|
1815
|
|
|
|
|
|
|
|
|
1816
|
|
|
|
|
|
|
|- tied_hash (tied to 'TiedHash') [H57] |
|
1817
|
|
|
|
|
|
|
| `- x = 1 [S58] |
|
1818
|
|
|
|
|
|
|
|
|
1819
|
|
|
|
|
|
|
|- tied_hash_object = (tied to 'TiedHash') blessed in 'SuperObject' <- [A]Potatoe <- Vegetable [O59] |
|
1820
|
|
|
|
|
|
|
| |- m1 = 1 [S60] |
|
1821
|
|
|
|
|
|
|
| `- m2 = 2 [S61] |
|
1822
|
|
|
|
|
|
|
|
|
1823
|
|
|
|
|
|
|
=head2 PERL DATA |
|
1824
|
|
|
|
|
|
|
|
|
1825
|
|
|
|
|
|
|
Setting one of the options below will show internal perl data: |
|
1826
|
|
|
|
|
|
|
|
|
1827
|
|
|
|
|
|
|
Cells: <2234> HASH(0x814F20c) |
|
1828
|
|
|
|
|
|
|
|- A1 [H1] <204> HASH(0x824620c) |
|
1829
|
|
|
|
|
|
|
| `- VALUE [S2] = datadatadatadatadatadatadatadatadatadata <85> |
|
1830
|
|
|
|
|
|
|
|- A8 [H11] <165> HASH(0x8243d68) |
|
1831
|
|
|
|
|
|
|
| `- VALUE [S12] = C <46> |
|
1832
|
|
|
|
|
|
|
`- C2 [H19] <165> HASH(0x8243dc0) |
|
1833
|
|
|
|
|
|
|
`- VALUE [S20] = B <46> |
|
1834
|
|
|
|
|
|
|
|
|
1835
|
|
|
|
|
|
|
=head3 DISPLAY_PERL_SIZE |
|
1836
|
|
|
|
|
|
|
|
|
1837
|
|
|
|
|
|
|
Setting this option will show the size of the memory allocated for each element in the tree within angle brackets. |
|
1838
|
|
|
|
|
|
|
|
|
1839
|
|
|
|
|
|
|
DISPLAY_PERL_SIZE => 1 |
|
1840
|
|
|
|
|
|
|
|
|
1841
|
|
|
|
|
|
|
The excellent L<Devel::Size> is used to compute the size of the perl data. If you have deep circular data structures, |
|
1842
|
|
|
|
|
|
|
expect the dump time to be slower, 50 times slower or more. |
|
1843
|
|
|
|
|
|
|
|
|
1844
|
|
|
|
|
|
|
=head3 DISPLAY_PERL_ADDRESS |
|
1845
|
|
|
|
|
|
|
|
|
1846
|
|
|
|
|
|
|
Setting this option will show the perl-address of the dumped data. |
|
1847
|
|
|
|
|
|
|
|
|
1848
|
|
|
|
|
|
|
DISPLAY_PERL_ADDRESS => 1 |
|
1849
|
|
|
|
|
|
|
|
|
1850
|
|
|
|
|
|
|
=head2 REPLACEMENT_LIST |
|
1851
|
|
|
|
|
|
|
|
|
1852
|
|
|
|
|
|
|
Scalars may contain non printable characters that you rather not see in a dump. One of the |
|
1853
|
|
|
|
|
|
|
most common is "\r" embedded in text string from dos files. B<Data::TreeDumper>, by default, replaces "\n" by |
|
1854
|
|
|
|
|
|
|
'[\n]' and "\r" by '[\r]'. You can set REPLACEMENT_LIST to an array ref containing elements which |
|
1855
|
|
|
|
|
|
|
are themselves array references. The first element is the character(s) to match and the second is |
|
1856
|
|
|
|
|
|
|
the replacement. |
|
1857
|
|
|
|
|
|
|
|
|
1858
|
|
|
|
|
|
|
# a fancy and stricter replacement for \n and \r |
|
1859
|
|
|
|
|
|
|
my $replacement = [ ["\n" => '[**Fancy \n replacement**]'], ["\r" => '\r'] ] ; |
|
1860
|
|
|
|
|
|
|
print DumpTree($smed->{TEXT}, 'Text:', REPLACEMENT_LIST => $replacement) ; |
|
1861
|
|
|
|
|
|
|
|
|
1862
|
|
|
|
|
|
|
=head2 QUOTE_HASH_KEYS |
|
1863
|
|
|
|
|
|
|
|
|
1864
|
|
|
|
|
|
|
B<QUOTE_HASH_KEYS> and its package variable B<$Data::TreeDumper::Quotehashkeys> can be set if you wish to single quote |
|
1865
|
|
|
|
|
|
|
the hash keys. Hash keys are not quoted by default. |
|
1866
|
|
|
|
|
|
|
|
|
1867
|
|
|
|
|
|
|
DumpTree(\$s, 'some data:', QUOTE_HASH_KEYS => 1) ; |
|
1868
|
|
|
|
|
|
|
|
|
1869
|
|
|
|
|
|
|
# output |
|
1870
|
|
|
|
|
|
|
some data: |
|
1871
|
|
|
|
|
|
|
`- REF(0x813da3c) [H1] |
|
1872
|
|
|
|
|
|
|
|- 'A' [H2] |
|
1873
|
|
|
|
|
|
|
| |- 'a' [H3] |
|
1874
|
|
|
|
|
|
|
| |- 'b' [H4] |
|
1875
|
|
|
|
|
|
|
| | |- 'a' = 0 [S5] |
|
1876
|
|
|
|
|
|
|
|
|
1877
|
|
|
|
|
|
|
=head2 QUOTE_VALUES |
|
1878
|
|
|
|
|
|
|
|
|
1879
|
|
|
|
|
|
|
B<QUOTE_VALUES> and its package variable B<$Data::TreeDumper::Quotevalues> can be set if you wish to single quote |
|
1880
|
|
|
|
|
|
|
the scalar values. |
|
1881
|
|
|
|
|
|
|
|
|
1882
|
|
|
|
|
|
|
DumpTree(\$s, 'Cells:', QUOTE_VALUES=> 1) ; |
|
1883
|
|
|
|
|
|
|
|
|
1884
|
|
|
|
|
|
|
=head2 NO_NO_ELEMENTS |
|
1885
|
|
|
|
|
|
|
|
|
1886
|
|
|
|
|
|
|
If this option is set, B<Data::TreeDumper> will not add 'no elements' to empty hashes and arrays |
|
1887
|
|
|
|
|
|
|
|
|
1888
|
|
|
|
|
|
|
=head2 NO_OUTPUT |
|
1889
|
|
|
|
|
|
|
|
|
1890
|
|
|
|
|
|
|
This option suppresses all output generated by Data::TreeDumper. |
|
1891
|
|
|
|
|
|
|
This is useful when you want to iterate through your data structures and |
|
1892
|
|
|
|
|
|
|
display the data yourself, manipulate the data structure, or do a search |
|
1893
|
|
|
|
|
|
|
(see L<using filter as iterators> below) |
|
1894
|
|
|
|
|
|
|
|
|
1895
|
|
|
|
|
|
|
=head2 Filters |
|
1896
|
|
|
|
|
|
|
|
|
1897
|
|
|
|
|
|
|
Data::TreeDumper can sort the tree nodes with a user defined subroutine. By default, hash keys are sorted. |
|
1898
|
|
|
|
|
|
|
|
|
1899
|
|
|
|
|
|
|
FILTER => \&ReverseSort |
|
1900
|
|
|
|
|
|
|
FILTER_ARGUMENT => ['your', 'arguments'] |
|
1901
|
|
|
|
|
|
|
|
|
1902
|
|
|
|
|
|
|
The filter routine is passed these arguments: |
|
1903
|
|
|
|
|
|
|
|
|
1904
|
|
|
|
|
|
|
=over 2 |
|
1905
|
|
|
|
|
|
|
|
|
1906
|
|
|
|
|
|
|
=item 1 - a reference to the node which is going to be displayed |
|
1907
|
|
|
|
|
|
|
|
|
1908
|
|
|
|
|
|
|
=item 2 - the nodes depth (this allows you to selectively display elements at a certain depth) |
|
1909
|
|
|
|
|
|
|
|
|
1910
|
|
|
|
|
|
|
=item 3 - the path to the reference from the start of the dump. |
|
1911
|
|
|
|
|
|
|
|
|
1912
|
|
|
|
|
|
|
=item 4 - an array reference containing the keys to be displayed (see L<Filter chaining>) |
|
1913
|
|
|
|
|
|
|
|
|
1914
|
|
|
|
|
|
|
=item 5 - the dumpers setup |
|
1915
|
|
|
|
|
|
|
|
|
1916
|
|
|
|
|
|
|
=item 5 - the filter arguments (see below) |
|
1917
|
|
|
|
|
|
|
|
|
1918
|
|
|
|
|
|
|
=back |
|
1919
|
|
|
|
|
|
|
|
|
1920
|
|
|
|
|
|
|
The filter returns the node's type, an eventual new structure (see below) and a list of 'keys' to display. The keys are hash keys or array indexes. |
|
1921
|
|
|
|
|
|
|
|
|
1922
|
|
|
|
|
|
|
In Perl: |
|
1923
|
|
|
|
|
|
|
|
|
1924
|
|
|
|
|
|
|
($tree_type, $replacement_tree, @nodes_to_display) = $your_filter->($tree, $level, $path, $nodes_to_display, $setup) ; |
|
1925
|
|
|
|
|
|
|
|
|
1926
|
|
|
|
|
|
|
Filter are not as complicated as they sound and they are very powerfull, |
|
1927
|
|
|
|
|
|
|
especially when using the path argument. The path idea was given to me by |
|
1928
|
|
|
|
|
|
|
another module writer but I forgot whom. If this writer will contact me, I |
|
1929
|
|
|
|
|
|
|
will give him the proper credit. |
|
1930
|
|
|
|
|
|
|
|
|
1931
|
|
|
|
|
|
|
Lots of examples can be found in I<filters.pl> and I'll be glad to help if |
|
1932
|
|
|
|
|
|
|
you want to develop a specific filter. |
|
1933
|
|
|
|
|
|
|
|
|
1934
|
|
|
|
|
|
|
=head3 FILTER_ARGUMENT |
|
1935
|
|
|
|
|
|
|
|
|
1936
|
|
|
|
|
|
|
it is possible to pass arguments to your filter, passing a reference allows you to modify |
|
1937
|
|
|
|
|
|
|
the arguments when the filter is run (that happends for each node). |
|
1938
|
|
|
|
|
|
|
|
|
1939
|
|
|
|
|
|
|
sub SomeSub |
|
1940
|
|
|
|
|
|
|
{ |
|
1941
|
|
|
|
|
|
|
my $counter = 0 ; |
|
1942
|
|
|
|
|
|
|
my $data_structure = {.....} ; |
|
1943
|
|
|
|
|
|
|
|
|
1944
|
|
|
|
|
|
|
DumpTree($data_structure, 'title', FILTER => \&CountNodes, FILTER_ARGUMENT => \$counter) ; |
|
1945
|
|
|
|
|
|
|
|
|
1946
|
|
|
|
|
|
|
print "\$counter = $counter\n" ; |
|
1947
|
|
|
|
|
|
|
} |
|
1948
|
|
|
|
|
|
|
|
|
1949
|
|
|
|
|
|
|
sub CountNodes |
|
1950
|
|
|
|
|
|
|
{ |
|
1951
|
|
|
|
|
|
|
my ($structure, $level, $path, $nodes_to_display, $setup, $counter) = @_ ; |
|
1952
|
|
|
|
|
|
|
$$counter++ ; # remember to pass references if you want them to be changed by the filter |
|
1953
|
|
|
|
|
|
|
|
|
1954
|
|
|
|
|
|
|
return(DefaultNodesToDisplay($structure)) ; |
|
1955
|
|
|
|
|
|
|
} |
|
1956
|
|
|
|
|
|
|
|
|
1957
|
|
|
|
|
|
|
=head3 Key removal |
|
1958
|
|
|
|
|
|
|
|
|
1959
|
|
|
|
|
|
|
Entries can be removed from the display by not returning their keys. |
|
1960
|
|
|
|
|
|
|
|
|
1961
|
|
|
|
|
|
|
my $s = {visible => '', also_visible => '', not_visible => ''} ; |
|
1962
|
|
|
|
|
|
|
my $OnlyVisible = sub |
|
1963
|
|
|
|
|
|
|
{ |
|
1964
|
|
|
|
|
|
|
my $s = shift ; |
|
1965
|
|
|
|
|
|
|
|
|
1966
|
|
|
|
|
|
|
if('HASH' eq ref $s) |
|
1967
|
|
|
|
|
|
|
{ |
|
1968
|
|
|
|
|
|
|
return('HASH', undef, grep {! /^not_visible/} keys %$s) ; |
|
1969
|
|
|
|
|
|
|
} |
|
1970
|
|
|
|
|
|
|
|
|
1971
|
|
|
|
|
|
|
return(Data::TreeDumper::DefaultNodesToDisplay($s)) ; |
|
1972
|
|
|
|
|
|
|
} |
|
1973
|
|
|
|
|
|
|
|
|
1974
|
|
|
|
|
|
|
DumpTree($s, 'title', FILTER => $OnlyVisible) ; |
|
1975
|
|
|
|
|
|
|
|
|
1976
|
|
|
|
|
|
|
=head3 Label changing |
|
1977
|
|
|
|
|
|
|
|
|
1978
|
|
|
|
|
|
|
The label for a hash keys or an array index can be altered. This can be used to add visual information to the tree dump. Instead |
|
1979
|
|
|
|
|
|
|
of returning the key name, return an array reference containing the key name and the label you want to display. |
|
1980
|
|
|
|
|
|
|
You only need to return such a reference for the entries you want to change, thus a mix of scalars and array ref is acceptable. |
|
1981
|
|
|
|
|
|
|
|
|
1982
|
|
|
|
|
|
|
sub StarOnA |
|
1983
|
|
|
|
|
|
|
{ |
|
1984
|
|
|
|
|
|
|
# hash entries matching /^a/i have '*' prepended |
|
1985
|
|
|
|
|
|
|
|
|
1986
|
|
|
|
|
|
|
my $tree = shift ; |
|
1987
|
|
|
|
|
|
|
|
|
1988
|
|
|
|
|
|
|
if('HASH' eq ref $tree) |
|
1989
|
|
|
|
|
|
|
{ |
|
1990
|
|
|
|
|
|
|
my @keys_to_dump ; |
|
1991
|
|
|
|
|
|
|
|
|
1992
|
|
|
|
|
|
|
for my $key_name (keys %$tree) |
|
1993
|
|
|
|
|
|
|
{ |
|
1994
|
|
|
|
|
|
|
if($key_name =~ /^a/i) |
|
1995
|
|
|
|
|
|
|
{ |
|
1996
|
|
|
|
|
|
|
$key_name = [$key_name, "* $key_name"] ; |
|
1997
|
|
|
|
|
|
|
} |
|
1998
|
|
|
|
|
|
|
|
|
1999
|
|
|
|
|
|
|
push @keys_to_dump, $key_name ; |
|
2000
|
|
|
|
|
|
|
} |
|
2001
|
|
|
|
|
|
|
|
|
2002
|
|
|
|
|
|
|
return ('HASH', undef, @keys_to_dump) ; |
|
2003
|
|
|
|
|
|
|
} |
|
2004
|
|
|
|
|
|
|
|
|
2005
|
|
|
|
|
|
|
return (Data::TreeDumper::DefaultNodesToDisplay($tree)) ; |
|
2006
|
|
|
|
|
|
|
} |
|
2007
|
|
|
|
|
|
|
|
|
2008
|
|
|
|
|
|
|
print DumpTree($s, "Entries matching /^a/i have '*' prepended", FILTER => \&StarOnA) ; |
|
2009
|
|
|
|
|
|
|
|
|
2010
|
|
|
|
|
|
|
If you use an ANSI terminal, you can also change the color of the label. |
|
2011
|
|
|
|
|
|
|
This can greatly improve visual search time. |
|
2012
|
|
|
|
|
|
|
See the I<label coloring> example in I<colors.pl>. |
|
2013
|
|
|
|
|
|
|
|
|
2014
|
|
|
|
|
|
|
=head3 Structure replacement |
|
2015
|
|
|
|
|
|
|
|
|
2016
|
|
|
|
|
|
|
It is possible to replace the whole data structure in a filter. This comes handy when you want to display a I<"worked"> |
|
2017
|
|
|
|
|
|
|
version of the structure. You can even change the type of the data structure, for example changing an array to a hash. |
|
2018
|
|
|
|
|
|
|
|
|
2019
|
|
|
|
|
|
|
sub ReplaceArray |
|
2020
|
|
|
|
|
|
|
{ |
|
2021
|
|
|
|
|
|
|
# replace arrays with hashes!!! |
|
2022
|
|
|
|
|
|
|
|
|
2023
|
|
|
|
|
|
|
my $tree = shift ; |
|
2024
|
|
|
|
|
|
|
|
|
2025
|
|
|
|
|
|
|
if('ARRAY' eq ref $tree) |
|
2026
|
|
|
|
|
|
|
{ |
|
2027
|
|
|
|
|
|
|
my $multiplication = $tree->[0] * $tree->[1] ; |
|
2028
|
|
|
|
|
|
|
my $replacement = {MULTIPLICATION => $multiplication} ; |
|
2029
|
|
|
|
|
|
|
return('HASH', $replacement, keys %$replacement) ; |
|
2030
|
|
|
|
|
|
|
} |
|
2031
|
|
|
|
|
|
|
|
|
2032
|
|
|
|
|
|
|
return (Data::TreeDumper::DefaultNodesToDisplay($tree)) ; |
|
2033
|
|
|
|
|
|
|
} |
|
2034
|
|
|
|
|
|
|
|
|
2035
|
|
|
|
|
|
|
print DumpTree($s, 'replace arrays with hashes!', FILTER => \&ReplaceArray) ; |
|
2036
|
|
|
|
|
|
|
|
|
2037
|
|
|
|
|
|
|
Here is a real life example. B<Tree::Simple> (L<http://search.cpan.org/dist/Tree-Simple/>) allows one |
|
2038
|
|
|
|
|
|
|
to build tree structures. The child nodes are not directly in the parent object (hash). Here is an unfiltered |
|
2039
|
|
|
|
|
|
|
dump of a tree with seven nodes: |
|
2040
|
|
|
|
|
|
|
|
|
2041
|
|
|
|
|
|
|
Tree::Simple through Data::TreeDumper |
|
2042
|
|
|
|
|
|
|
|- _children |
|
2043
|
|
|
|
|
|
|
| |- 0 |
|
2044
|
|
|
|
|
|
|
| | |- _children |
|
2045
|
|
|
|
|
|
|
| | | `- 0 |
|
2046
|
|
|
|
|
|
|
| | | |- _children |
|
2047
|
|
|
|
|
|
|
| | | |- _depth = 1 |
|
2048
|
|
|
|
|
|
|
| | | |- _node = 1.1 |
|
2049
|
|
|
|
|
|
|
| | | `- _parent |
|
2050
|
|
|
|
|
|
|
| | |- _depth = 0 |
|
2051
|
|
|
|
|
|
|
| | |- _node = 1 |
|
2052
|
|
|
|
|
|
|
| | `- _parent |
|
2053
|
|
|
|
|
|
|
| |- 1 |
|
2054
|
|
|
|
|
|
|
| | |- _children |
|
2055
|
|
|
|
|
|
|
| | | |- 0 |
|
2056
|
|
|
|
|
|
|
| | | | |- _children |
|
2057
|
|
|
|
|
|
|
| | | | |- _depth = 1 |
|
2058
|
|
|
|
|
|
|
| | | | |- _node = 2.1 |
|
2059
|
|
|
|
|
|
|
| | | | `- _parent |
|
2060
|
|
|
|
|
|
|
| | | |- 1 |
|
2061
|
|
|
|
|
|
|
| | | | |- _children |
|
2062
|
|
|
|
|
|
|
| | | | |- _depth = 1 |
|
2063
|
|
|
|
|
|
|
| | | | |- _node = 2.1a |
|
2064
|
|
|
|
|
|
|
| | | | `- _parent |
|
2065
|
|
|
|
|
|
|
| | | `- 2 |
|
2066
|
|
|
|
|
|
|
| | | |- _children |
|
2067
|
|
|
|
|
|
|
| | | |- _depth = 1 |
|
2068
|
|
|
|
|
|
|
| | | |- _node = 2.2 |
|
2069
|
|
|
|
|
|
|
| | | `- _parent |
|
2070
|
|
|
|
|
|
|
| | |- _depth = 0 |
|
2071
|
|
|
|
|
|
|
| | |- _node = 2 |
|
2072
|
|
|
|
|
|
|
| | `- _parent |
|
2073
|
|
|
|
|
|
|
| `- 2 |
|
2074
|
|
|
|
|
|
|
| |- _children |
|
2075
|
|
|
|
|
|
|
| |- _depth = 0 |
|
2076
|
|
|
|
|
|
|
| |- _node = 3 |
|
2077
|
|
|
|
|
|
|
| `- _parent |
|
2078
|
|
|
|
|
|
|
|- _depth = -1 |
|
2079
|
|
|
|
|
|
|
|- _node = 0 |
|
2080
|
|
|
|
|
|
|
`- _parent = root |
|
2081
|
|
|
|
|
|
|
|
|
2082
|
|
|
|
|
|
|
This is nice for the developer but not for a user wanting to oversee the node hierarchy. One of the |
|
2083
|
|
|
|
|
|
|
possible filters would be: |
|
2084
|
|
|
|
|
|
|
|
|
2085
|
|
|
|
|
|
|
FILTER => sub |
|
2086
|
|
|
|
|
|
|
{ |
|
2087
|
|
|
|
|
|
|
my $s = shift ; |
|
2088
|
|
|
|
|
|
|
|
|
2089
|
|
|
|
|
|
|
if('Tree::Simple' eq ref $s) |
|
2090
|
|
|
|
|
|
|
{ |
|
2091
|
|
|
|
|
|
|
my $counter = 0 ; |
|
2092
|
|
|
|
|
|
|
|
|
2093
|
|
|
|
|
|
|
return |
|
2094
|
|
|
|
|
|
|
( |
|
2095
|
|
|
|
|
|
|
'ARRAY' |
|
2096
|
|
|
|
|
|
|
, $s->{_children} |
|
2097
|
|
|
|
|
|
|
, map{[$counter++, $_->{_node}]} @{$s->{_children}} # index generation |
|
2098
|
|
|
|
|
|
|
) ; |
|
2099
|
|
|
|
|
|
|
} |
|
2100
|
|
|
|
|
|
|
|
|
2101
|
|
|
|
|
|
|
return(Data::TreeDumper::DefaultNodesToDisplay($s)) ; |
|
2102
|
|
|
|
|
|
|
} |
|
2103
|
|
|
|
|
|
|
|
|
2104
|
|
|
|
|
|
|
Which would give this much more readable output: |
|
2105
|
|
|
|
|
|
|
|
|
2106
|
|
|
|
|
|
|
Tree::Simple through Data::TreeDumper2 |
|
2107
|
|
|
|
|
|
|
|- 1 |
|
2108
|
|
|
|
|
|
|
| `- 1.1 |
|
2109
|
|
|
|
|
|
|
|- 2 |
|
2110
|
|
|
|
|
|
|
| |- 2.1 |
|
2111
|
|
|
|
|
|
|
| |- 2.1a |
|
2112
|
|
|
|
|
|
|
| `- 2.2 |
|
2113
|
|
|
|
|
|
|
`- 3 |
|
2114
|
|
|
|
|
|
|
|
|
2115
|
|
|
|
|
|
|
What about counting the children nodes? The index generating code becomes: |
|
2116
|
|
|
|
|
|
|
|
|
2117
|
|
|
|
|
|
|
map{[$counter++, "$_->{_node} [" . @{$_->{_children}} . "]"]} @{$s->{_children}} |
|
2118
|
|
|
|
|
|
|
|
|
2119
|
|
|
|
|
|
|
Tree::Simple through Data::TreeDumper4 |
|
2120
|
|
|
|
|
|
|
|- 1 [1] |
|
2121
|
|
|
|
|
|
|
| `- 1.1 [0] |
|
2122
|
|
|
|
|
|
|
|- 2 [3] |
|
2123
|
|
|
|
|
|
|
| |- 2.1 [0] |
|
2124
|
|
|
|
|
|
|
| |- 2.1a [0] |
|
2125
|
|
|
|
|
|
|
| `- 2.2 [0] |
|
2126
|
|
|
|
|
|
|
`- 3 [0] |
|
2127
|
|
|
|
|
|
|
|
|
2128
|
|
|
|
|
|
|
=head3 Filter chaining |
|
2129
|
|
|
|
|
|
|
|
|
2130
|
|
|
|
|
|
|
It is possible to chain filters. I<CreateChainingFilter> takes a list of filtering sub references. |
|
2131
|
|
|
|
|
|
|
The filters must properly handle the third parameter passed to them. |
|
2132
|
|
|
|
|
|
|
|
|
2133
|
|
|
|
|
|
|
Suppose you want to chain a filter that adds a star before each hash key label, with a filter |
|
2134
|
|
|
|
|
|
|
that removes all (original) keys that match /^a/i. |
|
2135
|
|
|
|
|
|
|
|
|
2136
|
|
|
|
|
|
|
sub AddStar |
|
2137
|
|
|
|
|
|
|
{ |
|
2138
|
|
|
|
|
|
|
my $s = shift ; |
|
2139
|
|
|
|
|
|
|
my $level = shift ; |
|
2140
|
|
|
|
|
|
|
my $path = shift ; |
|
2141
|
|
|
|
|
|
|
my $keys = shift ; |
|
2142
|
|
|
|
|
|
|
|
|
2143
|
|
|
|
|
|
|
if('HASH' eq ref $s) |
|
2144
|
|
|
|
|
|
|
{ |
|
2145
|
|
|
|
|
|
|
$keys = [keys %$s] unless defined $keys ; |
|
2146
|
|
|
|
|
|
|
|
|
2147
|
|
|
|
|
|
|
my @new_keys ; |
|
2148
|
|
|
|
|
|
|
|
|
2149
|
|
|
|
|
|
|
for (@$keys) |
|
2150
|
|
|
|
|
|
|
{ |
|
2151
|
|
|
|
|
|
|
if('' eq ref $_) |
|
2152
|
|
|
|
|
|
|
{ |
|
2153
|
|
|
|
|
|
|
push @new_keys, [$_, "* $_"] ; |
|
2154
|
|
|
|
|
|
|
} |
|
2155
|
|
|
|
|
|
|
else |
|
2156
|
|
|
|
|
|
|
{ |
|
2157
|
|
|
|
|
|
|
# another filter has changed the label |
|
2158
|
|
|
|
|
|
|
push @new_keys, [$_->[0], "* $_->[1]"] ; |
|
2159
|
|
|
|
|
|
|
} |
|
2160
|
|
|
|
|
|
|
} |
|
2161
|
|
|
|
|
|
|
|
|
2162
|
|
|
|
|
|
|
return('HASH', undef, @new_keys) ; |
|
2163
|
|
|
|
|
|
|
} |
|
2164
|
|
|
|
|
|
|
|
|
2165
|
|
|
|
|
|
|
return(Data::TreeDumper::DefaultNodesToDisplay($s)) ; |
|
2166
|
|
|
|
|
|
|
} ; |
|
2167
|
|
|
|
|
|
|
|
|
2168
|
|
|
|
|
|
|
sub RemoveA |
|
2169
|
|
|
|
|
|
|
{ |
|
2170
|
|
|
|
|
|
|
my $s = shift ; |
|
2171
|
|
|
|
|
|
|
my $level = shift ; |
|
2172
|
|
|
|
|
|
|
my $path = shift ; |
|
2173
|
|
|
|
|
|
|
my $keys = shift ; |
|
2174
|
|
|
|
|
|
|
|
|
2175
|
|
|
|
|
|
|
if('HASH' eq ref $s) |
|
2176
|
|
|
|
|
|
|
{ |
|
2177
|
|
|
|
|
|
|
$keys = [keys %$s] unless defined $keys ; |
|
2178
|
|
|
|
|
|
|
my @new_keys ; |
|
2179
|
|
|
|
|
|
|
|
|
2180
|
|
|
|
|
|
|
for (@$keys) |
|
2181
|
|
|
|
|
|
|
{ |
|
2182
|
|
|
|
|
|
|
if('' eq ref $_) |
|
2183
|
|
|
|
|
|
|
{ |
|
2184
|
|
|
|
|
|
|
push @new_keys, $_ unless /^a/i ; |
|
2185
|
|
|
|
|
|
|
} |
|
2186
|
|
|
|
|
|
|
else |
|
2187
|
|
|
|
|
|
|
{ |
|
2188
|
|
|
|
|
|
|
# another filter has changed the label |
|
2189
|
|
|
|
|
|
|
push @new_keys, $_ unless $_->[0] =~ /^a/i ; |
|
2190
|
|
|
|
|
|
|
} |
|
2191
|
|
|
|
|
|
|
} |
|
2192
|
|
|
|
|
|
|
|
|
2193
|
|
|
|
|
|
|
return('HASH', undef, @new_keys) ; |
|
2194
|
|
|
|
|
|
|
} |
|
2195
|
|
|
|
|
|
|
|
|
2196
|
|
|
|
|
|
|
return(Data::TreeDumper::DefaultNodesToDisplay($s)) ; |
|
2197
|
|
|
|
|
|
|
} ; |
|
2198
|
|
|
|
|
|
|
|
|
2199
|
|
|
|
|
|
|
DumpTree($s, 'Chained filters', FILTER => CreateChainingFilter(\&AddStar, \&RemoveA)) ; |
|
2200
|
|
|
|
|
|
|
|
|
2201
|
|
|
|
|
|
|
=head2 level Filters |
|
2202
|
|
|
|
|
|
|
|
|
2203
|
|
|
|
|
|
|
It is possible to define one filter for a specific level. If a filter for a specific level exists it is used |
|
2204
|
|
|
|
|
|
|
instead of the global filter. |
|
2205
|
|
|
|
|
|
|
|
|
2206
|
|
|
|
|
|
|
LEVEL_FILTERS => {1 => \&FilterForLevelOne, 5 => \&FilterForLevelFive ... } ; |
|
2207
|
|
|
|
|
|
|
|
|
2208
|
|
|
|
|
|
|
=head2 Type Filters |
|
2209
|
|
|
|
|
|
|
|
|
2210
|
|
|
|
|
|
|
You can define filters for specific types of references. This filter type has the highest priority. |
|
2211
|
|
|
|
|
|
|
|
|
2212
|
|
|
|
|
|
|
here's a very simple filter that will display the specified keys for the types |
|
2213
|
|
|
|
|
|
|
|
|
2214
|
|
|
|
|
|
|
print DumpTree |
|
2215
|
|
|
|
|
|
|
( |
|
2216
|
|
|
|
|
|
|
$data, |
|
2217
|
|
|
|
|
|
|
'title', |
|
2218
|
|
|
|
|
|
|
TYPE_FILTERS => |
|
2219
|
|
|
|
|
|
|
{ |
|
2220
|
|
|
|
|
|
|
'Config::Hierarchical' => sub {'HASH', undef, qw(CATEGORIES) }, |
|
2221
|
|
|
|
|
|
|
'PBS2::Node' => sub {'HASH', undef, qw(CONFIG DEPENDENCIES MATCH) },, |
|
2222
|
|
|
|
|
|
|
} |
|
2223
|
|
|
|
|
|
|
) ; |
|
2224
|
|
|
|
|
|
|
|
|
2225
|
|
|
|
|
|
|
|
|
2226
|
|
|
|
|
|
|
=head2 Using filters as iterators |
|
2227
|
|
|
|
|
|
|
|
|
2228
|
|
|
|
|
|
|
You can iterate through your data structures and display data yourself, |
|
2229
|
|
|
|
|
|
|
manipulate the data structure, or do a search. While iterating through the |
|
2230
|
|
|
|
|
|
|
data structure, you can prune arbitrary branches to speedup processing. |
|
2231
|
|
|
|
|
|
|
|
|
2232
|
|
|
|
|
|
|
# this example counts the nodes in a tree (hash based) |
|
2233
|
|
|
|
|
|
|
# a node is counted if it has a '__NAME' key |
|
2234
|
|
|
|
|
|
|
# any field that starts with '__' is considered rivate and we prune so we don't recurse in it |
|
2235
|
|
|
|
|
|
|
# anything that is not a hash (the part of the tree that interests us in this case) is pruned |
|
2236
|
|
|
|
|
|
|
|
|
2237
|
|
|
|
|
|
|
my $number_of_nodes_in_the_dependency_tree = 0 ; |
|
2238
|
|
|
|
|
|
|
my $node_counter = |
|
2239
|
|
|
|
|
|
|
sub |
|
2240
|
|
|
|
|
|
|
{ |
|
2241
|
|
|
|
|
|
|
my $tree = shift ; |
|
2242
|
|
|
|
|
|
|
if('HASH' eq ref $tree && exists $tree->{__NAME}) |
|
2243
|
|
|
|
|
|
|
{ |
|
2244
|
|
|
|
|
|
|
$number_of_nodes_in_the_dependency_tree++ if($tree->{__NAME} !~ /^__/) ; |
|
2245
|
|
|
|
|
|
|
|
|
2246
|
|
|
|
|
|
|
return('HASH', $tree, grep {! /^__/} keys %$tree) ; # prune to run faster |
|
2247
|
|
|
|
|
|
|
} |
|
2248
|
|
|
|
|
|
|
else |
|
2249
|
|
|
|
|
|
|
{ |
|
2250
|
|
|
|
|
|
|
return('SCALAR', 1) ; # prune |
|
2251
|
|
|
|
|
|
|
} |
|
2252
|
|
|
|
|
|
|
} ; |
|
2253
|
|
|
|
|
|
|
|
|
2254
|
|
|
|
|
|
|
DumpTree($dependency_tree, '', NO_OUTPUT => 1, FILTER => $node_counter) ; |
|
2255
|
|
|
|
|
|
|
|
|
2256
|
|
|
|
|
|
|
See the example under L<FILTER> which passes arguments through Data::TreeDumper instead for using a closure as above |
|
2257
|
|
|
|
|
|
|
|
|
2258
|
|
|
|
|
|
|
=head2 Start level |
|
2259
|
|
|
|
|
|
|
|
|
2260
|
|
|
|
|
|
|
This configuration option controls whether the tree trunk is displayed or not. |
|
2261
|
|
|
|
|
|
|
|
|
2262
|
|
|
|
|
|
|
START_LEVEL => 1: |
|
2263
|
|
|
|
|
|
|
|
|
2264
|
|
|
|
|
|
|
$tree: |
|
2265
|
|
|
|
|
|
|
|- A [H1] |
|
2266
|
|
|
|
|
|
|
| |- a [H2] |
|
2267
|
|
|
|
|
|
|
| |- bbbbbb = CODE(0x8139fa0) [C3] |
|
2268
|
|
|
|
|
|
|
| |- c123 [C4 -> C3] |
|
2269
|
|
|
|
|
|
|
| `- d [R5] |
|
2270
|
|
|
|
|
|
|
| `- REF(0x8139fb8) [R5 -> C3] |
|
2271
|
|
|
|
|
|
|
|- ARRAY [A6] |
|
2272
|
|
|
|
|
|
|
| |- 0 [S7] = element_1 |
|
2273
|
|
|
|
|
|
|
| |- 1 [S8] = element_2 |
|
2274
|
|
|
|
|
|
|
|
|
2275
|
|
|
|
|
|
|
START_LEVEL => 0: |
|
2276
|
|
|
|
|
|
|
|
|
2277
|
|
|
|
|
|
|
$tree: |
|
2278
|
|
|
|
|
|
|
A [H1] |
|
2279
|
|
|
|
|
|
|
|- a [H2] |
|
2280
|
|
|
|
|
|
|
|- bbbbbb = CODE(0x8139fa0) [C3] |
|
2281
|
|
|
|
|
|
|
|- c123 [C4 -> C3] |
|
2282
|
|
|
|
|
|
|
`- d [R5] |
|
2283
|
|
|
|
|
|
|
`- REF(0x8139fb8) [R5 -> C3] |
|
2284
|
|
|
|
|
|
|
ARRAY [A6] |
|
2285
|
|
|
|
|
|
|
|- 0 [S7] = element_1 |
|
2286
|
|
|
|
|
|
|
|- 1 [S8] = element_2 |
|
2287
|
|
|
|
|
|
|
|
|
2288
|
|
|
|
|
|
|
=head2 ASCII vs ANSI |
|
2289
|
|
|
|
|
|
|
|
|
2290
|
|
|
|
|
|
|
You can direct Data:TreeDumper to output ANSI codes instead of ASCII characters. The display |
|
2291
|
|
|
|
|
|
|
will be much nicer but takes slightly longer (not significant for small data structures). |
|
2292
|
|
|
|
|
|
|
|
|
2293
|
|
|
|
|
|
|
USE_ASCII => 0 # will use ANSI codes instead |
|
2294
|
|
|
|
|
|
|
|
|
2295
|
|
|
|
|
|
|
=head2 Display number of elements |
|
2296
|
|
|
|
|
|
|
|
|
2297
|
|
|
|
|
|
|
DISPLAY_NUMBER_OF_ELEMENTS => 1 |
|
2298
|
|
|
|
|
|
|
|
|
2299
|
|
|
|
|
|
|
When set, the number of elements of every array and hash is displayed (not for objects based on hashes and arrays). |
|
2300
|
|
|
|
|
|
|
|
|
2301
|
|
|
|
|
|
|
=head2 Maximum depth of the dump |
|
2302
|
|
|
|
|
|
|
|
|
2303
|
|
|
|
|
|
|
Controls the depth beyond which which we don't recurse into a structure. Default is -1, which |
|
2304
|
|
|
|
|
|
|
means there is no maximum depth. This is useful to limit the amount of data displayed. |
|
2305
|
|
|
|
|
|
|
|
|
2306
|
|
|
|
|
|
|
MAX_DEPTH => 1 |
|
2307
|
|
|
|
|
|
|
|
|
2308
|
|
|
|
|
|
|
=head2 Number of elements not displayed because of maximum depth limit |
|
2309
|
|
|
|
|
|
|
|
|
2310
|
|
|
|
|
|
|
Data::TreDumper will display the number of elements a hash or array has but that can not be displayed |
|
2311
|
|
|
|
|
|
|
because of the maximum depth setting. |
|
2312
|
|
|
|
|
|
|
|
|
2313
|
|
|
|
|
|
|
DISPLAY_NUMBER_OF_ELEMENTS_OVER_MAX_DEPTH => 1 |
|
2314
|
|
|
|
|
|
|
|
|
2315
|
|
|
|
|
|
|
=head2 Indentation |
|
2316
|
|
|
|
|
|
|
|
|
2317
|
|
|
|
|
|
|
Every line of the tree dump will be appended with the value of I<INDENTATION>. |
|
2318
|
|
|
|
|
|
|
|
|
2319
|
|
|
|
|
|
|
INDENTATION => ' ' ; |
|
2320
|
|
|
|
|
|
|
|
|
2321
|
|
|
|
|
|
|
=head1 Custom glyphs |
|
2322
|
|
|
|
|
|
|
|
|
2323
|
|
|
|
|
|
|
You can change the glyphs used by B<Data::TreeDumper>. |
|
2324
|
|
|
|
|
|
|
|
|
2325
|
|
|
|
|
|
|
DumpTree(\$s, 's', , GLYPHS => ['. ', '. ', '. ', '. ']) ; |
|
2326
|
|
|
|
|
|
|
|
|
2327
|
|
|
|
|
|
|
# output |
|
2328
|
|
|
|
|
|
|
s |
|
2329
|
|
|
|
|
|
|
. REF(0x813da3c) [H1] |
|
2330
|
|
|
|
|
|
|
. . A [H2] |
|
2331
|
|
|
|
|
|
|
. . . a [H3] |
|
2332
|
|
|
|
|
|
|
. . . b [H4] |
|
2333
|
|
|
|
|
|
|
. . . . a = 0 [S5] |
|
2334
|
|
|
|
|
|
|
. . . . b = 1 [S6] |
|
2335
|
|
|
|
|
|
|
. . . . c [H7] |
|
2336
|
|
|
|
|
|
|
. . . . . a = 1 [S8] |
|
2337
|
|
|
|
|
|
|
|
|
2338
|
|
|
|
|
|
|
Four glyphs must be given. They replace the standard glyphs ['| ', '|- ', '`- ', ' ']. It is also possible to set |
|
2339
|
|
|
|
|
|
|
the package variable B<$Data::TreeDumper::Glyphs>. B<USE_ASCII> should be set, which it is by default. |
|
2340
|
|
|
|
|
|
|
|
|
2341
|
|
|
|
|
|
|
=head1 Level numbering and tagging |
|
2342
|
|
|
|
|
|
|
|
|
2343
|
|
|
|
|
|
|
Data:TreeDumper can prepend the level of the current line to the tree glyphs. This can be very useful when |
|
2344
|
|
|
|
|
|
|
searching in tree dump either visually or with a pager. |
|
2345
|
|
|
|
|
|
|
|
|
2346
|
|
|
|
|
|
|
NUMBER_LEVELS => 2 |
|
2347
|
|
|
|
|
|
|
NUMBER_LEVELS => \&NumberingSub |
|
2348
|
|
|
|
|
|
|
|
|
2349
|
|
|
|
|
|
|
NUMBER_LEVELS can be assigned a number or a sub reference. When assigned a number, Data::TreeDumper will use that value to |
|
2350
|
|
|
|
|
|
|
define the width of the field where the level is displayed. For more control, you can define a sub that returns a string to be displayed |
|
2351
|
|
|
|
|
|
|
on the left side of the tree glyphs. The example below tags all the nodes whose level is zero. |
|
2352
|
|
|
|
|
|
|
|
|
2353
|
|
|
|
|
|
|
print DumpTree($s, "Level numbering", NUMBER_LEVELS => 2) ; |
|
2354
|
|
|
|
|
|
|
|
|
2355
|
|
|
|
|
|
|
sub GetLevelTagger |
|
2356
|
|
|
|
|
|
|
{ |
|
2357
|
|
|
|
|
|
|
my $level_to_tag = shift ; |
|
2358
|
|
|
|
|
|
|
|
|
2359
|
|
|
|
|
|
|
sub |
|
2360
|
|
|
|
|
|
|
{ |
|
2361
|
|
|
|
|
|
|
my ($element, $level, $setup) = @_ ; |
|
2362
|
|
|
|
|
|
|
|
|
2363
|
|
|
|
|
|
|
my $tag = "Level $level_to_tag => "; |
|
2364
|
|
|
|
|
|
|
|
|
2365
|
|
|
|
|
|
|
if($level == 0) |
|
2366
|
|
|
|
|
|
|
{ |
|
2367
|
|
|
|
|
|
|
return($tag) ; |
|
2368
|
|
|
|
|
|
|
} |
|
2369
|
|
|
|
|
|
|
else |
|
2370
|
|
|
|
|
|
|
{ |
|
2371
|
|
|
|
|
|
|
return(' ' x length($tag)) ; |
|
2372
|
|
|
|
|
|
|
} |
|
2373
|
|
|
|
|
|
|
} ; |
|
2374
|
|
|
|
|
|
|
} |
|
2375
|
|
|
|
|
|
|
|
|
2376
|
|
|
|
|
|
|
print DumpTree($s, "Level tagging", NUMBER_LEVELS => GetLevelTagger(0)) ; |
|
2377
|
|
|
|
|
|
|
|
|
2378
|
|
|
|
|
|
|
=head1 Level coloring |
|
2379
|
|
|
|
|
|
|
|
|
2380
|
|
|
|
|
|
|
Another way to enhance the output for easier searching is to colorize it. Data::TreeDumper can colorize the glyph elements or whole levels. |
|
2381
|
|
|
|
|
|
|
If your terminal supports ANSI codes, using Term::ANSIColors and Data::TreeDumper together can greatly ease the reading of large dumps. |
|
2382
|
|
|
|
|
|
|
See the examples in 'B<color.pl>'. |
|
2383
|
|
|
|
|
|
|
|
|
2384
|
|
|
|
|
|
|
COLOR_LEVELS => [\@color_codes, $reset_code] |
|
2385
|
|
|
|
|
|
|
|
|
2386
|
|
|
|
|
|
|
When passed an array reference, the first element is an array containing coloring codes. The codes are indexed |
|
2387
|
|
|
|
|
|
|
with the node level modulo the size of the array. The second element is used to reset the color after the glyph is displayed. If the second |
|
2388
|
|
|
|
|
|
|
element is an empty string, the glyph and the rest of the level is colorized. |
|
2389
|
|
|
|
|
|
|
|
|
2390
|
|
|
|
|
|
|
COLOR_LEVELS => \&LevelColoringSub |
|
2391
|
|
|
|
|
|
|
|
|
2392
|
|
|
|
|
|
|
If COLOR_LEVEL is assigned a sub, the sub is called for each glyph element. It is passed the following elements: |
|
2393
|
|
|
|
|
|
|
|
|
2394
|
|
|
|
|
|
|
=over 2 |
|
2395
|
|
|
|
|
|
|
|
|
2396
|
|
|
|
|
|
|
=item 1 - the nodes depth (this allows you to selectively display elements at a certain depth) |
|
2397
|
|
|
|
|
|
|
|
|
2398
|
|
|
|
|
|
|
=back |
|
2399
|
|
|
|
|
|
|
|
|
2400
|
|
|
|
|
|
|
It should return a coloring code and a reset code. If you return an |
|
2401
|
|
|
|
|
|
|
empty string for the reset code, the whole node is displayed using the last glyph element color. |
|
2402
|
|
|
|
|
|
|
|
|
2403
|
|
|
|
|
|
|
If level numbering is on, it is also colorized. |
|
2404
|
|
|
|
|
|
|
|
|
2405
|
|
|
|
|
|
|
=head1 Wrapping |
|
2406
|
|
|
|
|
|
|
|
|
2407
|
|
|
|
|
|
|
B<Data::TreeDumper> uses the Text::Wrap module to wrap your data to fit your display. Entries can be |
|
2408
|
|
|
|
|
|
|
wrapped multiple times so they snuggly fit your screen. |
|
2409
|
|
|
|
|
|
|
|
|
2410
|
|
|
|
|
|
|
| | |- 1 [S21] = 1 |
|
2411
|
|
|
|
|
|
|
| | `- 2 [S22] = 2 |
|
2412
|
|
|
|
|
|
|
| `- 3 [OH23 -> R17] |
|
2413
|
|
|
|
|
|
|
|- ARRAY_ZERO [A24] |
|
2414
|
|
|
|
|
|
|
|- B [S25] = scalar |
|
2415
|
|
|
|
|
|
|
|- Long_name Long_name Long_name Long_name Long_name Long_name |
|
2416
|
|
|
|
|
|
|
| Long_name Long_name Long_name Long_name Long_name Long_name |
|
2417
|
|
|
|
|
|
|
| Long_name Long_name Long_name Long_name Long_name [S26] = 0 |
|
2418
|
|
|
|
|
|
|
|
|
2419
|
|
|
|
|
|
|
You can direct DTD to not wrap your text by setting B<NO_WRAP => 1>. |
|
2420
|
|
|
|
|
|
|
|
|
2421
|
|
|
|
|
|
|
=head2 WRAP_WIDTH |
|
2422
|
|
|
|
|
|
|
|
|
2423
|
|
|
|
|
|
|
if this option is set, B<Data::TreeDumper> will use it instead for the console width. |
|
2424
|
|
|
|
|
|
|
|
|
2425
|
|
|
|
|
|
|
=head1 Custom Rendering |
|
2426
|
|
|
|
|
|
|
|
|
2427
|
|
|
|
|
|
|
B<Data::TreeDumper> has a plug-in interface for other rendering formats. The renderer callbacks are |
|
2428
|
|
|
|
|
|
|
set by overriding the native renderer. Thanks to Stevan Little author of Tree::Simple::View for getting |
|
2429
|
|
|
|
|
|
|
B<Data::TreeDumper> on this track. Check B<Data::TreeDumper::Renderer::DHTML>. |
|
2430
|
|
|
|
|
|
|
|
|
2431
|
|
|
|
|
|
|
DumpTree |
|
2432
|
|
|
|
|
|
|
( |
|
2433
|
|
|
|
|
|
|
$s |
|
2434
|
|
|
|
|
|
|
, 'Tree' |
|
2435
|
|
|
|
|
|
|
, RENDERER => |
|
2436
|
|
|
|
|
|
|
{ |
|
2437
|
|
|
|
|
|
|
BEGIN => \&RenderDhtmlBegin |
|
2438
|
|
|
|
|
|
|
, NODE => \&RenderDhtmlNode |
|
2439
|
|
|
|
|
|
|
, END => \&RenderDhtmlEnd |
|
2440
|
|
|
|
|
|
|
|
|
2441
|
|
|
|
|
|
|
# data needed by the renderer |
|
2442
|
|
|
|
|
|
|
, PREVIOUS_LEVEL => -1 |
|
2443
|
|
|
|
|
|
|
, PREVIOUS_ADDRESS => 'ROOT' |
|
2444
|
|
|
|
|
|
|
} |
|
2445
|
|
|
|
|
|
|
) ; |
|
2446
|
|
|
|
|
|
|
|
|
2447
|
|
|
|
|
|
|
=head2 Callbacks |
|
2448
|
|
|
|
|
|
|
|
|
2449
|
|
|
|
|
|
|
=over 2 |
|
2450
|
|
|
|
|
|
|
|
|
2451
|
|
|
|
|
|
|
=item * {RENDERER}{BEGIN} is called before the traversal of the data structure starts. This allows you |
|
2452
|
|
|
|
|
|
|
to setup the document (ex:: html header). |
|
2453
|
|
|
|
|
|
|
|
|
2454
|
|
|
|
|
|
|
=over 4 |
|
2455
|
|
|
|
|
|
|
|
|
2456
|
|
|
|
|
|
|
my ($title, $type_address, $element, $size, $perl_address, $setup) = @_ ; |
|
2457
|
|
|
|
|
|
|
|
|
2458
|
|
|
|
|
|
|
=item 1 $title |
|
2459
|
|
|
|
|
|
|
|
|
2460
|
|
|
|
|
|
|
|
|
2461
|
|
|
|
|
|
|
=item 2 $type_address |
|
2462
|
|
|
|
|
|
|
|
|
2463
|
|
|
|
|
|
|
|
|
2464
|
|
|
|
|
|
|
=item 3 $element |
|
2465
|
|
|
|
|
|
|
|
|
2466
|
|
|
|
|
|
|
|
|
2467
|
|
|
|
|
|
|
=item 4 $perl_size |
|
2468
|
|
|
|
|
|
|
|
|
2469
|
|
|
|
|
|
|
|
|
2470
|
|
|
|
|
|
|
=item 5 $perl_address |
|
2471
|
|
|
|
|
|
|
|
|
2472
|
|
|
|
|
|
|
|
|
2473
|
|
|
|
|
|
|
=item 6 $setup |
|
2474
|
|
|
|
|
|
|
|
|
2475
|
|
|
|
|
|
|
=back |
|
2476
|
|
|
|
|
|
|
|
|
2477
|
|
|
|
|
|
|
=item * {RENDERER}{NODE} is called for each node in the data structure. The following arguments are passed to the callback |
|
2478
|
|
|
|
|
|
|
|
|
2479
|
|
|
|
|
|
|
=over 4 |
|
2480
|
|
|
|
|
|
|
|
|
2481
|
|
|
|
|
|
|
=item 1 $element |
|
2482
|
|
|
|
|
|
|
|
|
2483
|
|
|
|
|
|
|
|
|
2484
|
|
|
|
|
|
|
=item 2 $level |
|
2485
|
|
|
|
|
|
|
|
|
2486
|
|
|
|
|
|
|
|
|
2487
|
|
|
|
|
|
|
=item 3 $is_terminal (whether a deeper structure will follow or not) |
|
2488
|
|
|
|
|
|
|
|
|
2489
|
|
|
|
|
|
|
|
|
2490
|
|
|
|
|
|
|
=item 4 $previous_level_separator (ASCII separators before this node) |
|
2491
|
|
|
|
|
|
|
|
|
2492
|
|
|
|
|
|
|
|
|
2493
|
|
|
|
|
|
|
=item 5 $separator (ASCII separator for this element) |
|
2494
|
|
|
|
|
|
|
|
|
2495
|
|
|
|
|
|
|
|
|
2496
|
|
|
|
|
|
|
=item 6 $element_name |
|
2497
|
|
|
|
|
|
|
|
|
2498
|
|
|
|
|
|
|
|
|
2499
|
|
|
|
|
|
|
=item 7 $element_value |
|
2500
|
|
|
|
|
|
|
|
|
2501
|
|
|
|
|
|
|
|
|
2502
|
|
|
|
|
|
|
=item 8 $td_address (address of the element, Ex: C12 or H34. Unique for each element) |
|
2503
|
|
|
|
|
|
|
|
|
2504
|
|
|
|
|
|
|
|
|
2505
|
|
|
|
|
|
|
=item 9 $link_address (link to another element, may be undef) |
|
2506
|
|
|
|
|
|
|
|
|
2507
|
|
|
|
|
|
|
|
|
2508
|
|
|
|
|
|
|
=item 10 $perl_size (size of the lement in bytes, see option B<DISPLAY_PERL_SIZE>) |
|
2509
|
|
|
|
|
|
|
|
|
2510
|
|
|
|
|
|
|
|
|
2511
|
|
|
|
|
|
|
=item 11 $perl_address (adress (physical) of the element, see option B<DISPLAY_PERL_ADDRESS>) |
|
2512
|
|
|
|
|
|
|
|
|
2513
|
|
|
|
|
|
|
|
|
2514
|
|
|
|
|
|
|
=item 12 $setup (the dumper's settings) |
|
2515
|
|
|
|
|
|
|
|
|
2516
|
|
|
|
|
|
|
|
|
2517
|
|
|
|
|
|
|
=back |
|
2518
|
|
|
|
|
|
|
|
|
2519
|
|
|
|
|
|
|
=item * {RENDERER}{END} is called after the last node has been processed. |
|
2520
|
|
|
|
|
|
|
|
|
2521
|
|
|
|
|
|
|
=item * {RENDERER}{ ... }Arguments to the renderer can be stores within the {RENDERER} hash. |
|
2522
|
|
|
|
|
|
|
|
|
2523
|
|
|
|
|
|
|
=back |
|
2524
|
|
|
|
|
|
|
|
|
2525
|
|
|
|
|
|
|
=head2 Renderer modules |
|
2526
|
|
|
|
|
|
|
|
|
2527
|
|
|
|
|
|
|
Renderers should be defined in modules under B<Data::TreeDumper::Renderer> and should define a function |
|
2528
|
|
|
|
|
|
|
called I<GetRenderer>. I<GetRenderer> can be passed whatever arguments the developer whishes. It is |
|
2529
|
|
|
|
|
|
|
acceptable for the modules to also export a specifc sub. |
|
2530
|
|
|
|
|
|
|
|
|
2531
|
|
|
|
|
|
|
print DumpTree($s, 'Tree', Data::TreeDumper::Renderer::DHTML::GetRenderer()) ; |
|
2532
|
|
|
|
|
|
|
or |
|
2533
|
|
|
|
|
|
|
print DumpTree($s, 'Tree', GetDhtmlRenderer()) ; |
|
2534
|
|
|
|
|
|
|
|
|
2535
|
|
|
|
|
|
|
If B<{RENDERER}> is set to a scalar, B<Data::TreeDumper> will load the |
|
2536
|
|
|
|
|
|
|
specified module if it exists. I<GetRenderer> will be called without |
|
2537
|
|
|
|
|
|
|
arguments. |
|
2538
|
|
|
|
|
|
|
|
|
2539
|
|
|
|
|
|
|
print DumpTree($s, 'Tree', RENDERER => 'DHTML') ; |
|
2540
|
|
|
|
|
|
|
|
|
2541
|
|
|
|
|
|
|
If B<{RENDERER}{NAME}> is set to a scalar, B<Data::TreeDumper> will load the specified module if it exists. I<GetRenderer> |
|
2542
|
|
|
|
|
|
|
will be called without arguments. Arguments to the renderer can aither be passed to the GetRenderer sub or as elements in the {RENDERER} hash. |
|
2543
|
|
|
|
|
|
|
|
|
2544
|
|
|
|
|
|
|
print DumpTree($s, 'Tree', RENDERER => {NAME => 'DHTML', STYLE => \$style) ; |
|
2545
|
|
|
|
|
|
|
|
|
2546
|
|
|
|
|
|
|
|
|
2547
|
|
|
|
|
|
|
=head1 Zero width console |
|
2548
|
|
|
|
|
|
|
|
|
2549
|
|
|
|
|
|
|
When no console exists, while redirecting to a file for example, Data::TreeDumper uses the variable |
|
2550
|
|
|
|
|
|
|
B<VIRTUAL_WIDTH> instead. Default is 120. |
|
2551
|
|
|
|
|
|
|
|
|
2552
|
|
|
|
|
|
|
VIRTUAL_WIDTH => 120 ; |
|
2553
|
|
|
|
|
|
|
|
|
2554
|
|
|
|
|
|
|
=head1 OVERRIDE list |
|
2555
|
|
|
|
|
|
|
|
|
2556
|
|
|
|
|
|
|
=over 2 |
|
2557
|
|
|
|
|
|
|
|
|
2558
|
|
|
|
|
|
|
=item * COLOR_LEVELS |
|
2559
|
|
|
|
|
|
|
|
|
2560
|
|
|
|
|
|
|
=item * DISPLAY_ADDRESS |
|
2561
|
|
|
|
|
|
|
|
|
2562
|
|
|
|
|
|
|
=item * DISPLAY_PATH |
|
2563
|
|
|
|
|
|
|
|
|
2564
|
|
|
|
|
|
|
=item * DISPLAY_PERL_SIZE |
|
2565
|
|
|
|
|
|
|
|
|
2566
|
|
|
|
|
|
|
=item * DISPLAY_ROOT_ADDRESS |
|
2567
|
|
|
|
|
|
|
|
|
2568
|
|
|
|
|
|
|
=item * DISPLAY_PERL_ADDRESS |
|
2569
|
|
|
|
|
|
|
|
|
2570
|
|
|
|
|
|
|
=item * FILTER |
|
2571
|
|
|
|
|
|
|
|
|
2572
|
|
|
|
|
|
|
=item * GLYPHS |
|
2573
|
|
|
|
|
|
|
|
|
2574
|
|
|
|
|
|
|
=item * INDENTATION |
|
2575
|
|
|
|
|
|
|
|
|
2576
|
|
|
|
|
|
|
=item * LEVEL_FILTERS |
|
2577
|
|
|
|
|
|
|
|
|
2578
|
|
|
|
|
|
|
=item * MAX_DEPTH |
|
2579
|
|
|
|
|
|
|
|
|
2580
|
|
|
|
|
|
|
=item * DISPLAY_NUMBER_OF_ELEMENTS_OVER_MAX_DEPTH |
|
2581
|
|
|
|
|
|
|
|
|
2582
|
|
|
|
|
|
|
=item * NUMBER_LEVELS |
|
2583
|
|
|
|
|
|
|
|
|
2584
|
|
|
|
|
|
|
=item * QUOTE_HASH_KEYS |
|
2585
|
|
|
|
|
|
|
|
|
2586
|
|
|
|
|
|
|
=item * QUOTE_VALUES |
|
2587
|
|
|
|
|
|
|
|
|
2588
|
|
|
|
|
|
|
=item * REPLACEMENT_LIST |
|
2589
|
|
|
|
|
|
|
|
|
2590
|
|
|
|
|
|
|
=item * START_LEVEL |
|
2591
|
|
|
|
|
|
|
|
|
2592
|
|
|
|
|
|
|
=item * USE_ASCII |
|
2593
|
|
|
|
|
|
|
|
|
2594
|
|
|
|
|
|
|
=item * WRAP_WIDTH |
|
2595
|
|
|
|
|
|
|
|
|
2596
|
|
|
|
|
|
|
=item * VIRTUAL_WIDTH |
|
2597
|
|
|
|
|
|
|
|
|
2598
|
|
|
|
|
|
|
=item * NO_OUTPUT |
|
2599
|
|
|
|
|
|
|
|
|
2600
|
|
|
|
|
|
|
=item * DISPLAY_OBJECT_TYPE |
|
2601
|
|
|
|
|
|
|
|
|
2602
|
|
|
|
|
|
|
=item * DISPLAY_INHERITANCE |
|
2603
|
|
|
|
|
|
|
|
|
2604
|
|
|
|
|
|
|
=item * DISPLAY_TIE |
|
2605
|
|
|
|
|
|
|
|
|
2606
|
|
|
|
|
|
|
=item * DISPLAY_AUTOLOAD |
|
2607
|
|
|
|
|
|
|
|
|
2608
|
|
|
|
|
|
|
=back |
|
2609
|
|
|
|
|
|
|
|
|
2610
|
|
|
|
|
|
|
=head1 Interface |
|
2611
|
|
|
|
|
|
|
|
|
2612
|
|
|
|
|
|
|
=head2 Package Data (à la Data::Dumper (as is the silly naming scheme)) |
|
2613
|
|
|
|
|
|
|
|
|
2614
|
|
|
|
|
|
|
=head3 Configuration Variables |
|
2615
|
|
|
|
|
|
|
|
|
2616
|
|
|
|
|
|
|
$Data::TreeDumper::Startlevel = 1 ; |
|
2617
|
|
|
|
|
|
|
$Data::TreeDumper::Useascii = 1 ; |
|
2618
|
|
|
|
|
|
|
$Data::TreeDumper::Maxdepth = -1 ; |
|
2619
|
|
|
|
|
|
|
$Data::TreeDumper::Indentation = '' ; |
|
2620
|
|
|
|
|
|
|
$Data::TreeDumper::Virtualwidth = 120 ; |
|
2621
|
|
|
|
|
|
|
$Data::TreeDumper::Displayrootaddress = 0 ; |
|
2622
|
|
|
|
|
|
|
$Data::TreeDumper::Displayaddress = 1 ; |
|
2623
|
|
|
|
|
|
|
$Data::TreeDumper::Displaypath = 0 ; |
|
2624
|
|
|
|
|
|
|
$Data::TreeDumper::Displayobjecttype = 1 ; |
|
2625
|
|
|
|
|
|
|
$Data::TreeDumper::Displayinheritance = 0 ; |
|
2626
|
|
|
|
|
|
|
$Data::TreeDumper::Displaytie = 0 ; |
|
2627
|
|
|
|
|
|
|
$Data::TreeDumper::Displayautoload = 0 ; |
|
2628
|
|
|
|
|
|
|
$Data::TreeDumper::Displayperlsize = 0 ; |
|
2629
|
|
|
|
|
|
|
$Data::TreeDumper::Displayperladdress = 0 ; |
|
2630
|
|
|
|
|
|
|
$Data::TreeDumper::Filter = \&FlipEverySecondOne ; |
|
2631
|
|
|
|
|
|
|
$Data::TreeDumper::Levelfilters = {1 => \&Filter_1, 5 => \&Filter_5} ; |
|
2632
|
|
|
|
|
|
|
$Data::TreeDumper::Numberlevels = 0 ; |
|
2633
|
|
|
|
|
|
|
$Data::TreeDumper::Glyphs = ['| ', '|- ', '`- ', ' '] ; |
|
2634
|
|
|
|
|
|
|
$Data::TreeDumper::Colorlevels = undef ; |
|
2635
|
|
|
|
|
|
|
$Data::TreeDumper::Nooutput = 0 ; # generate an output |
|
2636
|
|
|
|
|
|
|
$Data::TreeDumper::Quotehashkeys = 0 ; |
|
2637
|
|
|
|
|
|
|
$Data::TreeDumper::Displaycallerlocation = 0 ; |
|
2638
|
|
|
|
|
|
|
|
|
2639
|
|
|
|
|
|
|
=head3 API |
|
2640
|
|
|
|
|
|
|
|
|
2641
|
|
|
|
|
|
|
B<PrintTree>prints on STDOUT the output of B<DumpTree>. |
|
2642
|
|
|
|
|
|
|
|
|
2643
|
|
|
|
|
|
|
B<DumpTree> uses the configuration variables defined above. It takes the following arguments: |
|
2644
|
|
|
|
|
|
|
|
|
2645
|
|
|
|
|
|
|
=over 2 |
|
2646
|
|
|
|
|
|
|
|
|
2647
|
|
|
|
|
|
|
=item [1] structure_to_dump |
|
2648
|
|
|
|
|
|
|
|
|
2649
|
|
|
|
|
|
|
=item [2] title, a string to prepended to the tree (optional) |
|
2650
|
|
|
|
|
|
|
|
|
2651
|
|
|
|
|
|
|
=item [3] overrides (optional) |
|
2652
|
|
|
|
|
|
|
|
|
2653
|
|
|
|
|
|
|
=back |
|
2654
|
|
|
|
|
|
|
|
|
2655
|
|
|
|
|
|
|
print DumpTree($s, "title", MAX_DEPTH => 1) ; |
|
2656
|
|
|
|
|
|
|
|
|
2657
|
|
|
|
|
|
|
B<DumpTrees> uses the configuration variables defined above. It takes the following arguments |
|
2658
|
|
|
|
|
|
|
|
|
2659
|
|
|
|
|
|
|
=over 2 |
|
2660
|
|
|
|
|
|
|
|
|
2661
|
|
|
|
|
|
|
=item [1] One or more array references containing |
|
2662
|
|
|
|
|
|
|
|
|
2663
|
|
|
|
|
|
|
=over 4 |
|
2664
|
|
|
|
|
|
|
|
|
2665
|
|
|
|
|
|
|
=item [a] structure_to_dump |
|
2666
|
|
|
|
|
|
|
|
|
2667
|
|
|
|
|
|
|
=item [b] title, a string to prepended to the tree (optional) |
|
2668
|
|
|
|
|
|
|
|
|
2669
|
|
|
|
|
|
|
=item [c] overrides (optional) |
|
2670
|
|
|
|
|
|
|
|
|
2671
|
|
|
|
|
|
|
=back |
|
2672
|
|
|
|
|
|
|
|
|
2673
|
|
|
|
|
|
|
=item [2] overrides (optional) |
|
2674
|
|
|
|
|
|
|
|
|
2675
|
|
|
|
|
|
|
=back |
|
2676
|
|
|
|
|
|
|
|
|
2677
|
|
|
|
|
|
|
print DumpTrees |
|
2678
|
|
|
|
|
|
|
( |
|
2679
|
|
|
|
|
|
|
[$s, "title", MAX_DEPTH => 1] |
|
2680
|
|
|
|
|
|
|
, [$s2, "other_title", DISPLAY_ADDRESS => 0] |
|
2681
|
|
|
|
|
|
|
, USE_ASCII => 1 |
|
2682
|
|
|
|
|
|
|
, MAX_DEPTH => 5 |
|
2683
|
|
|
|
|
|
|
) ; |
|
2684
|
|
|
|
|
|
|
|
|
2685
|
|
|
|
|
|
|
=head1 Bugs |
|
2686
|
|
|
|
|
|
|
|
|
2687
|
|
|
|
|
|
|
None that I know of in this release but plenty, lurking in the dark |
|
2688
|
|
|
|
|
|
|
corners, waiting to be found. |
|
2689
|
|
|
|
|
|
|
|
|
2690
|
|
|
|
|
|
|
=head1 Examples |
|
2691
|
|
|
|
|
|
|
|
|
2692
|
|
|
|
|
|
|
Four examples files are included in the distribution. |
|
2693
|
|
|
|
|
|
|
|
|
2694
|
|
|
|
|
|
|
I<usage.pl> shows you how you can use B<Data::TreeDumper>. |
|
2695
|
|
|
|
|
|
|
|
|
2696
|
|
|
|
|
|
|
I<filters.pl> shows you how you how to do advance filtering. |
|
2697
|
|
|
|
|
|
|
|
|
2698
|
|
|
|
|
|
|
I<colors.pl> shows you how you how to colorize a dump. |
|
2699
|
|
|
|
|
|
|
|
|
2700
|
|
|
|
|
|
|
I<try_it.pl> is meant as a scratch pad for you to try B<Data::TreeDumper>. |
|
2701
|
|
|
|
|
|
|
|
|
2702
|
|
|
|
|
|
|
=head1 DEPENDENCY |
|
2703
|
|
|
|
|
|
|
|
|
2704
|
|
|
|
|
|
|
B<Text::Wrap>. |
|
2705
|
|
|
|
|
|
|
|
|
2706
|
|
|
|
|
|
|
B<Term::Size> or B<Win32::Console>. |
|
2707
|
|
|
|
|
|
|
|
|
2708
|
|
|
|
|
|
|
Optional B<Devel::Size> if you want Data::TreeDumper to show perl sizes for the tree elements. |
|
2709
|
|
|
|
|
|
|
|
|
2710
|
|
|
|
|
|
|
=head1 EXPORT |
|
2711
|
|
|
|
|
|
|
|
|
2712
|
|
|
|
|
|
|
I<DumpTree>, I<DumpTrees> and I<CreateChainingFilter>. |
|
2713
|
|
|
|
|
|
|
|
|
2714
|
|
|
|
|
|
|
=head1 AUTHOR |
|
2715
|
|
|
|
|
|
|
|
|
2716
|
|
|
|
|
|
|
Khemir Nadim ibn Hamouda. <nadim@khemir.net> |
|
2717
|
|
|
|
|
|
|
|
|
2718
|
|
|
|
|
|
|
Thanks to Ed Avis for showing interest and pushing me to re-write the documentation. |
|
2719
|
|
|
|
|
|
|
|
|
2720
|
|
|
|
|
|
|
Copyright (c) 2003-2010 Nadim Ibn Hamouda el Khemir. All rights |
|
2721
|
|
|
|
|
|
|
reserved. This program is free software; you can redis- |
|
2722
|
|
|
|
|
|
|
tribute it and/or modify it under the same terms as Perl |
|
2723
|
|
|
|
|
|
|
itself. |
|
2724
|
|
|
|
|
|
|
|
|
2725
|
|
|
|
|
|
|
If you find any value in this module, mail me! All hints, tips, flames and wishes |
|
2726
|
|
|
|
|
|
|
are welcome at <nadim@khemir.net>. |
|
2727
|
|
|
|
|
|
|
|
|
2728
|
|
|
|
|
|
|
=head1 SEE ALSO |
|
2729
|
|
|
|
|
|
|
|
|
2730
|
|
|
|
|
|
|
B<Data::TreeDumper::00>. B<Data::Dumper>. |
|
2731
|
|
|
|
|
|
|
|
|
2732
|
|
|
|
|
|
|
B<Data::TreeDumper::Renderer::DHTML>. |
|
2733
|
|
|
|
|
|
|
|
|
2734
|
|
|
|
|
|
|
B<Devel::Size::Report>.B<Devel::Size>. |
|
2735
|
|
|
|
|
|
|
|
|
2736
|
|
|
|
|
|
|
B<PBS>: the Perl Build System from which B<Data::TreeDumper> was extracted. |
|
2737
|
|
|
|
|
|
|
|
|
2738
|
|
|
|
|
|
|
=cut |
|
2739
|
|
|
|
|
|
|
|
|
2740
|
|
|
|
|
|
|
|