App-sh2p

 view release on metacpan or  search on metacpan

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

        if (@args && $cmd ne 'umask') {
        
            for (my $i=0; $i < @args; $i++) {
                
	        $ntok++;
	        if (substr ($args[$i],0,1) eq '#') {
	            my @comment = splice (@args,$i);
	            $comment = "@comment";
	            
	            # remove trailing comment from previous item
	            $args[$i-1] =~ s/,$// if $i > 0;
	            last
	        }
	        
	        # Remove any surrounding quotes 0.06
	        $args[$i] =~ s/^\"(.*)\"$/$1/;      
	        
	        # Escape embedded quotes 
	        #$args[$i] =~ s/\"/\\\"/g;   # commented out 0.06
	        #"help syntax highlighter
	        
	        $args[$i] = "\"$args[$i]\"";
	        $args[$i] .= ',' if $i < $#args;
	    } 
	          
            App::sh2p::Handlers::interpolation ("@args");
        }
    }
    out "; $comment\n";
    
    return $ntok;
}

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

sub do_chown {
    
    my ($cmd) = shift;
    my ($opt) = shift;
    my $ugrp;
    my $ntok = 1;

    if (substr($opt,0,1) eq '-') {
       error_out ("$cmd options not yet supported");
       $ugrp = shift;
       $ntok++;
    }
    else {
       $ugrp = $opt;
       $opt = '';
    }
    
    my @args = @_;

    my $comment = '';
    my $text = '';
    
    if (defined $ugrp) {
        $ntok++;   
        if ($cmd eq 'chown') {
            iout "{my(\$uid,\$gid)=(getpwnam(\"$ugrp\"))[2,3];";
        }
        else { # chgrp
            iout "{my (\$name,undef,\$gid)=getgrname(\"$ugrp\");\n";
            out  " my \$uid=(getpwnam(\$name))[2];\n ";
        }
        out "chown \$uid, \$gid,";   # There is no chgrp
    }
    else {
        error_out ("No user/group supplied for $cmd");
        iout $cmd;
    }
        
    if (@args) {
        
       for (my $i=0; $i < @args; $i++) {
                
           $ntok++;
	        
           if (substr ($args[$i],0,1) eq '#') {
               my @comment = splice (@args,$i);
               $comment = "@comment";
	            
               # remove trailing comment from previous item
               $args[$i-1] =~ s/,$// if $i > 0;
               last
           }
	        
           # Escape embedded quotes
           $args[$i] =~ s/\"/\\\"/g;
           #"help syntax highlighter
           $args[$i] = "\"$args[$i]\"";
           $args[$i] .= ',' if $i < $#args;
       } 
	          
       App::sh2p::Handlers::interpolation ("@args");

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

########################################################
 
sub do_exec {

   my (undef, @rest) = @_;
   my $ntok = 1;
   
   if ($rest[0] =~ /^\d$/) {
       error_out ("Warning: file descriptors are not supported");
       my ($fd, $access, $filename) = @rest;
       iout "open(my \$sh2p_handle$fd, '$access', \"$filename\") or ".
            "die \"Unable to open $filename: \$!\";\n";
       $ntok += 3;
       $g_file_handles{$fd} = $filename;
   }
   else {
       $ntok = general_arg_list('exec', @rest);
   }
   
   return $ntok;
}

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



( run in 1.650 second using v1.01-cache-2.11-cpan-ceb78f64989 )