Commit | Line | Data |
3fea05b9 |
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 |