view release on metacpan or  search on metacpan

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

# I expect only one active here doc at a time, 
# but I guess they could be in nested loops
#     while read var1
#     do
#        while read var2
#        do
#           ...
#        done << HERE
#           ...
#        HERE
#     done << HERE
#        ...
#     HERE
# This would create a problem, since the filename
# is based on the here label - TODO
#
use strict;
use Carp;
use Scalar::Util qw(refaddr);

use App::sh2p::Utils;

our $VERSION = '0.06';

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

my %handle;
my %name;
my %access;

my $g_last_opened_here_name;
my $g_last_opened_file_name;
my $g_write_subroutines = 0;

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

sub store_sh2p_here_subs {
    $g_write_subroutines = 1;
}

#################################################################################
# January 2009
sub abandon_sh2p_here_subs {
    $g_write_subroutines = 0;
}

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

sub get_last_here_doc {

   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

}

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

sub _get_dir {
   my $dir;
   
   if (defined $ENV{SH2P_HERE_DIR}) {
      $dir = $ENV{SH2P_HERE_DIR}
   }
   else {
      $dir = '.'
   }
   return $dir;
}

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

sub gen_filename {
   my $name = shift;
   my $dir  = _get_dir();
   
   return "$dir/$name.here";
}

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

sub open {
   my ($class, $name, $access) = @_;
   
   my $this = bless \do{my $some_scalar}, $class;
   my $key = refaddr $this;
   
   $name  {$key} = $name;
   $access{$key} = $access;
   
   $g_last_opened_here_name = $name;
   my $full_name = gen_filename($name);
   
   error_out ("Writing $full_name");
   open ($handle{$key}, $access{$key}, "$full_name") ||
        carp "Unable to open $full_name: $!\n";
   
   $g_write_subroutines = 1;
   
   return $this 
}

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

sub open_rd {
   my ($class, $filename, $access) = @_;
   
   my $this = bless \do{my $some_scalar}, $class;