local-lib5/lib/perl5/PPI/Dumper.pm

   1 package PPI::Dumper;
   2
   3 =pod
   4
   5 =head1 NAME
   6
   7 PPI::Dumper - Dumping of PDOM trees
   8
   9 =head1 SYNOPSIS
  10
  11   # Load a document
  12   my $Module = PPI::Document->new( 'MyModule.pm' );
  13
  14   # Create the dumper
  15   my $Dumper = PPI::Dumper->new( $Module );
  16
  17   # Dump the document
  18   $Dumper->print;
  19
  20 =head1 DESCRIPTION
  21
  22 The PDOM trees in PPI 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 use strict;
  36 use Params::Util qw{_INSTANCE};
  37
  38 use vars qw{$VERSION};
  39 BEGIN {
  40         $VERSION = '1.206';
  41 }
  42
  43
  44
  45
  46
  47 #####################################################################
  48 # Constructor
  49
  50 =pod
  51
  52 =head2 new $Element, param => value, ...
  53
  54 The C<new> constructor creates a dumper, and takes as argument a single
  55 L<PPI::Element> object of any type to serve as the root of the tree to
  56 be dumped, and a number of key-E<gt>value parameters to control the output
  57 format of the Dumper. Details of the parameters are listed below.
  58
  59 Returns a new C<PPI::Dumper> object, or C<undef> if the constructor
  60 is not passed a correct L<PPI::Element> root object.
  61
  62 =over
  63
  64 =item memaddr
  65
  66 Should the dumper print the memory addresses of each PDOM 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<PPI::Element/"location"> 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         my $class   = shift;
 109         my $Element = _INSTANCE(shift, 'PPI::Element') or return undef;
 110
 111         # Create the object
 112         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         my %options = map { lc $_ } @_;
 127         foreach ( keys %{$self->{display}} ) {
 128                 if ( exists $options{$_} ) {
 129                         if ( $_ eq 'indent' ) {
 130                                 $self->{display}->{indent} = $options{$_};
 131                         } else {
 132                                 $self->{display}->{$_} = !! $options{$_};
 133                         }
 134                 }
 135         }
 136
 137         $self->{indent_string} = join '', (' ' x $self->{display}->{indent});
 138
 139         # Try to auto-call index_locations. If it failes, turn of locations display
 140         if ( $self->{display}->{locations} ) {
 141                 my $Document = $Element->isa('PPI::Document') ? $Element : $Element->top;
 142                 if ( $Document->isa('PPI::Document') ) {
 143                         $Document->index_locations;
 144                 } else {
 145                         $self->{display}->{locations} = 0;
 146                 }
 147         }
 148
 149         $self;
 150 }
 151
 152
 153
 154
 155
 156 #####################################################################
 157 # Main Interface Methods
 158
 159 =pod
 160
 161 =head2 print
 162
 163 The C<print> 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         CORE::print(shift->string);
 171 }
 172
 173 =pod
 174
 175 =head2 string
 176
 177 The C<string> 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         my $array_ref = shift->_dump or return undef;
 186         join '', map { "$_\n" } @$array_ref;
 187 }
 188
 189 =pod
 190
 191 =head2 list
 192
 193 The C<list> 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         my $array_ref = shift->_dump or return ();
 203         @$array_ref;
 204 }
 205
 206
 207
 208
 209
 210 #####################################################################
 211 # Generation Support Methods
 212
 213 sub _dump {
 214         my $self    = ref $_[0] ? shift : shift->new(shift);
 215         my $Element = _INSTANCE($_[0], 'PPI::Element') ? shift : $self->{root};
 216         my $indent  = shift || '';
 217         my $output  = shift || [];
 218
 219         # Print the element if needed
 220         my $show = 1;
 221         if ( $Element->isa('PPI::Token::Whitespace') ) {
 222                 $show = 0 unless $self->{display}->{whitespace};
 223         } elsif ( $Element->isa('PPI::Token::Comment') ) {
 224                 $show = 0 unless $self->{display}->{comments};
 225         }
 226         push @$output, $self->_element_string( $Element, $indent ) if $show;
 227
 228         # Recurse into our children
 229         if ( $Element->isa('PPI::Node') ) {
 230                 my $child_indent = $indent . $self->{indent_string};
 231                 foreach my $child ( @{$Element->{children}} ) {
 232                         $self->_dump( $child, $child_indent, $output );
 233                 }
 234         }
 235
 236         $output;
 237 }
 238
 239 sub _element_string {
 240         my $self    = ref $_[0] ? shift : shift->new(shift);
 241         my $Element = _INSTANCE($_[0], 'PPI::Element') ? shift : $self->{root};
 242         my $indent  = shift || '';
 243         my $string  = '';
 244
 245         # Add the memory location
 246         if ( $self->{display}->{memaddr} ) {
 247                 $string .= $Element->refaddr . '  ';
 248         }
 249
 250         # Add the location if such exists
 251         if ( $self->{display}->{locations} ) {
 252                 my $loc_string;
 253                 if ( $Element->isa('PPI::Token') ) {
 254                         my $location = $Element->location;
 255                         if ($location) {
 256                                 $loc_string = sprintf("[ % 4d, % 3d, % 3d ] ", @$location);
 257                         }
 258                 }
 259                 # Output location or pad with 20 spaces
 260                 $string .= $loc_string || " " x 20;
 261         }
 262
 263         # Add the indent
 264         if ( $self->{display}->{indent} ) {
 265                 $string .= $indent;
 266         }
 267
 268         # Add the class name
 269         if ( $self->{display}->{class} ) {
 270                 $string .= ref $Element;
 271         }
 272
 273         if ( $Element->isa('PPI::Token') ) {
 274                 # Add the content
 275                 if ( $self->{display}->{content} ) {
 276                         my $content = $Element->content;
 277                         $content =~ s/\n/\\n/g;
 278                         $content =~ s/\t/\\t/g;
 279                         $string .= "  \t'$content'";
 280                 }
 281         } elsif ( $Element->isa('PPI::Structure') ) {
 282                 # Add the content
 283                 if ( $self->{display}->{content} ) {
 284                         my $start = $Element->start
 285                                 ? $Element->start->content
 286                                 : '???';
 287                         my $finish = $Element->finish
 288                                 ? $Element->finish->content
 289                                 : '???';
 290                         $string .= "  \t$start ... $finish";
 291                 }
 292         }
 293
 294         $string;
 295 }
 296
 297 1;
 298
 299 =pod
 300
 301 =head1 SUPPORT
 302
 303 See the L<support section|PPI/SUPPORT> in the main module.
 304
 305 =head1 AUTHOR
 306
 307 Adam Kennedy E<lt>adamk@cpan.orgE<gt>
 308
 309 =head1 COPYRIGHT
 310
 311 Copyright 2001 - 2009 Adam Kennedy.
 312
 313 This program is free software; you can redistribute
 314 it and/or modify it under the same terms as Perl itself.
 315
 316 The full text of the license can be found in the
 317 LICENSE file included with this module.
 318
 319 =cut