local-lib5/lib/perl5/PPI/Token/Structure.pm

   1 package PPI::Token::Structure;
   2
   3 =pod
   4
   5 =head1 NAME
   6
   7 PPI::Token::Structure - Token class for characters that define code structure
   8
   9 =head1 INHERITANCE
  10
  11   PPI::Token::Structure
  12   isa PPI::Token
  13       isa PPI::Element
  14
  15 =head1 DESCRIPTION
  16
  17 The C<PPI::Token::Structure> class is used for tokens that control the
  18 generally tree structure or code.
  19
  20 This consists of seven characters. These are the six brace characters from
  21 the "round", "curly" and "square" pairs, plus the semi-colon statement
  22 separator C<;>.
  23
  24 =head1 METHODS
  25
  26 This class has no methods beyond what is provided by its
  27 L<PPI::Token> and L<PPI::Element> parent classes.
  28
  29 =cut
  30
  31 use strict;
  32 use PPI::Token ();
  33
  34 use vars qw{$VERSION @ISA};
  35 BEGIN {
  36         $VERSION = '1.206';
  37         @ISA     = 'PPI::Token';
  38 }
  39
  40 # Set the matching braces, done as an array
  41 # for slightly faster lookups.
  42 use vars qw{@MATCH @OPENS @CLOSES};
  43 BEGIN {
  44         $MATCH[ord '{']  = '}';
  45         $MATCH[ord '}']  = '{';
  46         $MATCH[ord '[']  = ']';
  47         $MATCH[ord ']']  = '[';
  48         $MATCH[ord '(']  = ')';
  49         $MATCH[ord ')']  = '(';
  50
  51         $OPENS[ord '{']  = 1;
  52         $OPENS[ord '[']  = 1;
  53         $OPENS[ord '(']  = 1;
  54
  55         $CLOSES[ord '}'] = 1;
  56         $CLOSES[ord ']'] = 1;
  57         $CLOSES[ord ')'] = 1;
  58 }
  59
  60
  61
  62
  63
  64 #####################################################################
  65 # Tokenizer Methods
  66
  67 sub __TOKENIZER__on_char {
  68         # Structures are one character long, always.
  69         # Finalize and process again.
  70         $_[1]->_finalize_token->__TOKENIZER__on_char( $_[1] );
  71 }
  72
  73 sub __TOKENIZER__commit {
  74         my $t = $_[1];
  75         $t->_new_token( 'Structure', substr( $t->{line}, $t->{line_cursor}, 1 ) );
  76         $t->_finalize_token;
  77         0;
  78 }
  79
  80
  81
  82
  83
  84 #####################################################################
  85 # Lexer Methods
  86
  87 # For a given brace, find its opposing pair
  88 sub __LEXER__opposite {
  89         $MATCH[ord $_[0]->{content} ];
  90 }
  91
  92
  93
  94
  95
  96 #####################################################################
  97 # PPI::Element Methods
  98
  99 # There is a unusual situation in regards to "siblings".
 100 #
 101 # As an Element, braces sit outside the normal tree structure, and in
 102 # this context they NEVER have siblings.
 103 #
 104 # However, as tokens they DO have siblings.
 105 #
 106 # As such, we need special versions of _all_ of the sibling methods to
 107 # handle this.
 108 #
 109 # Statement terminators do not have these problems, and for them sibling
 110 # calls work as normal, and so they can just be passed upwards.
 111
 112 sub next_sibling {
 113         return $_[0]->SUPER::next_sibling if $_[0]->{content} eq ';';
 114         return '';
 115 }
 116
 117 sub snext_sibling {
 118         return $_[0]->SUPER::snext_sibling if $_[0]->{content} eq ';';
 119         return '';
 120 }
 121
 122 sub previous_sibling {
 123         return $_[0]->SUPER::previous_sibling if $_[0]->{content} eq ';';
 124         return '';
 125 }
 126
 127 sub sprevious_sibling {
 128         return $_[0]->SUPER::sprevious_sibling if $_[0]->{content} eq ';';
 129         return '';
 130 }
 131
 132 sub next_token {
 133         my $self = shift;
 134         return $self->SUPER::next_token if $self->{content} eq ';';
 135         my $structure = $self->parent or return '';
 136
 137         # If this is an opening brace, descend down into our parent
 138         # structure, if it has children.
 139         if ( $OPENS[ ord $self->{content} ] ) {
 140                 my $child = $structure->child(0);
 141                 if ( $child ) {
 142                         # Decend deeper, or return if it is a token
 143                         return $child->isa('PPI::Token') ? $child : $child->first_token;
 144                 } elsif ( $structure->finish ) {
 145                         # Empty structure, so next is closing brace
 146                         return $structure->finish;
 147                 }
 148
 149                 # Anything that slips through to here is a structure
 150                 # with an opening brace, but no closing brace, so we
 151                 # just have to go with it, and continue as we would
 152                 # if we started with a closing brace.
 153         }
 154
 155         # We can use the default implement, if we call it from the
 156         # parent structure of the closing brace.
 157         $structure->next_token;
 158 }
 159
 160 sub previous_token {
 161         my $self = shift;
 162         return $self->SUPER::previous_token if $self->{content} eq ';';
 163         my $structure = $self->parent or return '';
 164
 165         # If this is a closing brace, descend down into our parent
 166         # structure, if it has children.
 167         if ( $CLOSES[ ord $self->{content} ] ) {
 168                 my $child = $structure->child(-1);
 169                 if ( $child ) {
 170                         # Decend deeper, or return if it is a token
 171                         return $child->isa('PPI::Token') ? $child : $child->last_token;
 172                 } elsif ( $structure->start ) {
 173                         # Empty structure, so next is closing brace
 174                         return $structure->start;
 175                 }
 176
 177                 # Anything that slips through to here is a structure
 178                 # with a closing brace, but no opening brace, so we
 179                 # just have to go with it, and continue as we would
 180                 # if we started with a opening brace.
 181         }
 182
 183         # We can use the default implement, if we call it from the
 184         # parent structure of the closing brace.
 185         $structure->previous_token;
 186 }
 187
 188 1;
 189
 190 =pod
 191
 192 =head1 SUPPORT
 193
 194 See the L<support section|PPI/SUPPORT> in the main module.
 195
 196 =head1 AUTHOR
 197
 198 Adam Kennedy E<lt>adamk@cpan.orgE<gt>
 199
 200 =head1 COPYRIGHT
 201
 202 Copyright 2001 - 2009 Adam Kennedy.
 203
 204 This program is free software; you can redistribute
 205 it and/or modify it under the same terms as Perl itself.
 206
 207 The full text of the license can be found in the
 208 LICENSE file included with this module.
 209
 210 =cut