App-sh2p

 view release on metacpan or  search on metacpan

bin/sh2p.pl  view on Meta::CPAN

sub usage {
   print STDERR "Usage: sh2p.pl [-i] [-t] [-f] input-file output-file | input-files... out-directory\n";
   exit 1;
}

###########################################################
# main
# done this way to aid testing 
# see "Perl Testing, A Developer's Notebook" by Ian Langworth & chromatic (O'Reilly)

main(@ARGV) unless caller();

sub main
{
    my %args;

    getopts ('ift', \%args);
    $g_integer = 0 if exists $args{'i'};
    $g_clobber = 1 if exists $args{'f'};
    $g_display = 1 if exists $args{'t'};

lib/App/sh2p.pod  view on Meta::CPAN

A function name embedded in a variable and then called using that variable will not
be detected as such and will be treated as an external command.

The 'functions' alias, and 'typedef -f', will generate code to give a list of the 
subroutines in the main:: namespace (symbol table) at runtime.  This will include any 
imported names from external modules, and is unconnected with those known at conversion time.

Note that the value of $0 inside functions differs between shell versions.  In sh2p
$0 is retained to be the name of the current run unit (program), which is the POSIX
behaviour.
The Bash specific variable FUNCNAME is converted to 'caller(0))[3]'.

There are two different syntax conventions commonly used with functions:

    name () { ... }         # POSIX (Bourne) syntax
    function name { ... }   # non-POSIX (Korn) syntax

Bash and Korn shells support both, however they differ in operation when it comes to variable scope.  
As an extension to the POSIX standard, Bash and Korn shells allow local
variables to be declared using typeset, declare (Bash), or local.  This is mirrored in
Perl by the 'my' perfix.  Any variables not so declared are globals.

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

   
   return 1;
}

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

sub Handle_open_redirection {
    my ($type, $filename) = @_;
    
    #print STDERR "Handle_open_redirection: <$type> <$filename>\n";
    my @caller = caller();
    #print STDERR "Handle_open_redirection: @caller\n";
    
    out ("\n");
    
    my $var = 'sh2p_handle';
    if (Register_variable($var, '$')) {
       rd_iout "my \$$var;\n";
    }
    
    rd_iout ("open(\$$var,'$type',\"$filename\") or\n");

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

   
   return 1;
}

