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

   1 package PPI::Token::Magic;
   2
   3 =pod
   4
   5 =head1 NAME
   6
   7 PPI::Token::Magic - Tokens representing magic variables
   8
   9 =head1 INHERITANCE
  10
  11   PPI::Token::Magic
  12   isa PPI::Token::Symbol
  13       isa PPI::Token
  14           isa PPI::Element
  15
  16 =head1 SYNOPSIS
  17
  18   # When we say magic variables, we mean these...
  19   $1   $2   $3   $4   $5   $6   $7   $8   $9
  20   $_   $&   $`   $'   $+   @+   %+   $*   $.    $/    $|
  21   $\\  $"   $;   $%   $=   $-   @-   %-   $)    $#
  22   $~   $^   $:   $?   $!   %!   $@   $$   $<    $>
  23   $(   $0   $[   $]   @_   @*   $}   $,   $#+   $#-
  24   $^L  $^A  $^E  $^C  $^D  $^F  $^H
  25   $^I  $^M  $^N  $^O  $^P  $^R  $^S
  26   $^T  $^V  $^W  $^X
  27
  28 =head1 DESCRIPTION
  29
  30 C<PPI::Token::Magic> is a sub-class of L<PPI::Token::Symbol> which
  31 identifies the token as "magic variable", one of the strange and
  32 unusual variables that are connected to "things" behind the scenes.
  33
  34 Some are extremely common, like C<$_>, and others you will quite
  35 probably never encounter in your Perl career.
  36
  37 =head1 METHODS
  38
  39 The class provides no additional methods, beyond those provided by it's
  40 L<PPI::Token::Symbol>, L<PPI::Token> and L<PPI::Element>.
  41
  42 =cut
  43
  44 use strict;
  45 use PPI::Token::Symbol ();
  46
  47 use vars qw{$VERSION @ISA %magic};
  48 BEGIN {
  49         $VERSION = '1.206';
  50         @ISA     = 'PPI::Token::Symbol';
  51
  52         # Magic variables taken from perlvar.
  53         # Several things added separately to avoid warnings.
  54         foreach ( qw{
  55                 $1 $2 $3 $4 $5 $6 $7 $8 $9
  56                 $_ $& $` $' $+ @+ %+ $* $. $/ $|
  57                 $\\ $" $; $% $= $- @- %- $)
  58                 $~ $^ $: $? $! %! $@ $$ $< $>
  59                 $( $0 $[ $] @_ @*
  60
  61                 $^L $^A $^E $^C $^D $^F $^H
  62                 $^I $^M $^N $^O $^P $^R $^S
  63                 $^T $^V $^W $^X %^H
  64
  65                 $::|
  66         }, '$}', '$,', '$#', '$#+', '$#-' ) {
  67                 $magic{$_} = 1;
  68         }
  69 }
  70
  71 sub __TOKENIZER__on_char {
  72         my $t = $_[1];
  73
  74         # $c is the candidate new content
  75         my $c = $t->{token}->{content} . substr( $t->{line}, $t->{line_cursor}, 1 );
  76
  77         # Do a quick first test so we don't have to do more than this one.
  78         # All of the tests below match this one, so it should provide a
  79         # small speed up. This regex should be updated to match the inside
  80         # tests if they are changed.
  81         if ( $c =~ /^  \$  .*  [  \w  :  \$  \{  ]  $/x ) {
  82
  83                 if ( $c =~ /^(\$(?:\_[\w:]|::))/ or $c =~ /^\$\'[\w]/ ) {
  84                         # If and only if we have $'\d, it is not a
  85                         # symbol. (this was apparently a concious choice)
  86                         # Note that $::0 on the other hand is legal
  87                         if ( $c =~ /^\$\'\d$/ ) {
  88                                 # In this case, we have a magic plus a digit.
  89                                 # Save the CURRENT token, and rerun the on_char
  90                                 return $t->_finalize_token->__TOKENIZER__on_char( $t );
  91                         }
  92
  93                         # A symbol in the style $_foo or $::foo or $'foo.
  94                         # Overwrite the current token
  95                         $t->{class} = $t->{token}->set_class('Symbol');
  96                         return PPI::Token::Symbol->__TOKENIZER__on_char( $t );
  97                 }
  98
  99                 if ( $c =~ /^\$\$\w/ ) {
 100                         # This is really a scalar dereference. ( $$foo )
 101                         # Add the current token as the cast...
 102                         $t->{token} = PPI::Token::Cast->new( '$' );
 103                         $t->_finalize_token;
 104
 105                         # ... and create a new token for the symbol
 106                         return $t->_new_token( 'Symbol', '$' );
 107                 }
 108
 109                 if ( $c eq '$#$' or $c eq '$#{' ) {
 110                         # This is really an index dereferencing cast, although
 111                         # it has the same two chars as the magic variable $#.
 112                         $t->{class} = $t->{token}->set_class('Cast');
 113                         return $t->_finalize_token->__TOKENIZER__on_char( $t );
 114                 }
 115
 116                 if ( $c =~ /^(\$\#)\w/ ) {
 117                         # This is really an array index thingy ( $#array )
 118                         $t->{token} = PPI::Token::ArrayIndex->new( "$1" );
 119                         return PPI::Token::ArrayIndex->__TOKENIZER__on_char( $t );
 120                 }
 121
 122                 if ( $c =~ /^\$\^\w+$/o ) {
 123                         # It's an escaped char magic... maybe ( like $^M )
 124                         my $next = substr( $t->{line}, $t->{line_cursor}+1, 1 ); # Peek ahead
 125                         if ($magic{$c} && (!$next || $next !~ /\w/)) {
 126                                 $t->{token}->{content} = $c;
 127                                 $t->{line_cursor}++;
 128                         } else {
 129                                 # Maybe it's a long magic variable like $^WIDE_SYSTEM_CALLS
 130                                 return 1;
 131                         }
 132                 }
 133
 134                 if ( $c =~ /^\$\#\{/ ) {
 135                         # The $# is actually a case, and { is its block
 136                         # Add the current token as the cast...
 137                         $t->{token} = PPI::Token::Cast->new( '$#' );
 138                         $t->_finalize_token;
 139
 140                         # ... and create a new token for the block
 141                         return $t->_new_token( 'Structure', '{' );
 142                 }
 143         } elsif ($c =~ /^%\^/) {
 144                 return 1 if $c eq '%^';
 145                 # It's an escaped char magic... maybe ( like %^H )
 146                 if ($magic{$c}) {
 147                         $t->{token}->{content} = $c;
 148                         $t->{line_cursor}++;
 149                 } else {
 150                         # Back off, treat '%' as an operator
 151                         chop $t->{token}->{content};
 152                         bless $t->{token}, $t->{class} = 'PPI::Token::Operator';
 153                         $t->{line_cursor}--;
 154                 }
 155         }
 156
 157         # End the current magic token, and recheck
 158         $t->_finalize_token->__TOKENIZER__on_char( $t );
 159 }
 160
 161 # Our version of canonical is plain simple
 162 sub canonical { $_[0]->content }
 163
 164 1;
 165
 166 =pod
 167
 168 =head1 SUPPORT
 169
 170 See the L<support section|PPI/SUPPORT> in the main module.
 171
 172 =head1 AUTHOR
 173
 174 Adam Kennedy E<lt>adamk@cpan.orgE<gt>
 175
 176 =head1 COPYRIGHT
 177
 178 Copyright 2001 - 2009 Adam Kennedy.
 179
 180 This program is free software; you can redistribute
 181 it and/or modify it under the same terms as Perl itself.
 182
 183 The full text of the license can be found in the
 184 LICENSE file included with this module.
 185
 186 =cut