###############################################################################
# THIS IS THE PREVIOUS VERSION OF CGIPLUS.PM (RELEASED WITH PERLRTE 1.0, 1.1) #
#          AVAILABLE IF REQUIRED FOR STRICT BACKWARD COMPATIBILITY            #
###############################################################################
#
# CGIplus.pm (see end of module for description)
#------------------------------------------------------------------------------

package CGIplus;

require VMS::DCLsym or die "failed to require VMS::DCLsym\n";
tie %symVar, VMS::DCLsym or die "failed to tie VMS::DCLsym\n";

require VMS::Stdio or die "failed to required VMS::Stdio\n";
use VMS::Stdio qw( :CONSTANTS :FUNCTIONS );

use FileHandle;

$CGIPLUSIN = undef;
$SYSOUTPUT;
$usageCount = 0;
%varArray;

#------------------------------------------------------------------------------
# Takes one parameter, a function by reference (see examples).
# This dereferenced function is then executed once for standard CGI, or
# in a loop with the appropriate infrastructure if CGIplus.

sub process
{
   my $funcref = $_[0];
   if ($funcref eq undef) {
      die ("CGIplus::process() was passed no function reference\n");
   }

   if ($ENV{"CGIPLUSEOF"} eq undef)
   {
      # standard CGI, execute the function reference once
      &$funcref;
      return;
   }

   # otherwise it must be CGIplus
   while (1)
   {
      # read, with implicit wait-for, the next request's variable stream
      private_ReadCGIplusStream();
      # execute the function reference
      &$funcref;
      # tell the server we've finished processing this request
      CGIplus::eof();
   }
}

#------------------------------------------------------------------------------
# Return true if it is CGIplus environment.
# Takes zero parameters.

sub isCGIplus
{
   return ($ENV{"CGIPLUSEOF"} ne undef);
}

#------------------------------------------------------------------------------
# Return true if it is standard CGI environment.
# Takes zero parameters.

sub isCgi
{
   return ($ENV{"CGIPLUSEOF"} eq undef);
}

#------------------------------------------------------------------------------
# Return the number of time the script has been used (standard CGI is always 1).
# Takes zero parameters.

sub usageCount
{
   return ($usageCount);
}

#------------------------------------------------------------------------------
# Write an end-of-CGIplus-request record.
# Takes zero parameters.

sub eof
{
   STDOUT->autoflush(1);
   printf ("%s\n",$ENV{"CGIPLUSEOF"});
   STDOUT->autoflush(0);
}

#------------------------------------------------------------------------------
# Write a begin-callout record.
# Takes zero parameters.

sub esc
{
   STDOUT->autoflush(1);
   printf ("%s\n",$ENV{"CGIPLUSESC"});
   STDOUT->autoflush(0);
}

#------------------------------------------------------------------------------
# Write an end-callout record.
# Takes zero parameters.

sub eot
{
   STDOUT->autoflush(1);
   printf ("%s\n",$ENV{"CGIPLUSEOT"});
   STDOUT->autoflush(0);
}

#------------------------------------------------------------------------------
# Return the CGI variable value corresponding the supplied variable name.
# Takes one parameter, the name of the variable to be returned.

sub var
{
   my $name = $_[0];
   if (substr($name,0,4) ne "WWW_")
   {
      # add "WWW_" to variable name
      $name = "WWW_".$name;
   }

   if ($ENV{"CGIPLUSEOF"} ne undef)
   {
      # CGIplus environment
      return ($varArray{$name});
   }

   # standard CGI environment
   if ($ENV{"WWW_SERVER_SOFTWARE"} ne "")
   {
      # CGI variables available via standard environment
      return ($ENV{$name});
   }
   # CGI variables must be accessed via DCL symbols module
   return ($symVar{$name});
}

#------------------------------------------------------------------------------
# Reads the CGIplus variable stream.
# *** internal module use only ***

sub private_ReadCGIplusStream
{
   if ($CGIPLUSIN eq undef) {
      open (CGIPLUSIN, $ENV{"CGIPLUSIN"}) or die "Could not open CGIPLUSIN\n";
   }
   # ensure no variables are carried-over
   my $name;
   foreach $name (keys %varArray) {
      delete $varArray{$name};
   }
   # read CGIplus variable stream
   while (<CGIPLUSIN>)
   {
     chop;  # remove trailing newline
     if ($_ eq "") { last; }  # end of request's CGIplus stream
     if ($_ eq "!") { next; }  # start of new request's CGIplus stream
     my $length = index($_,"=");  # find end of name, start of value
     my $name = substr($_,0,$length);
     my $value = substr($_,$length+1); 
     $varArray{$name} = $value;
   }
   $usageCount++;
}

#------------------------------------------------------------------------------
# Print out the CGI variable values (for debug purposes).
# Takes zero parameters.

