view release on metacpan or  search on metacpan

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

            $types[0][0] eq 'TWO_CHAR_DELIMITER') {      # 0.05
        
            $string .= "$tokens[0]";
            
            # append with a space for print/echo
            $string .= ' ' if $i < $#args; 
        }
        elsif ($types[0][0] eq 'OPERATOR') {   # 0.05
            @trailing_tokens = splice (@args, $i);
            last;
        }
        else {
        
            if ($string) {
                App::sh2p::Handlers::interpolation ($string);   
                $string = ' ';  # Add a space between args
                out ',';
            }
        
            App::sh2p::Parser::convert (@tokens, @types); 
            out ',' if $i < $#args; 
        }
        
        $ntok++;    # 0.05 (moved)
    }
       
    if ($string && $string ne ' ') {
       if ($newline) {
          $string .= "\\n"
       }

       App::sh2p::Handlers::interpolation ($string);
    }
    elsif ($newline) {
       out ",\"\\n\""
    }
    
    if (@trailing_tokens) {    # 0.05
        out " ";    # cosmetic
        $ntok += @trailing_tokens;
        my @trailing_types  = App::sh2p::Parser::identify (1, @trailing_tokens);
        App::sh2p::Parser::convert (@trailing_tokens, @trailing_types); 
    }
    else {
        out ";\n";
    }
    
    # An ugly hack, but necessary where the first arg is parenthesised
    fix_print_arg();
    
    App::sh2p::Handlers::Handle_close_redirection('w') if $redirection;

    return $ntok;
    
}   # do_print

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

sub do_read {
   my %args;
   my $prompt = 'undef';
   my $ntok;
   local @ARGV;

   # First argument is 'read'
   shift @_;
   $ntok++;
   
   # Find end of statement
   for my $arg (@_) {   
      last if is_break($arg) || $arg eq ';';   # Inserted in sh2p loop
      push @ARGV, $arg;
      $ntok++;
   }
   
   getopts ('p:rsu:nAa', \%args);
   
   if (exists $args{p} && which_shell() eq 'bash') { 
       # Bash syntax for prompt
       $prompt = $args{p}
   }
   elsif ($ARGV[0] =~ /^(\w*)\?(.*)$/) {   # ksh syntax for prompt
       
      $ARGV[0] = $1 || 'REPLY';    
      $prompt  = $2;
   }   

   # Default variable
   @ARGV = ('REPLY') if ! @ARGV;     

   # Add $ prefix to variable names   
   # Do I need to pre-define them?
   for (my $i = 0; $i < @ARGV; $i++) {

       if (exists $args{a} || exists $args{A}) {
           $ARGV[$i] = "\@$ARGV[$i]";
           if (Register_variable($ARGV[$i], '@')) {
               pre_out "my $ARGV[$i];\n";
           }
       }
       elsif ($ARGV[$i] =~ s/^<//) {
           my $filename;
           if (defined $ARGV[$i] && $ARGV[$i]) {
               $filename = $ARGV[$i];
           }
           else {
               $filename = $ARGV[$i+1];
           }
           pop @ARGV;
           pop @ARGV if $i == $#ARGV;
           
           App::sh2p::Handlers::Handle_open_redirection('<', $filename);
           
       }
       else {
           $ARGV[$i] = "\$$ARGV[$i]";
           if (Register_variable($ARGV[$i], '$')) {
               pre_out "my $ARGV[$i];\n";
           }
       }
   }
   
   if (exists $args{p} && which_shell() eq 'ksh') { 
       # ksh syntax for pipes
       error_out "read through ksh pipes is not supported";
       iout "read @_;\n";
       return $ntok;
   }
   
   my $heredoc = App::sh2p::Here::get_last_here_doc();
   
   if (defined $heredoc) {
      my $filename = App::sh2p::Here::gen_filename($heredoc);
      if (Register_variable('$IFS', '$')) {
          pre_out "my \$IFS=".get_special_var('IFS').";\n";
      }
      iout "sh2p_read_from_file ('$filename', \"\$IFS\", $prompt, ". 
             '\\'.(join ',\\', @ARGV).")";
      App::sh2p::Here::store_sh2p_here_subs();
   } 
   else {
      if (exists $args{u} && $args{u} ne 0) {
          my $fd = $args{u};
         
          iout "$ARGV[0] = <\$sh_handle$fd>";
     
          if (@ARGV > 1) {
             iout "(".(join ',', @ARGV).") = split /\$IFS/, $ARGV[0];"
          }
      }
      else {
          if (Register_variable('$IFS', '$')) {
              pre_out "my \$IFS=".get_special_var('IFS').";\n";
          }
          
          my $filename = App::sh2p::Handlers::Query_redirection('r');
          
          if (defined $filename) {
              iout 'sh2p_read_from_handle ($sh2p_handle,"$IFS",'."$prompt,".
                     '\\'.(join ',\\', @ARGV).")";
          }
          else {
              iout "sh2p_read_from_stdin (\"\$IFS\", $prompt, ".
                     '\\'.(join ',\\', @ARGV).")";
          }
          
          if (!App::sh2p::Compound::get_context()) {
              out ";\n";
              App::sh2p::Handlers::Handle_close_redirection('r');
          }

          App::sh2p::Here::store_sh2p_here_subs();
      }
   }
   
   return $ntok;
   
}  # do_read

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

sub do_return {

   my ($name, $arg) = @_;
   my $ntok = 1;

   iout $name;
   
   if (defined $arg            && 
       substr($arg,0,1) ne '#' && 
       substr($arg,0,1) ne ';'    ) {
       
      out ' ';
      my @tokens = ($arg);
      my @types  = App::sh2p::Parser::identify (1, @tokens); 
                                                
      App::sh2p::Parser::convert (@tokens, @types);
      $ntok++;
   }

   out ";\n";
   return $ntok;
}

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

sub do_shift {

   my (undef, $level) = @_;
   my $ntok = 1;
   
   if (defined $level && $level =~ /^\d+$/ && !is_break($level)) {
      $ntok++;
   }
   else {
      $level = 1;
   }

   iout (('shift;' x $level)."\n");     # 0.04
   
   return $ntok;

}