File Coverage

blib/lib/MDOM/Dumper.pm
Criterion Covered Total %
statement 57 79 72.1
branch 26 60 43.3
condition 6 8 75.0
subroutine 8 10 80.0
pod 4 4 100.0
total 101 161 62.7


line stmt bran cond sub pod time code
1             package MDOM::Dumper;
2              
3             =pod
4              
5             =head1 NAME
6              
7             MDOM::Dumper - Dumping of MDOM trees
8              
9             =head1 SYNOPSIS
10              
11             # Load a document
12             my $Module = MDOM::Document->new( 'MyMakefile' );
13            
14             # Create the dumper
15             my $Dumper = MDOM::Dumper->new( $Module );
16            
17             # Dump the document
18             $Dumper->print;
19              
20             =head1 DESCRIPTION
21              
22             The MDOM trees in MDOM are quite complex, and getting a dump of their
23             structure for development and debugging purposes is important.
24              
25             This module provides that functionality.
26              
27             The process is relatively simple. Create a dumper object with a
28             particular set of options, and then call one of the dump methods to
29             generate the dump content itself.
30              
31             =head1 METHODS
32              
33             =cut
34              
35 13     13   5346 use strict;
  13         22  
  13         525  
36 13     13   57 use Params::Util '_INSTANCE';
  13         19  
  13         586  
37              
38 13     13   56 use vars qw{$VERSION};
  13         17  
  13         562  
