Perl-Tidy
view release on metacpan or search on metacpan
lib/Perl/Tidy/Tokenizer.pm view on Meta::CPAN
# These names are used in error messages
@opening_brace_names = qw# '{' '[' '(' '?' #;
@closing_brace_names = qw# '}' ']' ')' ':' #;
my @q;
my @digraphs = qw#
.. :: << >> ** && || // -> => += -= .= %= &= |= ^= *= <>
<= >= == =~ !~ != ++ -- /= x= ~~ ~. |. &. ^. ^^
#;
$is_digraph{$_} = 1 for @digraphs;
@q = qw(
. : < > * & | / - = + - % ^ ! x ~
);
$can_start_digraph{$_} = 1 for @q;
my @trigraphs =
qw( ... **= <<= >>= &&= ||= //= <=> !~~ &.= |.= ^.= <<~ ^^= );
$is_trigraph{$_} = 1 for @trigraphs;
my @tetragraphs = qw( <<>> );
$is_tetragraph{$_} = 1 for @tetragraphs;
# make a hash of all valid token types for self-checking the tokenizer
# (adding NEW_TOKENS : select a new character and add to this list)
# fix for c250: added new token type 'P' and 'S'
my @valid_token_types = qw#
A b C G L R f h Q k t w i q n p m F pp mm U j J Y Z v P S
{ } ( ) [ ] ; + - / * | % ! x ~ = ? : . < > ^ &
#;
push @valid_token_types, BACKSLASH;
push @valid_token_types, @digraphs;
push @valid_token_types, @trigraphs;
push @valid_token_types, @tetragraphs;
push @valid_token_types, ( '#', COMMA, 'CORE::' );
$is_valid_token_type{$_} = 1 for @valid_token_types;
# a list of file test letters, as in -e (Table 3-4 of 'camel 3')
my @file_test_operators =
qw( A B C M O R S T W X b c d e f g k l o p r s t u w x z );
$is_file_test_operator{$_} = 1 for @file_test_operators;
# these functions have prototypes of the form (&), so when they are
# followed by a block, that block MAY BE followed by an operator.
# Smartmatch operator ~~ may be followed by anonymous hash or array ref
@q = qw( do eval );
$is_block_operator{$_} = 1 for @q;
# These functions allow an identifier in the indirect object slot:
@q = qw( print printf sort exec system say );
$is_indirect_object_taker{$_} = 1 for @q;
# Keywords which definitely produce error if an OPERATOR is expected
# The following small list was used until version 20260705:
# @q = qw( my our state local use require );
# This list was expanded to the list below to catch more errors (c613).
@q = qw(
AUTOLOAD BEGIN CHECK DESTROY
END INIT UNITCHECK abs
accept alarm atan2 bind
binmode bless break caller
catch chdir chmod chomp
chop chown chr chroot
close closedir connect continue
cos crypt dbmclose dbmopen
default defined delete die
do dump each else
elsif endgrent endhostent endnetent
endprotoent endpwent endservent eof
eval evalbytes exec exists
exit exp fc fcntl
fileno flock fork format
formline getc getgrent getgrgid
getgrnam gethostbyaddr gethostbyname gethostent
getlogin getnetbyaddr getnetbyname getnetent
getpeername getpgrp getppid getpriority
getprotobyname getprotobynumber getprotoent getpwent
getpwnam getpwuid getservbyname getservbyport
getservent getsockname getsockopt given
glob gmtime goto grep
hex index int ioctl
join keys kill last
lc lcfirst length link
listen local localtime lock
log lstat m map
mkdir msgctl msgget msgrcv
msgsnd my next no
not oct open opendir
ord our pack package
pipe pop pos print
printf prototype push q
qq qr quotemeta qw
qx rand read readdir
readline readlink readpipe recv
redo ref rename require
reset return reverse rewinddir
rindex rmdir s say
scalar seek seekdir select
semctl semget semop send
setgrent sethostent setnetent setpgrp
setpriority setprotoent setpwent setservent
setsockopt shift shmctl shmget
shmread shmwrite shutdown sin
sleep socket socketpair sort
splice split sprintf sqrt
srand stat state study
sub substr switch symlink
syscall sysopen sysread sysseek
system syswrite tell telldir
tie tied time times
tr truncate uc ucfirst
umask undef unlink unpack
unshift untie use utime
values vec wait waitpid
wantarray warn write y
);
$is_TERM_keyword{$_} = 1 for @q;
# Stable keyword infix operators which produce error if a TERM is expected
@q = qw( and or xor eq ne ge gt le lt );
$is_OPERATOR_keyword{$_} = 1 for @q;
# Keywords which are omitted from the above TERM or OPERATOR lists.
# Note that 'cmp' is here since it can be re-defined by File::Compare.
# qw( isa err cmp if unless for foreach when while until case
# EQ GE GT LE LT NE );
# Note: 'field' will be added by sub check_options if --use-feature=class
@q = qw( my our state );
$is_my_our_state{$_} = 1 for @q;
# These tokens may precede a code block
# patched for SWITCH/CASE/CATCH. Actually these could be removed
# now and we could let the extended-syntax coding handle them.
# Added 'default' for Switch::Plain.
# Note: 'ADJUST' will be added by sub check_options if --use-feature=class
@q = qw(
BEGIN END CHECK INIT AUTOLOAD DESTROY
UNITCHECK continue if elsif else unless
do while until eval for foreach
map grep sort switch case given
when default catch try finally
);
$is_code_block_token{$_} = 1 for @q;
# These block types terminate statements and do not need a trailing
# semicolon; patched for SWITCH/CASE/; This may be updated in sub
# check_options.
@q = qw( } { BEGIN END CHECK INIT AUTOLOAD DESTROY UNITCHECK continue ;
if elsif else unless while until for foreach switch case given when );
$is_zero_continuation_block_type{$_} = 1 for @q;
# Note: this hash was formerly named '%is_not_zero_continuation_block_type'
# to contrast it with the block types in '%is_zero_continuation_block_type'
# Note: added 'sub' for anonymous sub blocks (c443)
@q = qw( sort map grep eval do sub );
$is_sort_map_grep_eval_do_sub{$_} = 1 for @q;
@q = qw( sort map grep );
$is_sort_map_grep{$_} = 1 for @q;
%is_grep_alias = ();
# I'll build the list of keywords incrementally
my @Keywords = ();
# keywords and tokens after which a value or pattern is expected,
# but not an operator. In other words, these should consume terms
# to their right, or at least they are not expected to be followed
# immediately by operators.
my @value_requestor = qw(
AUTOLOAD BEGIN CHECK DESTROY
END EQ GE GT
INIT LE LT NE
UNITCHECK abs accept alarm
and atan2 bind binmode
bless break caller chdir
chmod chomp chop chown
chr chroot close closedir
cmp connect continue cos
crypt dbmclose dbmopen defined
delete die dump each
else elsif eof eq
evalbytes exec exists exit
exp fc fcntl fileno
flock for foreach formline
ge getc getgrgid getgrnam
gethostbyaddr gethostbyname getnetbyaddr getnetbyname
getpeername getpgrp getpriority getprotobyname
getprotobynumber getpwnam getpwuid getservbyname
getservbyport getsockname getsockopt glob
gmtime goto grep gt
hex if index int
ioctl join keys kill
last lc lcfirst le
length link listen local
localtime lock log lstat
lt map mkdir msgctl
msgget msgrcv msgsnd my
ne next no not
oct open opendir or
ord our pack pipe
pop pos print printf
prototype push quotemeta rand
read readdir readlink readline
readpipe recv redo ref
rename require reset return
reverse rewinddir rindex rmdir
scalar seek seekdir select
semctl semget semop send
sethostent setnetent setpgrp setpriority
setprotoent setservent setsockopt shift
shmctl shmget shmread shmwrite
shutdown sin sleep socket
socketpair sort splice split
sprintf sqrt srand stat
state study substr symlink
syscall sysopen sysread sysseek
system syswrite tell telldir
tie tied truncate uc
ucfirst umask undef unless
unlink unpack unshift untie
until use utime values
vec waitpid warn while
write xor case catch
default err given isa
say switch when
);
# Note: 'ADJUST', 'field' are added by sub check_options
# if --use-feature=class
# patched above for SWITCH/CASE given/when err say
# 'err' is a fairly safe addition.
# Added 'default' for Switch::Plain. Note that we could also have
( run in 0.738 second using v1.01-cache-2.11-cpan-364913b4093 )