############################################################################
sub Handle_expansion {
    my ($token) = @_;
    my $ntok;
    
    #print STDERR "Handle_expansion: <$token>\n";
    #  my @caller = caller();
    #  print STDERR "Called from @caller\n";

    # Strip out the braces
    # $2: (.*?) replaced with (.*) 0.04
    $token =~ s/\$\{(.*?)\}(.*)/\$$1/;
    my $suffix = $2;
            
    # Arrays
    if ($token =~ /\w+\[.*\]/) {
        $ntok = Handle_variable($token);

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

}

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

sub interpolation {
   my ($string) = @_;
   my $delimiter = '';
   
   #print STDERR "interpolation: <$string>\n";
   #my @caller = caller();
   #print STDERR "@caller\n";
   
   # single quoted string
   if ($string =~ /^(\'.*\')(.*)/) {
       my $single = $1;
       $string = $2;
       
       if ($string) {
           out "$single.";
       }

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

         $user_function = 1;
         $ntok++;
      }
      elsif (@perlbi = App::sh2p::Parser::get_perl_builtin($name)) {
         # Do my best to trap unnecessary child processes
         $ntok = &{$perlbi[0]}(@_);
         return $ntok;
      }
      
      if (is_break($args[0])) {
          my @caller = caller();
          print STDERR "@caller\n";
          error_out ("++++ Internal error: Invalid break in Handle_external");
      }
     
      my $append = '';
      $append = ';' if query_semi_colon();
      
      iout "$func (";
                
      # Parse arguments

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

sub Handle_unknown {   

   my ($token) = @_;

   # Don't quote if numeric or already has quotes
   if ($token =~ /^[-+]?\d+$/ || $token =~ /^\".*\"$/) {
       out "$token";
   }
   else {
       #my @caller = caller();
       #print STDERR "Handle_unknown token: <$token> @caller\n";
       out "\"$token\"";
   }
   
   return 1;
}

############################################################################
sub store_subs {

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

   my $name = $g_last_opened_here_name;
   $g_last_opened_here_name = undef;
   return $name

}

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

sub get_last_file_name {

   my @caller = caller();
   print STDERR "get_last_file_name: <$g_last_opened_file_name> @caller\n";

   my $name = $g_last_opened_file_name;
   $g_last_opened_file_name = undef;
   return $name

}

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

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

#   nested = 1 - call is not nested, first argument is not an external program
#   nested = 2 - as 1, plus call is as a list

sub identify {
   my ($nested, @in) = @_;
   my @out;
   my $first = $in[0];
   
   if (!@in) {
       print STDERR "+++ Internal error: Empty input array to identify\n";
       my @caller = caller();
       die "@caller\n";
   }
   
   #print STDERR "identify first <$first>\n";
   # Special processing for the first token
   
   if ($first =~ /^\w+\+?=/) {
      $out[0] = [('ASSIGNMENT', 
                 \&App::sh2p::Handlers::Handle_assignment)];
      shift @in

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

   return @out;
   
}

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

sub convert (\@\@) {
   my ($rtok, $rtype) = @_;  
   
   if ( $DEBUG ) {
      my @caller = caller();
      print STDERR "\nconvert called from @caller\n";
      local $" = '|';
      print STDERR "convert:@$rtok\nconvert: ";
      print STDERR (map {"$_->[0] "} @$rtype),"\n";
   }

   if (@$rtok != @$rtype ) {
      print STDERR "+++ Internal Error rtok: <@$rtok>, rtype: <@$rtype>\n";
      die "Parser::convert: token and type arrays uneven\n"
   }

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

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

sub analyse_pipeline {
    my @args = @_;
    my $ntok = @args;
    my $end_value = '';
    
    error_out ();
    error_out "Pipeline '@args' detected";
    
    #my @caller = caller();
    #print STDERR "analyse_pipeline: <@args><@caller>\n";
    
    # Get commands, sometimes the | is separate, sometimes not
    @args = split /\|/, "@args";
    
    App::sh2p::Handlers::no_semi_colon();
    
    # Let's make a guess.  echo or print at the front usually means
    # that the command which follows wants a string
    if ($args[0] =~ s/^(echo |print )//) {

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

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

my $g_indent_spacing = 4;

my %g_special_vars = (
      'IFS'      => '" \t\n"',
      'ERRNO'    => '$!',
      'HOME'     => '$ENV{HOME}',
      'PATH'     => '$ENV{PATH}',
      'FUNCNAME' => '(caller(0))[3]',    # Corrected 0.04
      '?'        => '($? >> 8)',
      '#'        => 'scalar(@ARGV)',
      '@'        => '"@ARGV"',
      '*'        => '"@ARGV"',    
      '-'        => 'not supported',
      '$'        => '$$',
      '!'        => 'not supported'
      );
      
# This hash keeps a key for each variable declared

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

   }
   
   out (@args);
}

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

sub out {
   
   local $" = '';   
   #my @caller = caller();
   #print STDERR "out: <@_> @caller\n";
  
   $g_out_buffer .= "@_";
      
   $g_new_line = 0;
   
}

################################################################################
# I don't like these hacks, but any other way is convoluted

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

    $g_rd_pos = 0;
    $g_rd_len = 0;
    
}

#################################################################################
# Debug purposes only
sub print_types_tokens {
    
    my ($types, $tokens) = @_;
    my $caller = (caller(1))[3];
    
    for (my $i = 0; $i < @$types; $i++) {
    
        if (defined $types->[$i][0]) {
            print STDERR "$caller Type: ".$types->[$i][0].", ";
            print STDERR "Token: ".$tokens->[$i]."\n";
        }
        else {
            print STDERR "**** Type undefined for Token: <".$tokens->[$i].">\n";
        }