39             BEGIN {
40 13     13   9412 $VERSION = '0.007';
41             }
42              
43              
44              
45              
46              
47             #####################################################################
48             # Constructor
49              
50             =pod
51              
52             =head2 new $Element, param => value, ...
53              
54             The C constructor creates a dumper, and takes as argument a single
55             L object of any type to serve as the root of the tree to
56             be dumped, and a number of key-Evalue parameters to control the output
57             format of the Dumper. Details of the parameters are listed below.
58              
59             Returns a new C object, or C if the constructor
60             is not passed a correct L root object.
61              
62             =over
63              
64             =item memaddr
65              
66             Should the dumper print the memory addresses of each MDOM element.
67             True/false value, off by default.
68              
69             =item indent
70              
71             Should the structures being dumped be indented. This value is numeric,
72             with the number representing the number of spaces to use when indenting
73             the dumper output. Set to '2' by default.
74              
75             =item class
76              
77             Should the dumper print the full class for each element.
78             True/false value, on by default.
79              
80             =item content
81              
82             Should the dumper show the content of each element. True/false value,
83             on by default.
84              
85             =item whitespace
86              
87             Should the dumper show whitespace tokens. By not showing the copious
88             numbers of whitespace tokens the structure of the code can often be
89             made much clearer. True/false value, on by default.
90              
91             =item comments
92              
93             Should the dumper show comment tokens. In situations where you have
94             a lot of comments, the code can often be made clearer by ignoring
95             comment tokens. True/value value, on by default.
96              
97             =item locations
98              
99             Should the dumper show the location of each token. The values shown are
100             [ line, rowchar, column ]. See L for a description of
101             what these values really are. True/false value, off by default.
102              
103             =back
104              
105             =cut
106              
107             sub new {
108 69     69 1 446 my $class = shift;
109 69 50       636 my $Element = _INSTANCE(shift, 'MDOM::Element') or return undef;
110              
111             # Create the object
112 69         502 my $self = bless {
113             root => $Element,
114             display => {
115             memaddr => '', # Show the refaddr of the item
116             indent => 2, # Indent the structures
117             class => 1, # Show the object class
118             content => 1, # Show the object contents
119             whitespace => 1, # Show whitespace tokens
120             comments => 1, # Show comment tokens
121             locations => 0, # Show token locations
122             },
123             }, $class;
124              
125             # Handle the options
126 69         161 my %options = map { lc $_ } @_;
  0         0  
127 69         81 foreach ( keys %{$self->{display}} ) {
  69         336  
128 483 50       770 if ( exists $options{$_} ) {
129 0 0       0 if ( $_ eq 'indent' ) {
130 0         0 $self->{display}->{indent} = $options{$_};
131             } else {
132 0         0 $self->{display}->{$_} = !! $options{$_};
133             }
134             }
135             }
136              
137 69         288 $self->{indent_string} = join '', (' ' x $self->{display}->{indent});
138              
139             # Try to auto-call index_locations. If it failes, turn of locations display
140 69 50       159 if ( $self->{display}->{locations} ) {
141 0 0       0 my $Document = $Element->isa('MDOM::Document') ? $Element : $Element->top;
142 0 0       0 if ( $Document->isa('MDOM::Document') ) {
143 0         0 $Document->index_locations();
144             } else {
145 0         0 $self->{display}->{locations} = 0;
146             }
147             }
148            
149 69         157 $self;
150             }
151              
152              
153              
154              
155              
156             #####################################################################
157             # Main Interface Methods
158              
159             =pod
160              
161             =head2 print
162              
163             The C method generates the dump and prints it to STDOUT.
164              
165             Returns as for the internal print function.
166              
167             =cut
168              
169             sub print {
170 0     0 1 0 CORE::print(shift->string);
171             }
172              
173             =pod
174              
175             =head2 string
176              
177             The C method generates the dump and provides it as a
178             single string.
179              
180             Returns a string or undef if there is an error while generating the dump.
181              
182             =cut
183              
184             sub string {
185 69 50   69 1 319 my $array_ref = shift->_dump or return undef;
186 69         140 join '', map { "$_\n" } @$array_ref;
  861         1332  
187             }
188              
189             =pod
190              
191             =head2 list
192              
193             The C method generates the dump and provides it as a raw
194             list, without trailing newlines.
195              
196             Returns a list or the null list if there is an error while generation
197             the dump.
198              
199             =cut
200              
201             sub list {
202 0 0   0 1 0 my $array_ref = shift->_dump or return ();
203 0         0 @$array_ref;
204             }
205              
206              
207              
208              
209              
210             #####################################################################
211             # Generation Support Methods
212              
213             sub _dump {
214 861 50   861   1190 my $self = ref $_[0] ? shift : shift->new(shift);
215 861 100       4167 my $Element = _INSTANCE($_[0], 'MDOM::Element') ? shift : $self->{root};
216 861   100     1474 my $indent = shift || '';
217 861   100     1334 my $output = shift || [];
218              
219             # Print the element if needed
220 861         670 my $show = 1;
221 861 100       3737 if ( $Element->isa('MDOM::Token::Whitespace') ) {
    100          
222 279 50       521 $show = 0 unless $self->{display}->{whitespace};
223             } elsif ( $Element->isa('MDOM::Token::Comment') ) {
224 16 50       37 $show = 0 unless $self->{display}->{comments};
225             }
226 861 50       1695 push @$output, $self->_element_string( $Element, $indent ) if $show;
227              
228             # Recurse into our children
229 861 100       2504 if ( $Element->isa('MDOM::Node') ) {
230 187         272 my $child_indent = $indent . $self->{indent_string};
231 187         132 foreach my $child ( @{$Element->{children}} ) {
  187         312  
232 792         1071 $self->_dump( $child, $child_indent, $output );
233             }
234             }
235              
236 861         1153 $output;
237             }
238              
239             sub _element_string {
240 861 50   861   1114 my $self = ref $_[0] ? shift : shift->new(shift);
241 861 50       2934 my $Element = _INSTANCE($_[0], 'MDOM::Element') ? shift : $self->{root};
242 861   100     1327 my $indent = shift || '';
243 861         670 my $string = '';
244              
245             # Add the memory location
246 861 50       1383 if ( $self->{display}->{memaddr} ) {
247 0         0 $string .= $Element->refaddr . ' ';
248             }
249            
250             # Add the location if such exists
251 861 50       1279 if ( $self->{display}->{locations} ) {
252 0         0 my $loc_string;
253 0 0       0 if ( $Element->isa('MDOM::Token') ) {
254 0         0 my $location = $Element->location;
255 0 0       0 if ($location) {
256 0         0 $loc_string = sprintf("[ % 4d, % 3d, % 3d ] ", @$location);
257             }
258             }
259             # Output location or pad with 20 spaces
260 0   0     0 $string .= $loc_string || " " x 20;
261             }
262            
263             # Add the indent
264 861 50       1261 if ( $self->{display}->{indent} ) {
265 861         894 $string .= $indent;
266             }
267              
268             # Add the class name
269 861 50       1260 if ( $self->{display}->{class} ) {
270 861         985 $string .= ref $Element;
271             }
272              
273 861 100       2042 if ( $Element->isa('MDOM::Token') ) {
    50          
274             # Add the content
275 674 50       1050 if ( $self->{display}->{content} ) {
276 674         1139 my $content = $Element->content;
277 674         934 $content =~ s/\n/\\n/g;
278 674         610 $content =~ s/\t/\\t/g;
279 674         561 $content =~ s/'/\\'/g;
280 674         512 $content =~ s/\r/\\r/g;
281 674         914 $string .= " \t'$content'";
282             }
283             } elsif ( $Element->isa('MDOM::Structure') ) {
284             # Add the content
285 0 0       0 if ( $self->{display}->{content} ) {
286 0 0       0 my $start = $Element->start
287             ? $Element->start->content
288             : '???';
289 0 0       0 my $finish = $Element->finish
290             ? $Element->finish->content
291             : '???';
292 0         0 $string .= " \t$start ... $finish";
293             }
294             }
295            
296 861         1319 $string;
297             }
298              
299             1;
300              
301             =pod
302              
303             =head1 SUPPORT
304              
305             See the L in the main module.
306              
307             =head1 AUTHOR
308              
309             Adam Kennedy Eadamk@cpan.orgE
310              
311             Yichun "agentzh" Zhang C<< >>
312              
313             =head1 COPYRIGHT
314              
315             Copyright 2001 - 2006 Adam Kennedy.
316              
317             This program is free software; you can redistribute
318             it and/or modify it under the same terms as Perl itself.
319              
320             The full text of the license can be found in the
321             LICENSE file included with this module.
322              
323             =cut