view release on metacpan or  search on metacpan

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

}

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

sub read {
   my ($this) = @_;
   my $key = refaddr $this;

   return <$handle{key}>
}

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

sub close {
   my ($this) = @_;
   my $key = refaddr $this;

   my $retn = close $handle{$key};
   delete $handle{$key};
   delete $name  {$key};
   delete $access{$key};

   return $retn;
}

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

sub DESTROY {
   my ($this) = @_;
   my $key = refaddr $this;

   if (exists $name{$key}) {
      close_here_doc ($this);
   }
}

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

sub write_here_subs {

    if ($g_write_subroutines) {
    
        $g_write_subroutines = 0;
        
        out "";
        
        out << 'END';
        

######################################################
# sh2p_read_from_handle
# Arguments:
#       1. Handle
#	2. Value of $IFS
#	3. Prompt string
#	4. List of scalar references
#	Any may be undef
	
sub sh2p_read_from_handle {

   my ($handle, $sh2p_IFS, $prompt, @refs) = @_;
   
   return 0 if eof($handle);
   
   if (!defined $sh2p_IFS) {
      $sh2p_IFS = " \t\n";
   }
   
   if (defined $prompt) {
      print $prompt
   }
   
   my $line = <$handle>;
   my $sh2p_REPLY;
   
   chomp $line;
   
   my (@vars) = split /[$sh2p_IFS]+/, $line;
   my $i;
   
   # Assign values to variables
   for ($i = 0; $i < @refs; $i++) {
      if ($i > $#vars) {
         ${$refs[$i]} = '';
      }
      else {
         ${$refs[$i]} = $vars[$i];
      }
   }
   
   # If not enough variables supplied
   if ($i < @vars || !@refs) {
      my $IFS1st = substr($sh2p_IFS,0,1);
      $sh2p_REPLY = join $IFS1st, @vars[$i..$#vars];
   }

   if (@refs > 0 && defined $sh2p_REPLY) {
      # Concat extra values onto the element
      ${$refs[-1]} .= " $REPLY";
   }
   
   return 1;
}

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

sub sh2p_read_from_stdin {

   my (@args) = @_;
   
   return sh2p_read_from_handle (*STDIN, @args);
}

######################################################
{
# No 'state' variables in 5.8
my $handle;

   sub sh2p_read_from_file {

      my ($filename, @args) = @_;

      if (!defined $handle) {
          open ($handle, '<', $filename) or 
              die "Unable to open $filename: $!";
      }
   
      my $retn = sh2p_read_from_handle ($handle, @args);
      if (!$retn) {
          close $handle;