sub varPrint
{
   if ($ENV{"CGIPLUSEOF"} eq undef)
   {
      printf ("Standard CGI Variables (DCL symbols)\n");
      printf ("----------------------\n");
      system ("show symbol www_*");
      printf ("----------------------\n");
   }
   else
   {
      my $name;
      printf ("CGIplus Variables (usage count %d)\n", $usageCount);
      printf ("-----------------\n");
      my @sortedKeys = sort (keys %varArray);
      foreach $name (@sortedKeys) {
         printf ("$name=\"$varArray{$name}\"\n");
      }
      printf ("-----------------\n");
   }
}

#------------------------------------------------------------------------------
# Open a binary stream to SYS$OUTPUT.
# Takes zero parameters.

sub beginStream
{
   $SYSOUTPUT = vmssysopen ("SYS\$OUTPUT", O_WRONLY, 0, "ctx=bin")
      or die ("Could not open \"SYS\$OUTPUT\"");
   # make standard output flush-every-record mode
   STDOUT->autoflush(1);
}

#------------------------------------------------------------------------------
# Close the binary stream to SYS$OUTPUT.
# Takes zero parameters.

sub endStream
{
   close($SYSOUTPUT);
   # return standard output to buffered mode
   STDOUT->autoflush(0);
}

#------------------------------------------------------------------------------
# Write to the binary SYS$OUTPUT stream.
# The first parameter is the data to written.
# The second parameter is the number of bytes in the data.
# (if the second parameter is -1 the length of the data is determined)

sub writeStream
{
   my $data = $_[0];
   my $length = $_[1];
   if ($length < 0) {
      $length = length($data);
   }
   syswrite ($SYSOUTPUT, $data, $length);
}

#------------------------------------------------------------------------------
# Open the file specified in the parameter and return it as a binary stream.
# The first parameter is the file name.
# The second parameter is the file MIME content-type (default octet-stream).

sub fileStream
{
   $SYSOUTPUT = vmssysopen ("SYS\$OUTPUT", O_WRONLY, 0, "ctx=bin")
      or die ("Could not open \"SYS\$OUTPUT\"");

   $INFILE = vmssysopen ($_[0], O_RDONLY, 0, "ctx=bin")
      or die ("Could not open \"$_[0]\"");

   if ($_[1] eq "") {
      $contentType = "Content-Type: application/octet-stream\n\n";
   }
   else {
      $contentType = "Content-Type: " . $_[1] . "\n\n";
   }

   syswrite ($SYSOUTPUT, $contentType, length($contentType));
   while ($bytesRead = sysread ($INFILE, $bytes, 4096)) {
      syswrite ($SYSOUTPUT, $bytes, $bytesRead);
   }

   close($INFILE);
   close($SYSOUTPUT);
}

#------------------------------------------------------------------------------

# end of module initialization, return TRUE
1;

__END__


CGIPLUS.PM
----------
Makes WASD and general DCL CGI and WASD CGIplus environments transparent to CGI
Perl scripts.  To make the standard CGI and CGIplus as compatible as possible
the CGIplus::process() function takes a reference to a function which contains
all of the essential activities of the script.  This mechanism should *always*
be used to execute the script.  Nothing of the environment is then needed to be
known by the script itself!  Of course, for persistent scripting some care
needs to be taken to ensure all storage, etc., is correctly initialized each
time the script is started and nothing is left to script exit and rundown to
clean up (which of course doesn't happen with persistant scripts).

The module also compensates for variations in VMS environments.  Most VMS CGI
environments provide their CGI variables via DCL symbols.  Many Perl scripts
access these via the %ENV array.  Some VMS Perl versions do not support DCL
symbols via this mechanism.  CGIplus.pm detects whether CGI variables are
available via %ENV and if not uses Charles Bailey's VMS::DCLsym extension
module built into most versions of VMS Perl.

VMS' RMS complicates output streams under Perl.  This is a particular issue
with CGIplus end-of-file sentinals, which must be output as a single record. 
CGIplus.pm attempts to provide a simple mechanism for providing binary streams
if necessary, while still ensuring it's own records are not interfered with. 
This uses Charles Bailey's VMS::Stdio extension module built into most versions
of VMS Perl.

Ideally this file would be placed into the site's Perl library directory with
other modules.  It would then only be necessary to 'require CGIplus.pm;' at the
start of a script.


COPYRIGHT
---------
Copyright (c) 2000 Mark G.Daniel
This program, comes with ABSOLUTELY NO WARRANTY.
This is free software, and you are welcome to redistribute it
under the conditions of the GNU GENERAL PUBLIC LICENSE, version 2.


VERSION HISTORY
----------------
31-MAY-2000  MGD  initial

#------------------------------------------------------------------------------