caller\( results from the CPAN

App-sh2p

         }
         elsif ($char eq ';' && !$comment) {
           $index++ if defined $tokens[$index];
           $tokens[$index] .= $char;
           $index++;
         }
         elsif ($char eq '<' && !$comment) {
              # Here doc? 
             if (defined $tokens[$index]) {
                 if ($tokens[$index] ne '<') {         
                     $index++ if defined $tokens[$index];
                     $tokens[$index] .= $char;
                 }
                 else {
                     $heredoc = 1;
                     $tokens[$index] .= $char;
                     $index++;
                 }
             }
             else {
                 $tokens[$index] .= $char;
             }
         }
         elsif ($char eq '>' && !$comment) {
           if (defined $tokens[$index] && $tokens[$index] ne '>') {          # Append? 
              $index++ if defined $tokens[$index];
              $tokens[$index] .= $char;
           }
           else {
              $tokens[$index] .= $char;
              $index++;
           }
         }
         else {
            $tokens[$index] .= $char;
         }
      }
      else {
         $tokens[$index] .= $char;
      }
   }
   
   $tokens[$index] .= "\n" if $comment;
   
   return @tokens
}

###########################################################
# First argument is used to identify external program calls
#   nested = 0 - call is not nested, first argument may be an external program
#   nested = 1 - call is not nested, first argument is not an external program
#   nested = 2 - as 1, plus call is as a list

