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

   1 package PPI::Normal;
   2
   3 =pod
   4
   5 =head1 NAME
   6
   7 PPI::Normal - Normalize Perl Documents
   8
   9 =head2 DESCRIPTION
  10
  11 Perl Documents, as created by PPI, are typically filled with all sorts of
  12 mess such as whitespace and comments and other things that don't effect
  13 the actual meaning of the code.
  14
  15 In addition, because there is more than one way to do most things, and the
  16 syntax of Perl itself is quite flexible, there are many ways in which the
  17 "same" code can look quite different.
  18
  19 PPI::Normal attempts to resolve this by providing a variety of mechanisms
  20 and algorithms to "normalize" Perl Documents, and determine a sort of base
  21 form for them (although this base form will be a memory structure, and
  22 not something that can be turned back into Perl source code).
  23
  24 The process itself is quite complex, and so for convenience and
  25 extensibility it has been separated into a number of layers. At a later
  26 point, it will be possible to write Plugin classes to insert additional
  27 normalization steps into the various different layers.
  28
  29 In addition, you can choose to do the normalization only as deep as a
  30 particular layer, depending on aggressively you want the normalization
  31 process to be.
  32
  33 =head1 METHODS
  34
  35 =cut
  36
  37 use strict;
  38 use Carp                      ();
  39 use List::MoreUtils           ();
  40 use PPI::Util                 '_Document';
  41 use PPI::Document::Normalized ();
  42
  43 use vars qw{$VERSION %LAYER};
  44 BEGIN {
  45         $VERSION = '1.206';
  46
  47         # Registered function store
  48         %LAYER = (
  49                 1 => [],
  50                 2 => [],
  51         );
  52 }
  53
  54
  55
  56
  57
  58 #####################################################################
  59 # Configuration
  60
  61 =pod
  62
  63 =head2 register $function => $layer, ...
  64
  65 The C<register> method is used by normalization method providers to
  66 tell the normalization engines which functions need to be run, and
  67 in which layer they apply.
  68
  69 Provide a set of key/value pairs, where the key is the full name of the
  70 function (in string form), and the value is the layer (see description
  71 of the layers above) in which it should be run.
  72
  73 Returns true if all functions are registered, or C<undef> on error.
  74
  75 =cut
  76
  77 sub register {
  78         my $class = shift;
  79         while ( @_ ) {
  80                 # Check the function
  81                 my $function = shift;
  82                 SCOPE: {
  83                         no strict 'refs';
  84                         defined $function and defined &{"$function"}
  85                                 or Carp::croak("Bad function name provided to PPI::Normal");
  86                 }
  87
  88                 # Has it already been added?
  89                 if ( List::MoreUtils::any { $_ eq $function } ) {
  90                         return 1;
  91                 }
  92
  93                 # Check the layer to add it to
  94                 my $layer = shift;
  95                 defined $layer and $layer =~ /^(?:1|2)$/
  96                         or Carp::croak("Bad layer provided to PPI::Normal");
  97
  98                 # Add to the layer data store
  99                 push @{ $LAYER{$layer} }, $function;
 100         }
 101
 102         1;
 103 }
 104
 105 # With the registration mechanism in place, load in the main set of
 106 # normalization methods to initialize the store.
 107 use PPI::Normal::Standard;
 108
 109
 110
 111
 112
 113 #####################################################################
 114 # Constructor and Accessors
 115
 116 =pod
 117
 118 =head2 new
 119
 120   my $level_1 = PPI::Normal->new;
 121   my $level_2 = PPI::Normal->new(2);
 122
 123 Creates a new normalization object, to which Document objects
 124 can be passed to be normalized.
 125
 126 Of course, what you probably REALLY want is just to call
 127 L<PPI::Document>'s C<normalize> method.
 128
 129 Takes an optional single parameter of the normalisation layer
 130 to use, which at this time can be either "1" or "2".
 131
 132 Returns a new C<PPI::Normal> object, or C<undef> on error.
 133
 134 =begin testing new after PPI::Document 12
 135
 136 # Check we actually set the layer at creation
 137 my $layer_1 = PPI::Normal->new;
 138 isa_ok( $layer_1, 'PPI::Normal' );
 139 is( $layer_1->layer, 1, '->new creates a layer 1' );
 140 my $layer_1a = PPI::Normal->new(1);
 141 isa_ok( $layer_1a, 'PPI::Normal' );
 142 is( $layer_1a->layer, 1, '->new(1) creates a layer 1' );
 143 my $layer_2 = PPI::Normal->new(2);
 144 isa_ok( $layer_2, 'PPI::Normal' );
 145 is( $layer_2->layer, 2, '->new(2) creates a layer 2' );
 146
 147 # Test bad things
 148 is( PPI::Normal->new(3), undef, '->new only allows up to layer 2' );
 149 is( PPI::Normal->new(undef), undef, '->new(evil) returns undef' );
 150 is( PPI::Normal->new("foo"), undef, '->new(evil) returns undef' );
 151 is( PPI::Normal->new(\"foo"), undef, '->new(evil) returns undef' );
 152 is( PPI::Normal->new([]), undef, '->new(evil) returns undef' );
 153 is( PPI::Normal->new({}), undef, '->new(evil) returns undef' );
 154
 155 =end testing
 156
 157 =cut
 158
 159 sub new {
 160         my $class = shift;
 161         my $layer = @_ ?
 162                 (defined $_[0] and ! ref $_[0] and $_[0] =~ /^[12]$/) ? shift : return undef
 163                 : 1;
 164
 165         # Create the object
 166         my $object = bless {
 167                 layer => $layer,
 168                 }, $class;
 169
 170         $object;
 171 }
 172
 173 =pod
 174
 175 =head1 layer
 176
 177 The C<layer> accessor returns the normalisation layer of the object.
 178
 179 =cut
 180
 181 sub layer { $_[0]->{layer} }
 182
 183
 184
 185
 186
 187 #####################################################################
 188 # Main Methods
 189
 190 =pod
 191
 192 =head2 process
 193
 194 The C<process> method takes anything that can be converted to a
 195 L<PPI::Document> (object, SCALAR ref, filename), loads it and
 196 applies the normalisation process to the document.
 197
 198 Returns a L<PPI::Document::Normalized> object, or C<undef> on error.
 199
 200 =begin testing process after new 15
 201
 202 my $doc1 = PPI::Document->new(\'print "Hello World!\n";');
 203 isa_ok( $doc1, 'PPI::Document' );
 204 my $doc2 = \'print "Hello World!\n";';
 205 my $doc3 = \' print  "Hello World!\n"; # comment';
 206 my $doc4 = \'print "Hello World!\n"';
 207
 208 # Normalize them at level 1
 209 my $layer1 = PPI::Normal->new(1);
 210 isa_ok( $layer1, 'PPI::Normal' );
 211 my $nor11 = $layer1->process($doc1->clone);
 212 my $nor12 = $layer1->process($doc2);
 213 my $nor13 = $layer1->process($doc3);
 214 isa_ok( $nor11, 'PPI::Document::Normalized' );
 215 isa_ok( $nor12, 'PPI::Document::Normalized' );
 216 isa_ok( $nor13, 'PPI::Document::Normalized' );
 217
 218 # The first 3 should be the same, the second not
 219 is_deeply( { %$nor11 }, { %$nor12 }, 'Layer 1: 1 and 2 match' );
 220 is_deeply( { %$nor11 }, { %$nor13 }, 'Layer 1: 1 and 3 match' );
 221
 222 # Normalize them at level 2
 223 my $layer2 = PPI::Normal->new(2);
 224 isa_ok( $layer2, 'PPI::Normal' );
 225 my $nor21 = $layer2->process($doc1);
 226 my $nor22 = $layer2->process($doc2);
 227 my $nor23 = $layer2->process($doc3);
 228 my $nor24 = $layer2->process($doc4);
 229 isa_ok( $nor21, 'PPI::Document::Normalized' );
 230 isa_ok( $nor22, 'PPI::Document::Normalized' );
 231 isa_ok( $nor23, 'PPI::Document::Normalized' );
 232 isa_ok( $nor24, 'PPI::Document::Normalized' );
 233
 234 # The first 3 should be the same, the second not
 235 is_deeply( { %$nor21 }, { %$nor22 }, 'Layer 2: 1 and 2 match' );
 236 is_deeply( { %$nor21 }, { %$nor23 }, 'Layer 2: 1 and 3 match' );
 237 is_deeply( { %$nor21 }, { %$nor24 }, 'Layer 2: 1 and 4 match' );
 238
 239 =end testing
 240
 241 =cut
 242
 243 sub process {
 244         my $self = ref $_[0] ? shift : shift->new;
 245
 246         # PPI::Normal objects are reusable, but not re-entrant
 247         return undef if $self->{Document};
 248
 249         # Get or create the document
 250         $self->{Document} = _Document(shift) or return undef;
 251
 252         # Work out what functions we need to call
 253         my @functions = ();
 254         foreach ( 1 .. $self->layer ) {
 255                 push @functions, @{ $LAYER{$_} };
 256         }
 257
 258         # Execute each function
 259         foreach my $function ( @functions ) {
 260                 no strict 'refs';
 261                 &{"$function"}( $self->{Document} );
 262         }
 263
 264         # Create the normalized Document object
 265         my $Normalized = PPI::Document::Normalized->new(
 266                 Document  => $self->{Document},
 267                 version   => $VERSION,
 268                 functions => \@functions,
 269         ) or return undef;
 270
 271         # Done, clean up
 272         delete $self->{Document};
 273         return $Normalized;
 274 }
 275
 276 1;
 277
 278 =pod
 279
 280 =head1 NOTES
 281
 282 The following normalisation layers are implemented. When writing
 283 plugins, you should register each transformation function with the
 284 appropriate layer.
 285
 286 =head2 Layer 1 - Insignificant Data Removal
 287
 288 The basic step common to all normalization, layer 1 scans through the
 289 Document and removes all whitespace, comments, POD, and anything else
 290 that returns false for its C<significant> method.
 291
 292 It also checks each Element and removes known-useless sub-element
 293 metadata such as the Element's physical position in the file.
 294
 295 =head2 Layer 2 - Significant Element Removal
 296
 297 After the removal of the insignificant data, Layer 2 removed larger, more
 298 complex, and superficially "significant" elements, that can be removed
 299 for the purposes of normalisation.
 300
 301 Examples from this layer include pragmas, now-useless statement
 302 separators (since the PDOM tree is holding statement elements), and
 303 several other minor bits and pieces.
 304
 305 =head2 Layer 3 - TO BE COMPLETED
 306
 307 This version of the forward-port of the Perl::Compare functionality
 308 to the 0.900+ API of PPI only implements Layer 1 and 2 at this time.
 309
 310 =head1 TO DO
 311
 312 - Write the other 4-5 layers :)
 313
 314 =head1 SUPPORT
 315
 316 See the L<support section|PPI/SUPPORT> in the main module.
 317
 318 =head1 AUTHOR
 319
 320 Adam Kennedy E<lt>adamk@cpan.orgE<gt>
 321
 322 =head1 COPYRIGHT
 323
 324 Copyright 2005 Adam Kennedy.
 325
 326 This program is free software; you can redistribute
 327 it and/or modify it under the same terms as Perl itself.
 328
 329 The full text of the license can be found in the
 330 LICENSE file included with this module.
 331
 332 =cut