@@ -38,7 +38,7 @@ now, look at L<Perl::Critic::Utils>.
38
38
use strict;
39
39
use PPI::Token ();
40
40
41
- use vars qw{ $VERSION @ISA %OPERATOR %QUOTELIKE} ;
41
+ use vars qw{ $VERSION @ISA %OPERATOR %QUOTELIKE %KEYWORDS } ;
42
42
BEGIN {
43
43
$VERSION = ' 1.218' ;
44
44
@ISA = ' PPI::Token' ;
@@ -57,6 +57,35 @@ BEGIN {
57
57
' tr' => ' Regexp::Transliterate' ,
58
58
' y' => ' Regexp::Transliterate' ,
59
59
);
60
+
61
+ # List of keywords is from regen/keywords.pl in the perl source.
62
+ %KEYWORDS = map { $_ => 1 } qw{
63
+ abs accept alarm and atan2 bind binmode bless break caller chdir chmod
64
+ chomp chop chown chr chroot close closedir cmp connect continue cos
65
+ crypt dbmclose dbmopen default defined delete die do dump each else
66
+ elsif endgrent endhostent endnetent endprotoent endpwent endservent
67
+ eof eq eval evalbytes exec exists exit exp fc fcntl fileno flock for
68
+ foreach fork format formline ge getc getgrent getgrgid getgrnam
69
+ gethostbyaddr gethostbyname gethostent getlogin getnetbyaddr
70
+ getnetbyname getnetent getpeername getpgrp getppid getpriority
71
+ getprotobyname getprotobynumber getprotoent getpwent getpwnam
72
+ getpwuid getservbyname getservbyport getservent getsockname
73
+ getsockopt given glob gmtime goto grep gt hex if index int ioctl join
74
+ keys kill last lc lcfirst le length link listen local localtime lock
75
+ log lstat lt m map mkdir msgctl msgget msgrcv msgsnd my ne next no
76
+ not oct open opendir or ord our pack package pipe pop pos print
77
+ printf prototype push q qq qr quotemeta qw qx rand read readdir
78
+ readline readlink readpipe recv redo ref rename require reset return
79
+ reverse rewinddir rindex rmdir s say scalar seek seekdir select semctl
80
+ semget semop send setgrent sethostent setnetent setpgrp
81
+ setpriority setprotoent setpwent setservent setsockopt shift shmctl
82
+ shmget shmread shmwrite shutdown sin sleep socket socketpair sort
83
+ splice split sprintf sqrt srand stat state study sub substr symlink
84
+ syscall sysopen sysread sysseek system syswrite tell telldir tie tied
85
+ time times tr truncate uc ucfirst umask undef unless unlink unpack
86
+ unshift untie until use utime values vec wait waitpid wantarray warn
87
+ when while write x xor y
88
+ } ;
60
89
}
61
90
62
91
=pod
@@ -133,12 +162,6 @@ sub method_call {
133
162
}
134
163
135
164
136
- my %backoff = map { $_ => 1 } qw{
137
- eq ne ge le gt lt
138
- q qq qx qw qr m s tr y
139
- pack unpack
140
- } ;
141
-
142
165
sub __TOKENIZER__on_char {
143
166
my $class = shift ;
144
167
my $t = shift ;
@@ -149,8 +172,8 @@ sub __TOKENIZER__on_char {
149
172
my $word = $1 ;
150
173
# Special Case: If we accidentally treat eq'foo' like
151
174
# the word "eq'foo", then just make 'eq' (or whatever
152
- # else is in the %backoff hash.
153
- if ( $word =~ / ^(\w +)'/ && $backoff {$1 } ) {
175
+ # else is in the %KEYWORDS hash.
176
+ if ( $word =~ / ^(\w +)'/ && $KEYWORDS {$1 } ) {
154
177
$word = $1 ;
155
178
}
156
179
$t -> {token }-> {content } .= $word ;
@@ -220,7 +243,7 @@ sub __TOKENIZER__commit {
220
243
# Special Case: If we accidentally treat eq'foo' like the word "eq'foo",
221
244
# then unwind it and just make it 'eq' (or the other stringy comparitors)
222
245
my $word = $1 ;
223
- if ( $word =~ / ^(\w +)'/ && $backoff {$1 } ) {
246
+ if ( $word =~ / ^(\w +)'/ && $KEYWORDS {$1 } ) {
224
247
$word = $1 ;
225
248
}
226
249
0 commit comments