view release on metacpan or  search on metacpan

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

   if (defined $level && $level =~ /^\d+$/) {
      error_out "Multiple levels in 'continue $level' not supported";
      $ntok++;
   }

   return $ntok;
}

########################################################
# 0.04 - removed quote handling
sub do_cd {

   my (undef, @args) = @_;
   my $ntok = 1;
   my $comment = "\n";
   
   pop @args if !$args[-1];
   
   iout 'chdir (';
           
   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
       }
   
       # Wrap quotes around it:
       if ($args[$i] !~ /^\d+$/    &&     # if it is not a digit 
           $args[$i] !~ /^\".*\"$/ &&     # it doesn't already have quotes 
           $args[$i] !~ /\[|\*|\?/) {     # it isn't a glob constuct
           # Escape embedded quotes
           $args[$i] =~ s/\"/\\\"/g;
           #"help syntax highlighter
           $args[$i] = "\"$args[$i]\"";
       }
       
       $args[$i] .= '.' if $i < $#args;
   } 
   
#   $ntok += App::sh2p::Parser::join_parse_tokens ('.', @args);
   App::sh2p::Parser::join_parse_tokens ('.', @args);
   
   out ')';

   if (query_semi_colon()) {
       out "; $comment";
   }

   return $ntok;
}

########################################################
# TODO: comma separated groups
sub chmod_text_permissions {

   my ($in, $file) = @_;
   
   iout "# chmod $in $file\n";
   
   # Remove any surrounding quotes 0.06
   $file =~ s/^\"(.*)\"$/$1/; 
   
   my $stat = "{ my \$perm = (stat \"$file\")[2] & 07777;\n";
   
   # numbers are base 10: I'm constructing a string, not an octal int
   my %classes = ( u => 100, g => 10, o => 1);
   my %access  = ( x => 1, w => 2, r => 4);
   
   # Linux man page                      [ugoa]*([-+=]([rwxXst]*|[ugo]))+
   my ($class, $op, $access) = $in =~ /^([ugoa]*)([-=+])([rwx]+)?$/;
   
   my $mask  = 0;
   my $perms = 0;
   
   $class = 'ugo' if $class eq 'a' or !$class;
   $access = 0 if !$access;

   for (split('', $access)) {$mask  += $access{$_}}
   for (split('', $class))  {$perms += $mask * $classes{$_}}
    
   $perms = sprintf ("0%03d", $perms);
 
   iout "$stat  ";

   if ($op eq '=') {
       my $mask = 0; 
       for (split('', $class))  {$mask += 7 * $classes{$_}}
       $mask = sprintf ("0%03d", $mask);

       out "\$perm &= ~0$mask;";
       out "chmod(\$perm,\"$file\");chmod(\$perm|$perms"
   }
   elsif ($op eq '+') {
       out "chmod (\$perm | $perms";
   }
   else {
       out "chmod (\$perm & ~$perms";
   }

   out ", \"$file\")}\n";     
}

########################################################
# also used by umask
sub do_chmod {
    
    my ($cmd) = shift;
    my ($opt) = shift;
    my $perms;
    my $ntok = 2; 

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

    my $comment = '';
    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 = '';
    }

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

    
       $var = $rest[0];
       $ntok++;
      
       # 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