local-lib5/lib/perl5/PPI/Statement/Compound.pm

   1 package PPI::Statement::Compound;
   2
   3 =pod
   4
   5 =head1 NAME
   6
   7 PPI::Statement::Compound - Describes all compound statements
   8
   9 =head1 SYNOPSIS
  10
  11   # A compound if statement
  12   if ( foo ) {
  13       bar();
  14   } else {
  15       baz();
  16   }
  17
  18   # A compound loop statement
  19   foreach ( @list ) {
  20       bar($_);
  21   }
  22
  23 =head1 INHERITANCE
  24
  25   PPI::Statement::Compound
  26   isa PPI::Statement
  27       isa PPI::Node
  28           isa PPI::Element
  29
  30 =head1 DESCRIPTION
  31
  32 C<PPI::Statement::Compound> objects are used to describe all current forms
  33 of compound statements, as described in L<perlsyn>.
  34
  35 This covers blocks using C<if>, C<unless>, C<for>, C<foreach>, C<while>,
  36 and C<continue>. Please note this does B<not> cover "simple" statements
  37 with trailing conditions. Please note also that "do" is also not part of
  38 a compound statement.
  39
  40   # This is NOT a compound statement
  41   my $foo = 1 if $condition;
  42
  43   # This is also not a compound statement
  44   do { ... } until $condition;
  45
  46 =head1 METHODS
  47
  48 C<PPI::Statement::Compound> has a number of methods in addition to the
  49 standard L<PPI::Statement>, L<PPI::Node> and L<PPI::Element> methods.
  50
  51 =cut
  52
  53 use strict;
  54 use List::MoreUtils ();
  55 use PPI::Statement  ();
  56
  57 use vars qw{$VERSION @ISA %TYPES};
  58 BEGIN {
  59         $VERSION = '1.206';
  60         @ISA     = 'PPI::Statement';
  61
  62         # Keyword type map
  63         %TYPES = (
  64                 'if'      => 'if',
  65                 'unless'  => 'if',
  66                 'while'   => 'while',
  67                 'until'   => 'while',
  68                 'for'     => 'for',
  69                 'foreach' => 'foreach',
  70         );
  71 }
  72
  73 # Lexer clues
  74 sub __LEXER__normal { '' }
  75
  76
  77
  78
  79
  80 #####################################################################
  81 # PPI::Statement::Compound analysis methods
  82
  83 =pod
  84
  85 =head2 type
  86
  87 The C<type> method returns the syntactic type of the compound statement.
  88
  89 There are four basic compound statement types.
  90
  91 The C<'if'> type includes all variations of the if and unless statements,
  92 including any C<'elsif'> or C<'else'> parts of the compound statement.
  93
  94 The C<'while'> type describes the standard while statement, but again does
  95 B<not> describes simple statements with a trailing while.
  96
  97 The C<'for'> type covers the C-style for loops, regardless of whether they
  98 were declared using C<'for'> or C<'foreach'>.
  99
 100 The C<'foreach'> type covers loops that iterate over collections,
 101 regardless of whether they were declared using C<'for'> or C<'foreach'>.
 102
 103 All of the compounds are a variation on one of these four.
 104
 105 Returns the simple string C<'if'>, C<'for'>, C<'foreach'> or C<'while'>,
 106 or C<undef> if the type cannot be determined.
 107
 108 =begin testing type 52
 109
 110 my $Document = PPI::Document->new(\<<'END_PERL');
 111        while (1) { }
 112        until (1) { }
 113 LABEL: while (1) { }
 114 LABEL: until (1) { }
 115
 116 if (1) { }
 117 unless (1) { }
 118
 119        for              (@foo) { }
 120        foreach          (@foo) { }
 121        for     $x       (@foo) { }
 122        foreach $x       (@foo) { }
 123        for     my $x    (@foo) { }
 124        foreach my $x    (@foo) { }
 125        for     state $x (@foo) { }
 126        foreach state $x (@foo) { }
 127 LABEL: for              (@foo) { }
 128 LABEL: foreach          (@foo) { }
 129 LABEL: for     $x       (@foo) { }
 130 LABEL: foreach $x       (@foo) { }
 131 LABEL: for     my $x    (@foo) { }
 132 LABEL: foreach my $x    (@foo) { }
 133 LABEL: for     state $x (@foo) { }
 134 LABEL: foreach state $x (@foo) { }
 135
 136        for              qw{foo} { }
 137        foreach          qw{foo} { }
 138        for     $x       qw{foo} { }
 139        foreach $x       qw{foo} { }
 140        for     my $x    qw{foo} { }
 141        foreach my $x    qw{foo} { }
 142        for     state $x qw{foo} { }
 143        foreach state $x qw{foo} { }
 144 LABEL: for              qw{foo} { }
 145 LABEL: foreach          qw{foo} { }
 146 LABEL: for     $x       qw{foo} { }
 147 LABEL: foreach $x       qw{foo} { }
 148 LABEL: for     my $x    qw{foo} { }
 149 LABEL: foreach my $x    qw{foo} { }
 150 LABEL: for     state $x qw{foo} { }
 151 LABEL: foreach state $x qw{foo} { }
 152
 153        for     (             ;       ;     ) { }
 154        foreach (             ;       ;     ) { }
 155        for     ($x = 0       ; $x < 1; $x++) { }
 156        foreach ($x = 0       ; $x < 1; $x++) { }
 157        for     (my $x = 0    ; $x < 1; $x++) { }
 158        foreach (my $x = 0    ; $x < 1; $x++) { }
 159 LABEL: for     (             ;       ;     ) { }
 160 LABEL: foreach (             ;       ;     ) { }
 161 LABEL: for     ($x = 0       ; $x < 1; $x++) { }
 162 LABEL: foreach ($x = 0       ; $x < 1; $x++) { }
 163 LABEL: for     (my $x = 0    ; $x < 1; $x++) { }
 164 LABEL: foreach (my $x = 0    ; $x < 1; $x++) { }
 165 END_PERL
 166 isa_ok( $Document, 'PPI::Document' );
 167
 168 my $statements = $Document->find('Statement::Compound');
 169 is( scalar @{$statements}, 50, 'Found the 50 test statements' );
 170
 171 is( $statements->[0]->type, 'while', q<Type of while is "while"> );
 172 is( $statements->[1]->type, 'while', q<Type of until is "while"> );
 173 is( $statements->[2]->type, 'while', q<Type of while with label is "while"> );
 174 is( $statements->[3]->type, 'while', q<Type of until with label is "while"> );
 175 is( $statements->[4]->type, 'if',    q<Type of if is "if"> );
 176 is( $statements->[5]->type, 'if',    q<Type of unless is "if"> );
 177
 178 foreach my $index (6..37) {
 179         my $statement = $statements->[$index];
 180         is( $statement->type, 'foreach', qq<Type is "foreach": $statement> );
 181 }
 182
 183 foreach my $index (38..49) {
 184         my $statement = $statements->[$index];
 185         is( $statement->type, 'for', qq<Type is "for": $statement> );
 186 }
 187
 188 =end testing
 189
 190 =cut
 191
 192 sub type {
 193         my $self    = shift;
 194         my $p       = 0; # Child position
 195         my $Element = $self->schild($p) or return undef;
 196
 197         # A labelled statement
 198         if ( $Element->isa('PPI::Token::Label') ) {
 199                 $Element = $self->schild(++$p) or return 'label';
 200         }
 201
 202         # Most simple cases
 203         my $content = $Element->content;
 204         if ( $content =~ /^for(?:each)?\z/ ) {
 205                 $Element = $self->schild(++$p) or return $content;
 206                 if ( $Element->isa('PPI::Token') ) {
 207                         return 'foreach' if $Element->content =~ /^my|our|state\z/;
 208                         return 'foreach' if $Element->isa('PPI::Token::Symbol');
 209                         return 'foreach' if $Element->isa('PPI::Token::QuoteLike::Words');
 210                 }
 211                 if ( $Element->isa('PPI::Structure::List') ) {
 212                         return 'foreach';
 213                 }
 214                 return 'for';
 215         }
 216         return $TYPES{$content} if $Element->isa('PPI::Token::Word');
 217         return 'continue'       if $Element->isa('PPI::Structure::Block');
 218
 219         # Unknown (shouldn't exist?)
 220         undef;
 221 }
 222
 223
 224
 225
 226
 227 #####################################################################
 228 # PPI::Node Methods
 229
 230 sub scope { 1 }
 231
 232
 233
 234
 235
 236 #####################################################################
 237 # PPI::Element Methods
 238
 239 sub _complete {
 240         my $self = shift;
 241         my $type = $self->type or die "Illegal compound statement type";
 242
 243         # Check the different types of compound statements
 244         if ( $type eq 'if' ) {
 245                 # Unless the last significant child is a complete
 246                 # block, it must be incomplete.
 247                 my $child = $self->schild(-1) or return '';
 248                 $child->isa('PPI::Structure') or return '';
 249                 $child->braces eq '{}'        or return '';
 250                 $child->_complete             or return '';
 251
 252                 # It can STILL be
 253         } elsif ( $type eq 'while' ) {
 254                 die "CODE INCOMPLETE";
 255         } else {
 256                 die "CODE INCOMPLETE";
 257         }
 258 }
 259
 260 1;
 261
 262 =pod
 263
 264 =head1 TO DO
 265
 266 - Write unit tests for this package
 267
 268 =head1 SUPPORT
 269
 270 See the L<support section|PPI/SUPPORT> in the main module.
 271
 272 =head1 AUTHOR
 273
 274 Adam Kennedy E<lt>adamk@cpan.orgE<gt>
 275
 276 =head1 COPYRIGHT
 277
 278 Copyright 2001 - 2009 Adam Kennedy.
 279
 280 This program is free software; you can redistribute
 281 it and/or modify it under the same terms as Perl itself.
 282
 283 The full text of the license can be found in the
 284 LICENSE file included with this module.
 285
 286 =cut