Plack-App-MCCS

 view release on metacpan or  search on metacpan

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

                splice @{$rtokens},     $isplice, 0, $tok_1;
                splice @{$rtoken_type}, $isplice, 0, $pre_type_1;
                $max_token_index++;
                $isplice++;
            }

            # Splice in any trailing word
            if ($len_2) {
                splice @{$rtoken_map},  $isplice, 0, $pos_2;
                splice @{$rtokens},     $isplice, 0, $tok_2;
                splice @{$rtoken_type}, $isplice, 0, $pre_type_2;
                $max_token_index++;
            }

            $rtokens->[$i] = $tok_0;
            return 1;
        }
        else {

            # Shouldn't get here
            if (DEVEL_MODE) {
                $self->Fault(<<EOM);
While working near line number $input_line_number, bad arg '$tok' passed to sub split_pretoken()
EOM
            }
        }
        return;
    } ## end sub split_pretoken

    sub get_indentation_level {
        return $level_in_tokenizer;
    }

    sub reset_indentation_level {
        $level_in_tokenizer = $slevel_in_tokenizer = shift;
        push @{$rslevel_stack}, $slevel_in_tokenizer;
        return;
    }

    sub peeked_ahead {
        my $flag = shift;
        $peeked_ahead = defined($flag) ? $flag : $peeked_ahead;
        return $peeked_ahead;
    }

    # ------------------------------------------------------------
    # end of tokenizer variable access and manipulation routines
    # ------------------------------------------------------------

    #------------------------------
    # beginning of tokenizer hashes
    #------------------------------

    my %matching_start_token = ( '}' => '{', ']' => '[', ')' => '(' );

    # These block types terminate statements and do not need a trailing
    # semicolon
    # patched for SWITCH/CASE/
    my %is_zero_continuation_block_type;
    my @q;
    @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{@q} = (1) x scalar(@q);

    my %is_logical_container;
    @q = qw(if elsif unless while and or err not && !  || for foreach);
    @is_logical_container{@q} = (1) x scalar(@q);

    my %is_binary_type;
    @q = qw(|| &&);
    @is_binary_type{@q} = (1) x scalar(@q);

    my %is_binary_keyword;
    @q = qw(and or err eq ne cmp);
    @is_binary_keyword{@q} = (1) x scalar(@q);

    # 'L' is token for opening { at hash key
    my %is_opening_type;
    @q = qw< L { ( [ >;
    @is_opening_type{@q} = (1) x scalar(@q);

    my %is_opening_or_ternary_type;
    push @q, '?';
    @is_opening_or_ternary_type{@q} = (1) x scalar(@q);

    # 'R' is token for closing } at hash key
    my %is_closing_type;
    @q = qw< R } ) ] >;
    @is_closing_type{@q} = (1) x scalar(@q);

    my %is_closing_or_ternary_type;
    push @q, ':';
    @is_closing_or_ternary_type{@q} = (1) x scalar(@q);

    my %is_redo_last_next_goto;
    @q = qw(redo last next goto);
    @is_redo_last_next_goto{@q} = (1) x scalar(@q);

    my %is_use_require;
    @q = qw(use require);
    @is_use_require{@q} = (1) x scalar(@q);

    # This hash holds the array index in $self for these keywords:
    # Fix for issue c035: removed 'format' from this hash
    my %is_END_DATA = (
        '__END__'  => _in_end_,
        '__DATA__' => _in_data_,
    );

    my %is_list_end_type;
    @q = qw( ; { } );
    push @q, ',';
    @is_list_end_type{@q} = (1) x scalar(@q);

    # 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

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

    if (   $last_nonblank_token eq '{'
        && $last_nonblank_type eq $last_nonblank_token )
    {

        # opening brace where a statement may appear is probably
        # a code block but might be and anonymous hash reference
        if ( $rbrace_type->[$brace_depth] ) {
            return $self->decide_if_code_block( $i, $rtokens, $rtoken_type,
                $max_token_index );
        }

        # cannot start a code block within an anonymous hash
        else {
            return EMPTY_STRING;
        }
    }

    elsif ( $last_nonblank_token eq ';' ) {

        # an opening brace where a statement may appear is probably
        # a code block but might be and anonymous hash reference
        return $self->decide_if_code_block( $i, $rtokens, $rtoken_type,
            $max_token_index );
    }

    # handle case of '}{'
    elsif ($last_nonblank_token eq '}'
        && $last_nonblank_type eq $last_nonblank_token )
    {

        # a } { situation ...
        # could be hash reference after code block..(blktype1.t)
        if ($last_nonblank_block_type) {
            return $self->decide_if_code_block( $i, $rtokens, $rtoken_type,
                $max_token_index );
        }

        # must be a block if it follows a closing hash reference
        else {
            return $last_nonblank_token;
        }
    }

    #--------------------------------------------------------------
    # NOTE: braces after type characters start code blocks, but for
    # simplicity these are not identified as such.  See also
    # sub is_non_structural_brace.
    #--------------------------------------------------------------

