view release on metacpan or  search on metacpan

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

    my $text = '';
    
    if ( $perms !~ /^\d+$/ ) {
       for my $file (@args) {
           chmod_text_permissions ($perms, $file);
           $ntok++;
       }
       return $ntok;
    }

    iout "$cmd ";
    
    if (defined $perms) {
        #$ntok++;      0.06
        
        if ($cmd eq 'chmod') {
            out "0$perms,";
        }
        elsif ($cmd eq 'umask') {
            out "0$perms";
        }
        else {
            out "$perms,";
        }
        
        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;
}

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

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

      
       # unset only supports two options (POSIX)
       # -v has the same effect as not being there
       
       if ($option eq '-f') {
           unset_user_function ($var);
           $ntok++;
           return $ntok;
       }
       
   }
   
   iout 'undef ';

   if (defined $var && substr($var,0,1) ne '#') {
   
      my $type = '$';
      
      if (get_special_var($var,0)) {
          set_special_var(undef);
      }
      else {
          $type = get_variable_type($var);
          Delete_variable ($var);
      }
      
      $var = $type.$var;
      
      my @tokens = ($var);
      my @types  = App::sh2p::Parser::identify (1, @tokens); 
                        
      App::sh2p::Parser::convert (@tokens, @types);
      $ntok++;
      
   }
   out ";\n";
   
   return $ntok;
}

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

1;

__END__
=head1 Summary
package App::sh2p::Builtins;
sub not_implemented 
# For builtins/functionality that cannot be implemented 
sub one4one
sub general_arg_list 
sub advise
sub do_autoload
sub do_break 
sub do_colon 
sub do_continue
sub do_cd
sub chmod_text_permissions
sub do_chmod 
# also used by umask
sub do_chown 
sub do_exec 
sub do_exit 
sub do_export 
sub do_expr 
sub do_functions 
sub do_integer
sub do_kill 
sub do_let 
sub do_print
sub do_read
sub do_return
sub do_shift
sub do_shopt
sub do_source
sub do_touch
sub do_tr
sub do_typeset
sub do_set
sub initialise_array
# set -A
sub overwrite_array
# set +A
sub do_true
sub do_false
sub do_unset

=cut