view release on metacpan or  search on metacpan

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

        $signal = shift @rest;
    }
    else {
        $signal = 'TERM';  # default signal
        
        # 0.06 Hack because this is an inserted token and 
        # general_arg_list will include this in its count
        $ntok--;           
    }

    #print STDERR "do_kill: <@rest>\n";

    $ntok += general_arg_list ($cmd, $signal, @rest);
    
    return $ntok;
}

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

sub do_let {

    my ($cmd, @rest) = @_;
    my $ntok = 1;
    
    # Find any comment - this should go first
    if (substr($rest[-1],0,1) eq '#') {
        $ntok++;
        iout $rest[-1];      # Write the comment out
        pop @rest
    }
    
    for my $token (@rest) {
        # strip quotes
	$token =~ s/[\'\"]//g;

        # Get variable name
        $token =~ /^(.*?)=/;
        my $var = "\$$1";
        if (Register_variable($var, int)) {
            iout "my $var;\n";      # 0.05 added leading $
        }
        
        App::sh2p::Compound::arith ($token);
        $ntok++;
    }
    
    return $ntok;
}

########################################################
# Also does for echo
sub do_print {

   my $ntok = 1;
   my ($name, @args) = @_;
   my $newline = 1;
   my $handle = '';

   my $opt_u;
   my %options;
   local @ARGV;

   my $redirection = '';
   my $file        = '';
   my $from_fd     = '';       # TODO - not currently supported
   
   # Move the comment to before the statement
   if ( substr($args[-1],0,1) eq '#' ) {
       my $comment = pop @args;
       out "\n";
       iout $comment;
       $ntok++;
   }
   
   for my $arg (@args) {
       last if is_break($arg) || $arg eq ';';
       my $in_redirection_token = 0;
       
       # This is so a > inside a string is not seen as redirection
       if ($arg =~ /^([\"\']).*?\1/) {
           set_in_quotes();
       }
       
       # This should also strip out the redirection
       if (!query_in_quotes() && $arg =~ s/(\>{1,2})//) {
           
           $ntok++;
           $redirection = $1;
           $in_redirection_token = 1;
           
           if ($ARGV[-1] =~ /\d/) {
	       $from_fd = pop @ARGV;
               error_out ("dup file descriptors ($from_fd>&n) not currently supported");
               $ntok++;
           }
       }
       
       if ($arg && $redirection && (! $file)) {
           $arg =~ s/(\S+)//;
           $file = $1;
           $ntok++ unless $in_redirection_token;
       }
       
       unset_in_quotes();
       push @ARGV, $arg if $arg;
       #$ntok++;    0.05 commented out
   }
   
   if ($redirection) {
       
       #print STDERR "do_print redirection file <$file>\n";
       # January 2009
       if ( $file =~ /^\&(\d+)$/ ) {
           my $fd = $1;
           if ($fd == 1) {
               $handle = 'STDOUT ';
           }
           elsif ($fd == 2) {
               $handle = 'STDERR ';
           }
           else {