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
|
|
|
|
|
|
|
|