view release on metacpan or  search on metacpan

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

package App::sh2p::Compound;

use strict;
use App::sh2p::Parser;
use App::sh2p::Utils;
use App::sh2p::Handlers;
use App::sh2p::Trap;

sub App::sh2p::Parser::convert(\@\@);
our $VERSION = '0.06';

my $g_not = 0;
my $g_context = '';
my @g_case_statements;

#####################################################
              #  shell   perl
my %convert = ( '=='  => 'eq',
                '='   => 'eq',
                '!='  => 'ne',
                '<'   => 'lt',
                '>'   => 'gt',
                '<='  => 'le',
                '>='  => 'ge',
                '-eq' => '==',
                '-ne' => '!=',
                '-lt' => '<',
                '-gt' => '>',
                '-ge' => '>=',
                '-le' => '<=',
                '-nt'=> undef,
                '-ot'=> undef,
                '-ef'=> undef,
                '-n' => '',       # No value required
                '-z' => '!',
                '-a' => '-e',     # see %sh_convert
                '-h' => '-l',
                '-o' => undef,    # shell option, but see %sh_convert
                '-O' => '-o',     # confused?
                '-G' => undef,    # owned by egid
                '-L' => '-l',
                '-N' => undef);   # modified since last read);

# Many options are the same as the Perl functions, but not all
# Bourne shell syntax overlaps
my %sh_convert = ('-o' => 'or',
                  '-a' => 'and');
                     
#####################################################
# ((
sub arith {

   my ($statement, @rest) = @_;  
   
   # First 2 chars passed should be (( or $((, unless from let
   $statement =~ s/^\$?\(\(//;
   # Last 2 chars passed should be )), unless from let
   $statement =~ s/\)\)$//;
   
   my $out = '( ';
   my @tokens = App::sh2p::Parser::tokenise ($statement);

   my $pattern = '<<|>>|==|>=|<=|\/=|%=|\+=|-=|\*=|=|>|<|!=|\+\+|\+|--|-|\*|\/|%';

   for my $token (@tokens) {  
      # Further tokenise
      
      $token =~ s/($pattern)/$1 /;
      
      for my $subtok (split (/ /, $token)) {
      
          if ($subtok =~ /^[_A-Za-z]/) {
              # Must be a variable!
              $subtok = "\$$subtok";
          }
          elsif ($subtok =~ /\$[A-Z0-9\?#\{\}\[\]]+/i) {
              my $special = get_special_var($subtok,0); 
              $subtok = $special if (defined $special);
          }
          
          $out .= "$subtok "
      }
      
   }
  
   if (query_semi_colon()) {
       out "$out);\n";
   }
   else {
       out "$out)";
   }
   return 1;
}

#####################################################
# identify_ksh_boolean ($tokens[$i], $types[$i])

sub identify_ksh_boolean (\$\$){

    my ($rtok, $rtype) = @_;