sub identify {
   my ($nested, @in) = @_;
   my @out;
   my $first = $in[0];
   
   if (!@in) {
       print STDERR "+++ Internal error: Empty input array to identify\n";
       my @caller = caller();
       die "@caller\n";
   }
   
   #print STDERR "identify first <$first>\n";
   # Special processing for the first token
   
   if ($first =~ /^\w+\+?=/) {
      $out[0] = [('ASSIGNMENT', 
                 \&App::sh2p::Handlers::Handle_assignment)];
      shift @in
   }
   elsif ($first =~ /^\w+\[.*\]=/) {
      $out[0] = [('ARRAY_ASSIGNMENT', 
                 \&App::sh2p::Handlers::Handle_array_assignment)];
      shift @in
   }
   elsif (is_break($first)) {
      $out[0] = [('BREAK', 
                 \&App::sh2p::Handlers::Handle_break)];
      shift @in
   }
   elsif (!$nested && $first =~ /^([\"]?)\$[A-Z0-9#@*{}\[\]]+\1/i) {   # Optional " added January 2009
       # Not a variable, but a call (variable contains call name)
       $out[0] = [('EXTERNAL',
                  \&App::sh2p::Handlers::Handle_external)];
       shift @in;
   }

   # Now process the rest
   
   for my $token (@in) {
   
      #print STDERR "Identify token: <$token> <$nested>\n";
   
      my $type = 'UNKNOWN';
      my $sub  = \&App::sh2p::Handlers::Handle_unknown;

      if (ref($token) eq 'CODE') {
         $sub  = $token;
         $type = 'INTERNAL';      
      }
      elsif ($token =~ /^\w+=/) {
         $sub  = \&App::sh2p::Handlers::Handle_assignment;
         $type = 'ASSIGNMENT';
      }
      elsif ($token =~ /^\w+\[.*\]=/) {
          $sub  = \&App::sh2p::Handlers::Handle_array_assignment;
          $type = 'ARRAY_ASSIGNMENT';
      }
      elsif (exists $icompound{$token}) {
         $sub  = $icompound{$token};
         $type = 'COMPOUND';
      }
      elsif (exists $ioperator{$token} && $nested < 2) {
         $sub  = $ioperator{$token};
         $type = 'OPERATOR';
         # Shortcut, next is another command
      }
      elsif (exists $ibuiltins{$token} && $nested < 2) {
         $sub  = $ibuiltins{$token};

lib/App/sh2p/Parser.pm view on Meta::CPAN

            }
         }
         elsif (exists $idelimiter{$first_char}) {   # January 2009
            if ( $first_char eq '"' && (!@out || ($out[-1]->[0] eq 'BREAK')) && 
	    	  !$nested && !is_break($first_char)) {   # Must be first token
	        $type = 'EXTERNAL';
	    	$sub = \&App::sh2p::Handlers::Handle_external;
	    }
	    else {
                $type = 'SINGLE_DELIMITER';
                $sub  = $idelimiter{$first_char};
            }
         }
         elsif ($first_char eq '~') {
            $type = 'GLOB';
            $sub  = \&App::sh2p::Handlers::Handle_Glob;
         }
         elsif ( (!@out || ($out[-1]->[0] eq 'BREAK')) && 
                  !$nested && !is_break($first_char)) {   # Must be first token
            $type = 'EXTERNAL';
            $sub = \&App::sh2p::Handlers::Handle_external;
         }
         # January 2009 This test must come after the 'EXTERNAL' test, 
         # otherwise a bare variable is not seen as an external call
         elsif ($first_char eq '$' && $token =~ /^\$[A-Z0-9\#\@\*\?\{\}\[\]]+$/i) {        
            $type = 'VARIABLE';
            $sub  = \&App::sh2p::Handlers::Handle_variable
         }
         elsif (is_break($token)) {      # 0.06
            $type = 'BREAK';
            $sub = \&App::sh2p::Handlers::Handle_break;
         }
         elsif (exists $ioperator{$two_chars} && $nested) {
	    $sub  = $ioperator{$two_chars};
	    $type = 'OPERATOR'
	 }
         elsif (exists $ioperator{$first_char} && $nested) {
            $sub  = $ioperator{$first_char};
            $type = 'OPERATOR'
         }
         elsif ($token =~ /\[|\*|\?/ && !query_in_quotes()) {
            # No globbing inside quotes
	    $sub  = \&App::sh2p::Handlers::Handle_Glob;
	    $type = 'GLOB';
	 }

      }
      push @out, [($type, $sub)];
   }
   
   return @out;
   
}

###########################################################

sub convert (\@\@) {
   my ($rtok, $rtype) = @_;  
   
   if ( $DEBUG ) {
      my @caller = caller();
      print STDERR "\nconvert called from @caller\n";
      local $" = '|';
      print STDERR "convert:@$rtok\nconvert: ";
      print STDERR (map {"$_->[0] "} @$rtype),"\n";
   }

   if (@$rtok != @$rtype ) {
      print STDERR "+++ Internal Error rtok: <@$rtok>, rtype: <@$rtype>\n";
      die "Parser::convert: token and type arrays uneven\n"
   }
   
   pop @$rtok if (is_break($rtok->[-1]));
   my $tokens_processed = 0;
   
   #print_types_tokens ($rtype, $rtok);
   
   while (@$rtok) {
    
      my $type = $rtype->[0][0];
      my $sub  = $rtype->[0][1];
      
      #print STDERR "tokens: <@$rtok> type: $type, sub: $sub\n";
      if (ref($sub) eq 'CODE' ) {
      
         if ($type eq 'COMPOUND') {
             test_for_redirection($rtok, $rtype);
         }
      
         $tokens_processed = &$sub(@$rtok);
         
         if ($tokens_processed > @$rtok) {
             error_out "Internal error: Token count wrong! Was: $tokens_processed, max: ".scalar(@$rtok);
             error_out "Type: $rtype->[0][0], tokens: @$rtok";
         }
      }
      else {      
         error_out ("No conversion routine for $type $rtok->[0]");
         out "$rtok->[0]\n";
         $tokens_processed = 1;
      }
      
      if ($tokens_processed) {
          # Remove tokens already processed
          splice (@$rtok,  0, $tokens_processed);
          splice (@$rtype, 0, $tokens_processed);
      }
   }
   
}

########################################################
# Called by convert
sub test_for_redirection {
    
    my ($rtok, $rtype) = @_;
    
    my $next_type = $rtype->[1][0];
    
     
    return 0 if !defined $next_type || $next_type ne 'BUILTIN';

lib/App/sh2p/Parser.pm view on Meta::CPAN

        if ($rtok->[$i] eq '<' || $rtok->[$i] eq '>' || $rtok->[$i] eq '>>') {     
	    
	    if ( !defined $rtok->[$i+1] ) {
	         die "*** Malformed redirection (no file)\n";
	    }
	
	    my $redirection_file = $rtok->[$i+1];
	    $redirection_file =~ s/^\s+//; 
	    App::sh2p::Handlers::Handle_open_redirection ($rtok->[$i], 
	                                                  $redirection_file);
            # Remove tokens processed
            splice (@$rtok,  $i, 2);
            splice (@$rtype, $i, 2);
	    
	    return 2;
	}
    }
}

########################################################

sub join_parse_tokens {

    my ($sep, @args) = @_;
    my $ntok = 0;

    # C style for loop because I need to check the position
    for (my $i = 0; $i < @args; $i++) {
        
        my @tokens = ($args[$i]);
        my @types  = identify (2, @tokens);
   
        #print_types_tokens(\@types, \@tokens);
        
        convert (@tokens, @types); 
        $ntok++;
        
        # Look ahead to see if we are at end
        if ($i < $#args) { 
            last if substr($args[$i+1],0,1) eq '#';  
            last if is_break($args[$i+1]);
            last if $args[$i+1] eq ';';      # January 2009
            out $sep;
        }
        
    }

    return $ntok;
}

###########################################################

sub analyse_pipeline {
    my @args = @_;
    my $ntok = @args;
    my $end_value = '';
    
    error_out ();
    error_out "Pipeline '@args' detected";
    
    #my @caller = caller();
    #print STDERR "analyse_pipeline: <@args><@caller>\n";
    
    # Get commands, sometimes the | is separate, sometimes not
    @args = split /\|/, "@args";
    
    App::sh2p::Handlers::no_semi_colon();
    
    # Let's make a guess.  echo or print at the front usually means
    # that the command which follows wants a string
    if ($args[0] =~ s/^(echo |print )//) {
        $end_value = shift @args;         
    }
    
    for (my $i = 0; $i < @args; $i++) {
        $args[$i] =~ s/^\s+//;      # Strip leading whitespace
        $args[$i] =~ s/\s+$//;      # Strip trailing whitespace
        
        if (! $args[$i] ) {
            # Blank line - remove it
            splice (@args, $i, 1);
            $i--;   # to counteract the ++
            next;
        }
        
        my @tokens = tokenise ($args[$i]);
        my @types  = identify (0, @tokens);
        
        # We are delimited by |, so get the arguments as well
        # external call is not the last in the pipe, change to back-ticks
        if ( $types[0][0] eq 'EXTERNAL' && $i < $#args) {
        
            @types = (['DELIMITER',\&App::sh2p::Handlers::Handle_2char_qx]);
            @tokens = ("\$(@tokens)");
            
            if ($args[$i+1] =~ /^\s*grep/) {
                # Switch next command around with this
                $i++;
                $args[$i] =~ s/^\s+//; 
		$args[$i] =~ s/\s+$//;

                my @next_tokens = tokenise ($args[$i]);
                my @next_types  = identify (0, @next_tokens);
                convert (@next_tokens, @next_types);
            }
        }

	#print_types_tokens (\@types, \@tokens);
	
	convert (@tokens, @types);
	out '|' if $i < $#args;
    }
    out "$end_value";
    out "\n" if !App::sh2p::Compound::get_context();
    
    App::sh2p::Handlers::reset_semi_colon();
    error_out ();
    
    return $ntok;
}

( run in 1.478 second using v1.01-cache-2.11-cpan-99c4e6809bf )