view release on metacpan or  search on metacpan

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

        print STDERR "++++ Internal Error, block level = $g_block_level\n";
        my @caller = caller;
        die "@caller\n";
    }
}

sub get_block_level {
    return $g_block_level;
}

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

sub is_user_function {
   my ($name) = @_;

   return (exists $g_user_functions{$name})
}

sub set_user_function {
   my ($name) = @_;

   $g_user_functions{$name} = undef;
   
   return 1;   # true
}

sub unset_user_function {
   my ($name) = @_;
   
   delete $g_user_functions{$name} if exists $g_user_functions{$name};
   
   return 1;   # true
}

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

sub mark_new_line {
    $g_new_line = 1;
}

sub new_line {
    return $g_new_line;
}

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

sub inc_indent { $g_indent++ if $g_indent < 80 }
sub dec_indent { $g_indent-- if $g_indent > 0  }

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

sub open_out_file {
    my ($g_filename, $perms) = @_;
    
    if ($g_filename eq '-') {
        $g_outh = *STDOUT;
    }
    else {
        open ($g_outh, '>', $g_filename) || die "$g_filename: $!\n";
        
        # fchmod is not implemented on all platforms
        chmod ($perms, $g_filename) if defined $perms;
        print STDERR "Processing $g_filename:\n";
    }
    
    $g_out_buffer = '';
    $g_err_buffer = '';
    $g_pre_buffer = '';
}

sub close_out_file {
    
    flush_out ();
    
    close ($g_outh);
    print STDERR "\n";
    $g_filename = undef;
}

#################################################################################
# Out to remember redirection position
sub rd_iout {

    $g_rd_pos = length ($g_out_buffer);
    iout (@_);
    $g_rd_len = length ($g_out_buffer) - $g_rd_pos;
}

sub rd_remove {

    if ($g_rd_len) {
        $g_out_buffer = substr ($g_out_buffer, 0, $g_rd_pos) .
                        substr ($g_out_buffer, $g_rd_pos + $g_rd_len);
    }
}

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

sub out_to_buffer {
    flush_out();
    ($g_ref_redirect) = @_;
}

sub off_out_to_buffer {
    flush_out();
    $g_ref_redirect = undef;
}

#################################################################################
# Indented out
sub iout {

   #print $g_outh ' ' x ($g_indent * $g_indent_spacing);
   
   my (@args) = @_;
  
   if (query_semi_colon()) {
       unshift @args, (' ' x ($g_indent * $g_indent_spacing));
   }
   
   out (@args);
}