view release on metacpan or  search on metacpan

lib/Perl/Tidy/Tokenizer.pm  view on Meta::CPAN

    $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
    @q = qw( my our state local use require );
    $is_TERM_keyword{$_} = 1 for @q;

    # 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
    # a separate set of keywords to include if we see 'use Switch::Plain'
    push( @Keywords, @value_requestor );

lib/Perl/Tidy/Tokenizer.pm  view on Meta::CPAN

    @q = qw( q qq qx qr s y tr m );
    $is_q_qq_qx_qr_s_y_tr_m{$_} = 1 for @q;

    # Note added 'qw' here
    @q = qw( q qq qw qx qr s y tr m );
    $is_q_qq_qw_qx_qr_s_y_tr_m{$_} = 1 for @q;

    # Quote modifiers:
    # original ref: camel 3 p 147,
    # but perl may accept undocumented flags
    # perl 5.10 adds 'p' (preserve)
    # Perl version 5.22 added 'n'
    # From http://perldoc.perl.org/perlop.html we have
    # /PATTERN/msixpodualngc or m?PATTERN?msixpodualngc
    # s/PATTERN/REPLACEMENT/msixpodualngcer
    # y/SEARCHLIST/REPLACEMENTLIST/cdsr
    # tr/SEARCHLIST/REPLACEMENTLIST/cdsr
    # qr/STRING/msixpodualn
    %quote_modifiers = (
        's'  => '[msixpodualngcer]',
        'y'  => '[cdsr]',
        'tr' => '[cdsr]',
        'm'  => '[msixpodualngc]',
        'qr' => '[msixpodualn]',
        'q'  => EMPTY_STRING,
        'qq' => EMPTY_STRING,
        'qw' => EMPTY_STRING,
        'qx' => EMPTY_STRING,
    );

    # Note: 'class' will be added by sub check_options if -use-feature=class
    @q = qw( package );
    $is_package{$_} = 1 for @q;

    @q = qw( if elsif unless );
    $is_if_elsif_unless{$_} = 1 for @q;

    @q = qw( ; t );
    $is_semicolon_or_t{$_} = 1 for @q;

    @q = qw( if elsif unless case when );
    $is_if_elsif_unless_case_when{$_} = 1 for @q;

    # Hash of other possible line endings which may occur.
    # Keep these coordinated with the regex where this is used.
    # Note: chr(13) = chr(015)="\r".
    @q = ( chr(13), chr(29), chr(26) );
    $other_line_endings{$_} = 1 for @q;

    # These keywords are handled specially in the tokenizer code:
    my @special_keywords =
      qw( do eval format m package q qq qr qw qx s sub tr y );
    push( @Keywords, @special_keywords );

    # Keywords after which list formatting may be used
    # WARNING: do not include |map|grep|eval or perl may die on
    # syntax errors (map1.t).
    my @keyword_taking_list = qw(
      and        chmod      chomp      chop
      chown      dbmopen    die        elsif
      exec       fcntl      for        foreach
      formline   getsockopt given      if
      index      ioctl      join       kill
      local      msgctl     msgrcv     msgsnd
      my         open       or         our
      pack       print      printf     push
      read       readpipe   recv       return
      reverse    rindex     seek       select
      semctl     semget     send       setpriority
      setsockopt shmctl     shmget     shmread
      shmwrite   socket     socketpair sort
      splice     split      sprintf    state
      substr     syscall    sysopen    sysread
      sysseek    system     syswrite   tie
      unless     unlink     unpack     unshift
      until      vec        warn       when
      while
    );

    # NOTE: This hash is available but not currently used
    $is_keyword_taking_list{$_} = 1 for @keyword_taking_list;

    # perl functions which may be unary operators.

    # This list is used to decide if a pattern delimited by slashes, /pattern/,
    # can follow one of these keywords.
    @q = qw( chomp eof eval fc lc pop shift uc undef );

    $is_keyword_rejecting_slash_as_pattern_delimiter{$_} = 1 for @q;

    # These are keywords for which an arg may optionally be omitted.  They are
    # currently only used to disambiguate a ? used as a ternary from one used
    # as a (deprecated) pattern delimiter.  In the future, they might be used
    # to give a warning about ambiguous syntax before a /.
    # Note: split has been omitted (see note below).
    my @keywords_taking_optional_arg = qw(
      abs      alarm    caller    chdir     chomp   chop
      chr      chroot   close     cos       defined die
      eof      eval     evalbytes exit      exp     fc
      getc     glob     gmtime    hex       int     last
      lc       lcfirst  length    localtime log     lstat
      mkdir    next     oct       ord       pop     pos
      print    printf   prototype quotemeta rand    readline
      readlink readpipe redo      ref       require reset
      reverse  rmdir    say       select    shift   sin
      sleep    sqrt     srand     stat      study   tell
      uc       ucfirst  umask     undef     unlink  warn
      write
    );
    $is_keyword_taking_optional_arg{$_} = 1 for @keywords_taking_optional_arg;

    # This list is used to decide if a pattern delimited by question marks,
    # ?pattern?, can follow one of these keywords.  Note that from perl 5.22
    # on, a ?pattern? is not recognized, so we can be much more strict than
    # with a /pattern/. Note that 'split' is not in this list. In current
    # versions of perl a question following split must be a ternary, but
    # in older versions it could be a pattern.  The guessing algorithm will
    # decide.  We are combining two lists here to simplify the test.
    @q = ( @keywords_taking_optional_arg, @operator_requestor );
    $is_keyword_rejecting_question_as_pattern_delimiter{$_} = 1 for @q;