##    elsif ( $last_nonblank_type eq 't' ) {
##       return $last_nonblank_token;
##    }

    # brace after label:
    elsif ( $last_nonblank_type eq 'J' ) {
        return $last_nonblank_token;
    }

# otherwise, look at previous token.  This must be a code block if
# it follows any of these:
# /^(BEGIN|END|CHECK|INIT|AUTOLOAD|DESTROY|UNITCHECK|continue|if|elsif|else|unless|do|while|until|eval|for|foreach|map|grep|sort)$/
    elsif ($is_code_block_token{$last_nonblank_token}
        || $is_grep_alias{$last_nonblank_token} )
    {

        # Bug Patch: Note that the opening brace after the 'if' in the following
        # snippet is an anonymous hash ref and not a code block!
        #   print 'hi' if { x => 1, }->{x};
        # We can identify this situation because the last nonblank type
        # will be a keyword (instead of a closing paren)
        if (
            $last_nonblank_type eq 'k'
            && (   $last_nonblank_token eq 'if'
                || $last_nonblank_token eq 'unless' )
          )
        {
            return EMPTY_STRING;
        }
        else {
            return $last_nonblank_token;
        }
    }

    # or a sub or package BLOCK
    elsif ( ( $last_nonblank_type eq 'i' || $last_nonblank_type eq 't' )
        && $last_nonblank_token =~ /^(sub|package)\b/ )
    {
        return $last_nonblank_token;
    }

    # or a sub alias
    elsif (( $last_nonblank_type eq 'i' || $last_nonblank_type eq 't' )
        && ( $is_sub{$last_nonblank_token} ) )
    {
        return 'sub';
    }

    elsif ( $statement_type =~ /^(sub|package)\b/ ) {
        return $statement_type;
    }

    # user-defined subs with block parameters (like grep/map/eval)
    elsif ( $last_nonblank_type eq 'G' ) {
        return $last_nonblank_token;
    }

    # check bareword
    elsif ( $last_nonblank_type eq 'w' ) {

        # check for syntax 'use MODULE LIST'
        # This fixes b1022 b1025 b1027 b1028 b1029 b1030 b1031
        return EMPTY_STRING if ( $statement_type eq 'use' );

        return $self->decide_if_code_block( $i, $rtokens, $rtoken_type,
            $max_token_index );
    }

    # Patch for bug # RT #94338 reported by Daniel Trizen
    # for-loop in a parenthesized block-map triggering an error message:
    #    map( { foreach my $item ( '0', '1' ) { print $item} } qw(a b c) );
    # Check for a code block within a parenthesized function call

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

    @opening_brace_names = qw# '{' '[' '(' '?' #;
    @closing_brace_names = qw# '}' ']' ')' ':' #;

    my @q;

    my @digraphs = qw(
      .. :: << >> ** && || // -> => += -= .= %= &= |= ^= *= <>
      <= >= == =~ !~ != ++ -- /= x= ~~ ~. |. &. ^.
    );
    @is_digraph{@digraphs} = (1) x scalar(@digraphs);

    @q = qw(
      . : < > * & | / - = + -  %  ^ !  x ~
    );
    @can_start_digraph{@q} = (1) x scalar(@q);

    my @trigraphs = qw( ... **= <<= >>= &&= ||= //= <=> !~~ &.= |.= ^.= <<~);
    @is_trigraph{@trigraphs} = (1) x scalar(@trigraphs);

    my @tetragraphs = qw( <<>> );
    @is_tetragraph{@tetragraphs} = (1) x scalar(@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)
    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
      { } ( ) [ ] ; + - / * | % ! x ~ = \ ? : . < > ^ &
      #;
    push( @valid_token_types, @digraphs );
    push( @valid_token_types, @trigraphs );
    push( @valid_token_types, @tetragraphs );
    push( @valid_token_types, ( '#', ',', 'CORE::' ) );
    @is_valid_token_type{@valid_token_types} = (1) x scalar(@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{@file_test_operators} =
      (1) x scalar(@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{@q} = (1) x scalar(@q);

    # these functions allow an identifier in the indirect object slot
    @q = qw( print printf sort exec system say);
    @is_indirect_object_taker{@q} = (1) x scalar(@q);

    # Note: 'field' will be added by sub check_options if --use-feature=class
    @q = qw(my our state);
    @is_my_our_state{@q} = (1) x scalar(@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{@q} = (1) x scalar(@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'
    @q = qw( sort map grep eval do );
    @is_sort_map_grep_eval_do{@q} = (1) x scalar(@q);

    @q = qw( sort map grep );
    @is_sort_map_grep{@q} = (1) x scalar(@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