#!/usr/bin/perl -w
{
  $name = $0;
  $version = "1.2   9 Jul 2003";
#  9 Jul 2003  v 1.2  WJS
#   Add time stamp to error msgs.  Merge program variants (dates/version
#	numbers show independent development lines)
#   1.1 mod: 
#	a) Use $0 instead of hard-coded name.  Whatever
#	  file is named will be program name
#	b) Could not find 8081 in program anyplace.  ??
#   1.01 mod: /usr/local/bin works on both boxes
#	[Begin v 1.2]
# 31 Jan 2000  v 1.1  CLH
#   need to use from 8081 for testing superobjects
#   v 1.1 only renames method (jgofsread) and
#   changes hardcoding to 8081 port
# 28 Jun 2000  v 1.01 RCG/WJS Change location for perl compiler
# 25 Jan 2000  v 1.0  WJS
#	[Begin v 1.0]

  require "ctime.pl";

  $FALSE = 0;
  $TRUE = ( ! $FALSE);

  $INPUT_open = $FALSE;

#   Must accept > 1 arg - could get selections/projections, which we ignore
  ($data_file = shift) || &bad_out("input file name missing");

  $! = 0;
  $? = 0;
  open (INPUT,"$data_file") || &bad_io_out("Could not open input");
  $INPUT_open = $TRUE;

#   jdb routines want Content-type lines... so they can be skipped
#   As of jdb 1.1, lines are just skipped, so they can be anything.  However,
#     let's put in Content-type lines if they are missing
  defined($line = <INPUT>) || &bad_io_out("Read error or empty input file");
  if ($line =~ /^Content-type:/) {
    (print $line) || &bad_out ("Write error.  err msg/number: $!");
    defined($line = <INPUT>) || ($line = "<EOF or error>");
    ( $line =~ /^\s+$/ )  ||  &bad_out("Bad format? " .
				"Line after 'Content-type:' should be empty\n" .
				"  Line: $line");
    (print $line) || &bad_out ("Write error.  err msg/number: $!");
    defined($line = <INPUT>) || ($line = "<EOF or error>");
  } else {
    (print "Content-type: text/plain\n\n") ||
			&bad_out ("Write error.  err msg/number: $!");
  }

#   Format check.  Also serves as crude security check in that only files
#   this "copier" will read start with &v0
  ( $line =~ /^&(v0|c)\n$/ )  || &bad_out("Bad format. " .
				"First data line must be &v0 or &c\n" .
				"  Line: $line");
  (print $line) || &bad_out ("Write error.  err msg/number: $!");

#   Copy input to stdout
  while (defined($line = <INPUT>)) {
    (print $line) || &bad_out ("Write error.  err msg/number: $!");
  }
  ($! || $?) && &bad_io_out("Read error.");

  exit;
}

sub bad_io_out
#	Also "normal" way out if EOF... maybe
{
#   Explicitly close input in an attempt to get a $? status if input happens
#     to be a pipe...
#   We're really doing a unix "wait" call... or at least, that's my
#     intention!  Seems weird to do a close if the open did not succeed!
#   Not sure what it would mean if close itself failed... selfishly, it
#     wouldn't affect this program.
  my $save_status = $!;
  close INPUT;
  $INPUT_open = $FALSE;
  $! = $save_status;
  chomp $_[$#_];
  &bad_out("@_\n" .
	   "  I/O status: $save_status\n" .
	   "  Input source: $data_file\n" .
	   "  Child process status(if appropriate): $?"      );
}

sub bad_out
{
  chomp $_[$#_];
  if ($cleanup_msg = &cleanup) {
    chomp $cleanup_msg;
    push (@_,"\n",$cleanup_msg);
  }
  $text = "&x $name: @_\nThis message issued " . &ctime(time) .
	  "$name version $version\n";
  print $text;
  die $text;
}

sub cleanup
{
  if ($INPUT_open) {
    close INPUT;
    $INPUT_open = $FALSE;
    ($! || $?) &&  return  "Problems closing input\n" .
			   "  I/O status: $!\n" .
			   "  Input source: $data_file\n" .
			   "  Child process status (if appropriate): $?"      ;
  }
  return "";
}