#!/usr/bin/perl -w
#
# Name:         $OPTHOME/optbin/download-4
# Purpose:      part of JGOFS data download package
#		split data into smaller files, get info file
#		pkg data and info for download
# Dec 98.clc. under development.
#
# Modification history:
$version = "download-4 version 3.4  11 Aug 2016";
# 11 Aug 16 WJS
# History file entries for start/end of rename attempt
# 17 Jul 15 WJS
# User spec of character to replace # in "multiple small file" file names
#	  [begin download-4 v 3.4]

#  6 Sep 14	WJS
# Try to do a BETTER job of "clean up object specs that had prepended commas", esp
#    since it's this code that made most of them!
#	  [begin download-4 v 3.3a]
# 26 Dec 12	WJS
#	Mod check_data into a line counter.  See its text for more
#  3 Dec 12	WJS
#	Finish recode to reflect removal of  do_shell_command  from  
#    wjs_web_perl_utilities.pl.  Interesting that we didn't do all of them when
#    we did the first (18 mos ago).  Also interesting that such a problem (non-existent 
#    subroutine) doesn't get diagnosed by the code.  Not perl's fault - it sends
#    a message to stderr.  Yet a whole new level of error checking that's not done ...
#	Did some work to clean up object specs that had prepended commas in sel/proj list,
#    double sel/proj lists, empty sel/proj lists, etc
#	Got rid of mysterious "using extended URL" message that printed in httpd logs
#    and did NOT include a nice string like "TESTING"
#	Don't include server port number in "From:" email address
#  4 Feb 12	WJS
#	Move fundamental checks (eg, existence) for various utilities from
#    here to download-1.  Among other things, this allows us to compensate
#    for removal of non-gzip compression utility on gb11
#	Yet another try at letting env vars drive matlab choices
# 27 Dec 11	WJS
#	Bug fix: 16 Oct 10 fix (probably) introduced new error due 
#    to the $maxlev stuff described next.  Try to fix the new thing 
#    while keeping the old thing fixed
#	download-3 passed a confusing parameter called  $maxlev  that 
#    wasn't actually needed.  Re-create its meanings from the other 
#    info it duplicated (or so I intend!).  Comments may still refer to 
#    maxlev.  Note that $maxlev NEVER meant "number of JGOFS
#    levels" or "maximum JGOFS level" (although it meant one of those 
#    in download-2 and part of download-3.  Elsewhere, after its meaning 
#    changed to those described below, it may well 
#    have coincidentally matched one of the JGOFS level numbers)
#    Here are the meanings (I hope!)
#	    $maxlev == 0    User asked for "onebigfile".  
#			    Get from  bulk  formvar
#	    $maxlev > 0	    User asked for "moresmallfiles" and was 
#		offered a per-level menu for all levels except the 
#		"bottom" level.  Menu items were variables at that level.  
#		Thus, given an N-level object, the user was offered N-1
#		menus.  User may have picked any subset of these N-1.  
#		The empty subset is rejected before it gets here.  
#		$maxlev is the size of the subset; thus  1<= $maxlev <= N-1.  
#			    Get from size of  @determine  array  
#		Since these variables determine the splitting, they are
#		referred to as the "determinants"
#    $maxlev == 1  is a special case in the splitting logic.  
#    I have not studied any of the splitting logic to see why it needs to 
#    be special.
#	Get rid of some global variables
#	Fix bug:   @array eq ""   does NOT check for empty array
#	  [begin download-4 v 3.3]

# 10 Aug 11	WJS
#	Change "Plotting and ..." to "Download and ..."
# 24 Jul 11	WJS
#	Per-var-value file names need to be protected against containing
#   shell chars since the var-values can contain shell chars.  
#   Directory names that theoretically have the same problem don't, because
#   the code uses the perl  mkdir  function, which does not go to the shell.
#   Not sure about cleanup of said directories, done w/some perl library
#   function called  rmtree .
#	While in here, remove do_shell_command in favor of backtick
#	  [begin download-4 v 3.2b]
# 16 Oct 10
#	Bug fixes to  sub getallvalues  for the case of a l-level object
#   Problem first noticed (but not fixed!) in 2004, apparently
#	  [begin download-4 v 3.2a]
#  7 Feb 10	WJS
#	Code to handle info= field
#	Code to call info with a data= extended URL
#	Better form var check
#	Don't report success for info download in various places if
#   in fact the attempt to download failed
# 14 Jan 10	WJS
#	Put user-supplied file extensions on packaged files.  Since
#   that will now be coming from download-3, have download-3 pass us
#   .matlab and .netcdf if appropriate, and remove that code from here
#	Put in code that will use an info= extended URL field and which
#   will pass a data=extended URL field to that info.  The former should
#   have been happening all along; latter might help out BCO-DMO info
#   source.  Since nobody is supplying an extended URL at the moment,
#   we can experiment.  As part of this, $getinfo referred to in previous
#   comments has been better named to $OOserverinfo
#	Check for user-supplied file name/extension consisting of all 
#    whitespace (previous logic checked for empty string)
# 25 Apr 09	WJS
#	Mod of 17 Jan left all refs to $getinfo unused except its
#   defining reference.  This gave an "only used once" error.
#   In case we eventually want to go back and use $getinfo, just put
#   in dummy command to get rid of err msg
#	  [begin download-4 v 3.2]
# 21 Jan 09	WJS
#	Clean up an unused branch after 17 Jan mod
# 17 Jan 09	WJS
#	Directory that info was using had been altered to point to relevant
#   jgofsopt subdirectory.  Accordingly, info never found anything.
# 28 Nov 08	WJS
#	1 Nov mods in download-1 can destroy dobjext.  Add code
#  1 Nov 08.  WJS
#	Parametrize tracefile but leave it pointed to STDERR
#	Allow for possibility that dobject has appended arg list
#	  [begin download-4 v 3.1]
#  9 Aug 08.  WJS
#	Issue non-terminating diagnostic if we can tell email addr bad
#	Replace split in scalar context - gives diagnostic
#	  [begin download-4 v 3.0a]
#  9 May 08.  WJS
#	Many typos, which makes me suspect testing of previous versions!
#	Log with $version rather than script name
#	Change listm_user to list_options
#	Change version to 3.0 to match other pieces of download which are
#   getting a version for the first time.  See download-3 comments
#   for why 3.0
#	  [begin download-4 v 3.0]
#	[older comments removed to download-X_tmp.comments  Jul 15]
#	[older comments removed to download-X_tmp.comments  Dec 04]
#
# =====================================================================

require "cgi-lib.pl";
require "wjs_web_perl_utilities.pl";
use File::Copy;
use File::Path;
use FileHandle;
use LWP::Simple;

MAIN:
{
#   Set stdout to flush after every record.  Should allow user
#   to wait for download or leave while it's running
  autoflush STDOUT;

#   Run bulk of program as a child process.  Idea is that httpd
#   server kills cgi process it started when server discovers browser
#   has broken connection.  However, it does not kill that process'
#   children.  This (which is the heart of the deferred download
#   idea) is based strictly on observation of the behavior of the
#   Apache web server on gb1 in Dec '04
  $! = $? = 0;
  $child_pid = open (CHILD_HANDLE,"-|");
  defined($child_pid) ||
      &uh_oh ("Could not run download as child process\n\$!=$!;\$?=$?\n");
  if ($child_pid != 0) {
#     Parent process - copy whatever we get to STDOUT
    $! = 0;
    while (  defined($rec = <CHILD_HANDLE>)  ) {
      print $rec;
    }
    $status = $!;
#     Not going to worry about status of close
    close CHILD_HANDLE;
    ($status == 0) || 
      &uh_oh ("Error reading from download child process $child_pid\n" .
                "\$!=$!\n");
    exit;
  }

  &printheader();

#   Set up environment.  Assume .pl routine is in our directory
  $build_opt_env = "./build-opt-env.pl";
  &check_r_access($build_opt_env);
  do $build_opt_env;

  $tracefile = "STDERR";
  $objarg_sep = ',';
#
# set up some variables
# 
  $protocol = "http://";
  $logfilename = "README";	# download status log file
  $historyfilename = "HISTORY";	# another log file w/more emphasis on
                                #   processing & less on data
  $pid = $$;
  $dwnld_id_stamp = "DWNLD_$pid";
  $dwnld_err_stamp = $dwnld_id_stamp . "_ERR";
   
#   color palette  
  $credhi = "indianred";
  $chdrbar1 = "skyblue";
  $cgobar = "mediumaquamarine";
  
  $dbasemgr = "$ENV{'SERVER_ADMIN'}";	# env var defined in web server setup,
					# not JGOFS system

  print $tracefile " $dwnld_id_stamp: using script: $version \n";
  $now = localtime() . "\n";
  print $tracefile " $dwnld_id_stamp: $now \n";
# 
# These variables set by makefile from ENVars at install time
#
  $jgtopdir  = $ENV{'JGOFSDIR'};	# top of JGOFS tree
  $jgscdir   = $ENV{"JGSCRIPTDIR"};	# where are CGI scripts?
  $webimages = $ENV{'BUTTONIMAGESDIR'}; # where are web images?
  $OOserverinfo = $ENV{"INFOSERVER"};	# data doc file retrieval system    
		# Note that this is the info for the OOserver itself
		# It is NOT the info for the data object being dealt with
  $tempdir  = $ENV{"USETEMPDIR"};

  $jgtopdir = &abs_filespec($ENV{'JGOFSDIR'},"Env var JGOFSDIR");
  $jgbindir = "$jgtopdir/bin";
#
#
#  which archive and compression (tar,compress,zip) programs to use
#

  $bundle = "$ENV{'TARPROG'} cf";
  $pkgtype = ".tar";
  $comp = $ENV{'UNIXCOMPRESS'};
  $compext = ".Z";
  $compgz = $ENV{'GNUCOMPRESS'};
  $compgzext = ".gz";
  $pcbundle = "$ENV{'ZIPPROG'} -r";
  $pcpkgtype = ".zip";
  $pccomp = "";

  $list = "$jgbindir/list";			# which list program to use
  $renamer_script = $ENV{'OPTHOME'} . '/' . $ENV{'OPTRUNDIR'} . "/repl_char_in_filenames_via_rename.pl";
#   matlab & netcdf image files defined where used

  $email_sender = $ENV{"MAIL_SENDER"};

#   Note that ENV{"OPTIONSERVER"} is NOT necessarily the same as below
#   It might be the production server and the stuff below will return
#   value for a test server if that's what's running at the moment
  $jg_url = "http://$ENV{'MYADDR'}$ENV{'JGSCRIPTDIR'}";
  $optsmenu = "$jg_url/otheropt";
  $download_inquiry_url = "$jg_url/download_inquiry.pl"; 

  $no_goback_url = "http://" . $ENV{"MYADDR"} . "/no_download_goback.html";
#############################################################
#
# Read in all the variables set by the form
#
  &ReadParse(*form_info);

#
# get information passed in form_info hash
# Note that this amounts to env vars from build
#
  $dobject = &get_form_var('dobject','REQ','OBJSPEC');
  $dobjext = &get_form_var('dobjext','REQ','OBJSPEC');	# jgofs object string with extension
  $dispobj = &get_form_var('dispobj','REQ','OBJSPEC');	# jgofs object+(QS) for display
  $urlobjx = &get_form_var('urlobjx','REQ','OBJSPEC');
  $subsels = &get_form_var('subsels','OPT','NOCHECK');
  $subsdisp = &get_form_var('subsdisp','OPT','NOCHECK');
  $dobj_infoserver = &get_form_var('dobj_infoserver','OPT','OBJSPEC');

  $format = &get_form_var('format','REQ');
  $filesize = &get_form_var('bulk','REQ');
  $compress = &get_form_var('compress','REQ');

  $pkgname = &get_form_var('pkgname','REQ');
  $customname = &get_form_var('customname','OPT');
  $datafile_ext = &get_form_var('datafile_ext','OPT');
  $custom_datafile_ext = &get_form_var('custom_datafile_ext','OPT');
  $varvalsepchar = &get_form_var('varvalsepchar','OPT');
  $defvarvalsep =  &get_form_var('defvarvalsep','REQ');

  $email_address = &get_form_var('email','OPT','NOCHECK');  # email address  

  ($status,$objnode,$objdir,$objnameonly,$objargs) = 
						&parse_object_spec($dobject);
  ($status eq "OK") || 
	&uh_oh ("Problem parsing obj spec $dobject\n" .
		"Problem = $objnode");
  $orig_objdir = $objdir;
  if ($objargs) {
#     Undo whole qs adjusting thing in case we have a do-over from the
#     beginning.
    $orig_subsels = $objargs;
    $subsels && ($orig_subsels .= $objarg_sep . $subsels);
    $objnsels = $dobject;
    chop $objnsels;
    $objnsels .= $objarg_sep . $subsels;
  } else {
    $orig_subsels = $subsels;
    $objnsels = "$dobject($subsels";	# object(sub,sels  ; no final paren
  }

  $user_confirm = &get_form_var('confirm','REQ');
  $list_options = &get_form_var('list_options','OPT','SPACEOK');
  $tempdir = $ENV{'USETEMPDIR'};
  $utility = "download";		# tmp = tmpdir/client_host/download
#  
# make full options menu specifier with data object [and subsels] 
#  
  $back_to_opts =  ($dobjext eq "NO_VALID_DOBJEXT") ? 
			$no_goback_url : "$optsmenu"."$dobjext"."?"."$subsels";

  print <<ENDOFTOP;  
  <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
  <html>
  <!--This page prepared by $version//-->
  <head>
  <title>Data download - final form.</title>
  </head>
  <BODY BGCOLOR="#FBFBFF">
  <h1>Data download - final form</h1>
  <b>Current object is:  $dispobj</b></br></br>
  If you wish, you may leave this page and come back later
  for your download.</br>
  Use the download inquiry link on the
  "Download and Other Operations" menu at that time.</br>
  The process ID for this download is <b>$pid</b></br></br>
ENDOFTOP

  if ($email_address) {
    $status = &pre_validate_email($email_address);
    ($status eq "OK") || 
	print " *** WARNING: will not be able to send email because of ".
		"following problem<br>\n\t$status<br>\n" .
		" ... Continuing with download<br>\n";
  }

# get user selected name for packaged datafile
  $customname && ($pkgname = $customname);
  $n_underscores = ($pkgname =~ s/\s+/_/g);

# get user supplied file extension for files being packaged
  $custom_datafile_ext && ($datafile_ext = $custom_datafile_ext);
  $n_ext_underscores = ($datafile_ext =~ s/\s+/_/g);
  
# The # under discussion is used in get0values et al.  It has been hardcoded in here
# "since the beginning".  In fear of what would happen if we change it, we leave it in,
# and, after the fact, change the filenames that contain it (if user asked, of course)
# $defvarvalsep is a sanity check.  It's set in download-3
  ($defvarvalsep eq '#') || 
      &uh_oh ("Internal inconsistency: \$defvarvalsep must be #.  Its value is -->$defvarvalsep<--");
  ($varvalsepchar eq "") && ($varvalsepchar = $defvarvalsep);
  $renaming_files = ($filesize eq "moresmall") && ($varvalsepchar ne $defvarvalsep);


  if ($user_confirm eq "yes") {
#
# user selections have been made and confirmed ... let's do it ...
#
  print $tracefile " $dwnld_id_stamp: Working on object: $dispobj \n";
  print $tracefile " $dwnld_id_stamp: dobject: $dobject \n";
  print $tracefile " $dwnld_id_stamp: dispobj: $dispobj \n";
  print $tracefile " $dwnld_id_stamp: objnsels: $objnsels \n";

#
# if user has assigned a value to the level, use it
#
  $levelparams = &get_form_var('levelparams','OPT','NOCHECK');
  @determine = split("%",$levelparams);
#
# make a new directory tree
# flag determines if we remove this directory tree if it already exists
#
  $flag="no";
  $hostdir = make_directory($tempdir,$utility,$flag);
  $flag="yes";
  $objdir = make_directory($hostdir,$objnameonly,$flag);
  $flag="no";
  $url_of_objdir = $ENV{'USETEMPADDR'} . "/$utility/$objnameonly";
#
# create README & HISTORY files to keep track of progress during processing
#
  $logfile = "$objdir/$logfilename";
  $historyfile = "$objdir/$historyfilename";
#   $badcreate is TRUE if we fail to create file
  ($badcreate = &create_readme) &&
    print $tracefile " $dwnld_err_stamp: could not create $logfile: $badcreate \n";
  ($badcreate = &create_history) &&
    print $tracefile " $dwnld_err_stamp: could not create $historyfile: $badcreate \n";
  &add_history ("PID",$pid,
		"OBJECT",$dobject,
		"OBJECT_W_SELECTIONS",$dispobj,
		"OPTIONS",join(',',$format,$filesize,$compress));
  $url_of_logfile = "$url_of_objdir/$logfilename";
#
# Need to, as it says, fool w/library path some time if we're doing matlab
# Why not do it now?
#
  if (($format eq "matlab") || ($format eq "matlab5")) {
    $library_path_name = "LD_LIBRARY_PATH";
#     List of possible matlab libs just in case multiple ones are in
#     LD_LIBRARY_PATH.  No big deal if this not kept up to date (tried to
#     have this come from build-env.pl, but just not worth it - Aug 05)
    $ENV{'MATLABLIBDIR'} && push (@matlablib_list, $ENV{'MATLABLIBDIR'});
    $ENV{'MATLAB5LIBDIR'} && push (@matlablib_list, $ENV{'MATLAB5LIBDIR'});

    $lib_env_var = uc($format) . "LIBDIR";
    $lib_file = ($ENV{$lib_env_var}) ? $ENV{$lib_env_var} : "";

    if ($lib_file) {
      ($status1,$status2,$new_lib_path) = 
			&add_file_to_path_string($library_path_name,
						 $lib_file,
						 @matlablib_list);
    } else {
      $status1 = "NG";
      $status2 = "UNDEFINED_" . $lib_env_var;
    }
    if ($status1 eq "OK") {
      $ENV{$library_path_name} = $new_lib_path;
    } else {
      &add_note ("",
	" Cannot seem to find $format library $lib_file",
	" Possible problem: $status2",
        " Proceeding in case correct library has been defaulted somehow",
        " Check resulting matlab file for version, if appropriate",
	"");
    }
  }
#
# The number of determinant parameter levels (maxlev) controls flow. 
#   If there are 0 levels, user wants all data in one single file, so
#   we just drop right down to make_files subroutine.
# However, for multiple levels, we need to get parameter lists:
#   If only 1 level, force one call to getallvalues .
#   If 2 levels, only need to getallvalues once.
#   If more than 2 levels, do getallvalues (#levels - 1) times
#   We must get all values at each user-selected level, but 
#   we do level 0 and level 1 in first pass, level 1 and 2 next 
#   and so on, so #passes = #levels-1 or maxlev-1
# Note: I could probably create a %filename{$selection} of filenames
#   indexed by selection string, but this could be done later
# As we progress, build param#value strings
#
 &add_note ("Locating data files.  Report any errors here: ");  
 @listovals = ();
 
 if ($filesize eq "moresmall") {
#  user wants data divided into multiple (moresmall) files
#  get a list of all values at [determinant] level 0 (not JGOFS level 0)
  @listovals = &get0values;
#
# Abort if we don't have a list of values; no point in continuing
  if (@listovals == 0) {
     &add_note ("\nSorry, unable to find any data for $dispobj");
     &uh_oh ("Unable to find any data for $dispobj");
  }
   
  $thislev=1;
#	See commented out reference to $pvalkey, below.  Until we have the
#	guts to throw that out, we need to keep the next line around
#	  $param=$zp;
  
  if ( @determine == 1 ) {
#     number of [determinant] levels = 1
#     so we force thislev to be zero because we only have one level, 
#     getallvalues and nullify the higher level selection criteria
#     [As of v 3.3, don't need to getallvalues.  Use the  &get0values
#     listovals set above.
    $thislev=0;
             
  } else {

#      number of levels > 1
     while ( (@determine - $thislev) > 0 ) {
       @nextvals = ();
       foreach $val (@listovals) {
         # make subdirectories as we go through selection list 
         $temp = $val;
         ($datadir = $temp) =~ tr/+/\//;
         &make_directory($objdir,$datadir,$flag);
#  [Note: orig code, below, saved return val of make_directory but did
#   not use it here or in production OOserver.  WJS 12 Dec 04]
#	         $fulldirec = &make_directory($objdir,$datadir,$flag);

         @newvals=&getallvalues($val);
# if @newvals is null (due to problem in &getallvalues) skip ahead 
# to next $val in @listovals
         if (@newvals) {
            @nextvals = (@nextvals,@newvals);
         }
       }
       $thislev++;
       @listovals = @nextvals;
     }
  }
#
# Check whether we have data to process; if not, note in log and abort
#
  if (@listovals == 0) {
     &add_note ("\nSorry, unable to find any data for $dispobj");
     &uh_oh ("Unable to find any data for $dispobj");
  }
 }
#
# All seems OK - make the data file(s)
#
# should give user a progress report of data packaging status; frame?
# Something like:
#  Creating individual files for $objnameonly data, please wait . . .
#  Packaging ...
#   
  &add_note ("\nOK ... START MAKING DATA FILES ... ");
  $renaming_files && 
    &add_note ("(Note: the first # in the file names below will be changed to " .
                  "$varvalsepchar in the names of the downloaded files)");
  $data_status = &make_files;
  if ($data_status) {
    $status_msg = $data_status;
    $err_warning = "<FONT COLOR=\"$credhi\">WARNING:</FONT> data retrieval error";
  } else {
    $err_warning = $status_msg = "";
  }
  ($msg = $status_msg) && ($msg = "ERROR: $status_msg");
  &add_history("END_DATA_EXTRACTION",$msg);
#
# # # # # # #   All data files have been processed.   # # # # # #
#
# copy the documentation info file for this data object
#   
  ($infostatus,$infoURL) = &copy_data_doc;
  $selection = "";
  &add_note(" ");
  $msg = ($infostatus eq "OK") ?
    "Documentation info file written." : 
			"*** Could not get documentation from $infoURL";
  &add_note($msg);
  
#
# bundle up all the files for this object
#
  &add_note("$dispobj data download request completed:");
  &add_note(scalar localtime());
  &add_history("B4BUNDLE_CALL","");
  $datapkgfilename = &bundle_em_up;
  $url_of_datapkg = "$url_of_objdir/$datapkgfilename";
  &add_history ("END_OF_BUNDLING_AND_COMPACTION","",
		"DOWNLOADURL",$url_of_datapkg,
		"READMEURL",$url_of_logfile,
		"INFOURL",$infoURL);

#   Would prefer to have next bunch of stuff after web display of
#   download URL.  In particular, this would mean that finish time
#   would be time after user actually got data.  However, in deferred
#   case (where STDOUT is no longer available), it appears that this
#   process dies during attempt to do web display, and therefore does
#   not write the "normal conclusion" message we expect.  (This despite
#   tests that made it appear that writing to a non-existent STDOUT
#   made no difference - sigh)

# tell user to download packaged file via email
  $email_address && &add_history("EMAIL_ATTEMPT",
		&send_email($email_address,
		    "Download of $objnameonly data available at URL below",
		    "$download_inquiry_url?process_id=$pid")
			);

  $now = localtime() . "\n";
  print $tracefile "\nData $dwnld_id_stamp: $dispobj request completed\n";
  print $tracefile "Data $dwnld_id_stamp: at $now \n";
  print $tracefile "Data $dwnld_id_stamp: === end of script $0 === \n\n";
  &add_history("EOJ");

#
# tell user to download packaged file
#
  $pkgname_warning = ($n_underscores == 0) ? 
	"" :
	"Note: whitespace in package name was replaced by underscores<BR>";
  $file_ext_warning = ($n_ext_underscores == 0) ? 
	"" :
	"Note: whitespace in file extensions was replaced by underscores<BR>";



  print <<ENDOFTEXT1;

  <hr noshade><p>
  
  <H2>
 <A HREF="$url_of_datapkg">Download</A> your packaged $objnameonly data now.<BR>
  </H2>

  $pkgname_warning
  $file_ext_warning

  <H2>$err_warning </H2> <B>$status_msg</B>
ENDOFTEXT1

  if ($infostatus eq "OK") {
    print <<ENDOFTEXT2;

  An
  	<FONT SIZE=+1>
		<A HREF="$infoURL">information file</A>
	</FONT> 
  for your data set is included in package<BR>
ENDOFTEXT2
  }

  print <<ENDOFTEXT3;
  A
	<FONT SIZE=+1>
		<A HREF="$url_of_logfile">README file</A>
	</FONT> 
  associated with your data set is included in package<BR>
  <BR>

  <HR NOSHADE WIDTH="100%">  

  <H3>  
  <A HREF="$back_to_opts">Return</A> to Download and Other Options menu
  </H3> 

  <HR SIZE=4 NOSHADE WIDTH="100%"><BR>
  
  <P>
  This is a trial system.  Please help us improve it by giving us some feedback.
  We would like to know what you liked/didn't like, what worked/failed.  Please 
  consider sending us some 
  <A HREF="mailto: $dbasemgr">mail</A>.  Thank you.
ENDOFTEXT3

} else {
#
# user confirm indicated a problem ... find out what they want to do
#
  &bad_confirmation
}
# 
# Close html file cleanly.
#
  print &HtmlBot;

#   Avoid "1 time use" diagnostic for various unused but seemingly
#   innocuous variables.  Deliberately not addressing this problem
#   for more suspicious variables.
  undef $chdrbar1;
  undef $cgobar;
  undef $webimages;
  undef $OOserverinfo;

  exit;
}


sub get0values {
   my ($status,$clean_obj_spec,$save_rec_sep);

#
# $objnsels comes in w/an unclosed (.  If there's nothing after that
# (, get rid of it (for the call to &get_column).  If there IS something
# after it, add a closing )
#
   $clean_obj_spec = $objnsels;
   $save_rec_sep = $/;
   $/ = '(';
   ((chomp $clean_obj_spec) == 0) && ($clean_obj_spec .= ')');
   $/ = $save_rec_sep;

   $zp = $determine[0];
   ($status,@zerovals) = &get_column($list,$clean_obj_spec,$zp);   
   ($status eq "OK") || &uh_oh($zerovals[0]);
#
# Remove duplicates from zerovals array
#   
   @zerovals = &unique_vals(@zerovals);
#
#
# Build selection list
# Add a param#value pair to selection list for every item in the list
#
   foreach $item (@zerovals) {
     $paramlist = "$zp"."#";
     push(@sel_list,"$paramlist"."$item");
   }
   return (@sel_list);
}


sub getallvalues {

# the previous selection list of parameters is passed in, one at a time
  my $presel=pop @_;

########				  if ( $maxlev == 1 ) {
########				    @vallist = @zerovals;
########				    return (@vallist);
########				  } 

#   change parameter list from param#value back into 
#   param0=val0,param1=val1 format
#   [Note: $presel possibly undefined in some circumstances as of 12 Dec 04]
#   [Regarding note: getallvalues called w/null arg list in 1-level case
#    Presumably that was the undefined; hence the code move here... and
#    a diagnostic for the future.  16 Oct 10
#   ]
#   [Note regarding note regarding note:  Nice idea, but a bug.  zerovals is
#    just data; required return is set of var#datum strings or some such.
#    Most recent, presumably better, analysis is that  "1-level case"  need not
#    come in here at all.  BTW, it never was  "1 JGOFS level"  anyway; it was
#    "user picked 1 'split by' variable, although offered a 'split by' variable
#    for each level excluding the 'bottom' level.  WJS 26 Dec 10]
  $presel || 
	&uh_oh("Internal error: empty selection list in multi-level download");
  ($selection = $presel) =~ tr/#+/=,/ ;
#  
#   OK ... maxlev is > 1, so we still need to get more info
#   remember to remove all leading whitespace from params (don't know where
#   this is done.  Addition of -z to list command (in get_column), however,
#   removes any whitespace previously added by list.  WJS Apr 04)
#
  $d=$determine[$thislev];
  ($status,@vallist) = &get_column($list,"$objnsels,$selection)",$d);
  &uh_oh($vallist[0]) unless ($status eq "OK");

#       
# Remove duplicates from vallist array
#   
   @vallist = &unique_vals(@vallist);
#
# keep the values for each parameter in a hash of lists (arrays)
# Need to make a hash of vallist arrays.  See Camel book pg 266-268
# Note:  key modified to be param+value (ie. leg+1 = leg1) otherwise
#        if duplicate value found at different level, higher level 
#        would replace previous level at that value (station1 over leg1)
# Also, need to save selection list from each level parameter
# How do I build param_list for lev 0 -> maxlev-2 when maxlev > 2 ?
#
#	 Next 2 lines commented out.  As of 12 Dec 04,
#	 $which undefined, here & in production server
#	 However, $keep is unused, which might explain why $which not
#	 causing trouble!
#	     $pvalkey = "$param"."_"."$which";
#	     $keep{$pvalkey} = [ @vallist ];
     

# 
# Build selection list
# Add a param#value pair to selection list for every item in the list
#
     $paramlist = "$presel"."+"."$d"."#";
     @sel_list = ();
     foreach $item (@vallist) {
       push(@sel_list,"$paramlist"."$item");
     }

     return (@sel_list);
}


sub make_files {

  @all_selections = @listovals;
  
  if ( $filesize eq "onebig" ) {
 #
 # This can probably be combined into one operation regardless of 
 # one vs multifile, but for initial testing phase, keep em separate ... (clc)
 # user requests all data in single data file
 #
  $filename = "$objnameonly";
  ($datafile_ext ne "EMPTY_FILE_EXTENT") && ($filename .= '.' . $datafile_ext);
  $errfilename = "$objnameonly.err";
  $fullfile = "$objdir/$filename";
  $fullerrfile = "$objdir/$errfilename";
  print $tracefile " $dwnld_id_stamp: create $filesize data file: $fullfile \n";
  print $tracefile " $dwnld_id_stamp: for $dispobj \n";
 #
 # write the data to a file & log # lines into download log
 #
   &write_data ( &make_complete_obj_spec_1($objnsels,""),
			$fullfile,$fullerrfile);
   &add_note ("... counting records in $fullfile");
   &add_note ("... " . &count_lines($fullfile) . " lines of data in $fullfile. \n"); 
   
 } else {

 # user requests data divided into multiple (moresmall) data files;
 # make data files (directory hierarchy already exists)
 #
  foreach $selection (@all_selections) {
    $selection =~ s/^\+//;		# remove leading + (maxlev=1)
    $temp = $selection;
 # make filename and selection list from param#value pairs
    ($filename = $temp) =~ tr/+/\//;	# replace + with /
    $selection =~ tr/#+/=,/; 		# replace # with = and + with ,
    ($datafile_ext ne "EMPTY_FILE_EXTENT") && ($filename .= '.' . $datafile_ext);
    $fullfile = "$objdir/$filename";
    $fullerrfile = "$objdir/$filename.err";
    $obj_spec = &make_complete_obj_spec_1($objnsels,$selection);
    print $tracefile " $dwnld_id_stamp: list $obj_spec \n";
    print $tracefile " $dwnld_id_stamp: to $fullfile \n";
 #
 # write the data to a file & log # lines into download log
 #
   &write_data ($obj_spec,$fullfile,$fullerrfile);
   &add_note ("... " . &count_lines($fullfile) . " lines of data in $filename. \n"); 
  }
 }
 return;
}


sub write_data {
my ($listobj,$datafile,$errfile) = @_;
my ($command);
my ($results,$exit_status,@status_info);
#
# Use the list program to get data listing (or use matlab/netcdf conversion 
# program to get a matlab/netcdf file)
#     list doesn't return bad status if &x error,
# but it does exit list [list 1.6 (assumed in download 1.2) should return bad
# status for all errors].
#     Errors go to STDOUT [also to -errout destination as of list 1.6.  
# However, parsing errors due to malformed list command do
# NOT go to -errout (nor do they contain &x)].
#     Must capture errs to a file 
# otherwise they cause a "malformed header from script" error that generates
# an httpd "500 Internal Server Error" preventing download-4 screen from being
# displayed. Send STDOUT to $datafile too, so error msg ends up in file and
# user is aware there was an error.  (Not sure if this is true if one
# uses CgiDie (via quit).  I think that program prints enough html to
# avoid 500 errors in all circumstances)
# 

  &add_note ("... creating: $filename");
  &add_note ("... for: $listobj"); 

#   If we are doing a per-var-value download, file names include var
#   values, which can include shell chars.  Enclose them in quotation marks
#   Obj specifier has always had this problem
  $datafile = '"' . $datafile . '"';
  $errfile = '"' . $errfile . '"';
  $listobj = '"' . $listobj . '"';
  if (  ($matlab_version) = ($format =~ /^matlab(.*)/)  ) {
    $makemat = $jgbindir . "/makemat" . $matlab_version;
    &check_x_access($makemat);
    $command = "$makemat $listobj > $datafile 2> $errfile";
  } elsif ($format eq "netcdf") {
    $makenetcdf = $jgbindir . "/makenetcdf";
    &check_x_access($makenetcdf);
    $command = 
	"$makenetcdf -maxwidth $listobj $datafile > $errfile 2> $errfile";
  } else {
    $command = "$list -errout $errfile $list_options $listobj > $datafile";
  }

  ($results,$exit_status,@status_info) = &backtick($command);
  ($exit_status == 0) && return; 

#   Sigh. "It" didn't work.  Orig code used do_shell_command and
#   do_shell_command would just quit, so, for now, let's just do that

#   Considering all the stdout and stderr redirection in $command, don't
#   see how we would get much back in $results
  ($results) ?
	&uh_oh (&format_backtick_return_status
			($command,$exit_status,@status_info,
					"return from command = $results")
	       )
			:
	&uh_oh (&format_backtick_return_status
					($command,$exit_status,@status_info)
	       );
#   Not that we will be here to return ...
  return;
}


sub count_lines {
#
# check file for errors; report total number of data records in file
# Now (download 3.3) just a record counter, since all the data writers
#    (list, makemat, makenetcdf) exit w/error status, and write_data
#    (above) will exit as a result).  Rewrite to return record count as
#    function value and die if error in calculating the count.
# Other issues:
#    1) 2nd parameter ($errfile) never used
#    2) Old, bad read error processing replaced (MUST use perl eof function
#	to distinguish between EOF & read error ... but after 5+ years of
#	being wrong about this, feel free to investigate the new assertion)
#    3) $prevln not initialized, but it's not in here any more
#    4) Reported $? in case of a  close  error
#    5) Sometimes ID'ed things w/global file name instead of file name received as
#	argument
#
  my ($datafile,$dummy) = @_;
  my ($nrec);
  ($datafile && (! $dummy)) || &uh_oh("Internal error: count_lines called w/wrong # args");

  open (FLIN, "< $datafile")
  	|| &uh_oh ("Error opening $datafile for read : $!");	
  $nrec = 0;
  while ( ! eof(FLIN) ) {
    $! = 0;
    if (defined (<FLIN>)) {
      $nrec ++;
    } else {
      &uh_oh ("... Error reading $datafile after record $nrec : $!");
    }
  }
  $! = 0;  
  close (FLIN) || &uh_oh ("... Error closing $datafile after record $nrec : $!");
#
  return $nrec;
}


sub unique_vals {
    my @list = @_;
    
# Remove duplicates from an array, order doesn't matter;
# see Perl Cookbook (Bighorn Sheep book) pg. 102
# Extracting unique elements from a list (straightforward method - 
#  slower but more easily understood)

   %seen = ();
   @uniq = ();
   foreach $item (@list) {
      unless ( $seen{$item} ) {
         # we have a unique one; keep it
         $seen{$item} = 1;
         push(@uniq, $item);
      }
   }
   return @uniq;
}


sub make_directory {
  my ($parent, $dirname, $cleanup) = @_;
  my ($dir);

  umask(022);
#
#   check that the parent string has no slash at end
  $tmp = $/;
  $/ = '/';
  chomp $parent;
  $/ = $tmp;

  $dir = "$parent/$dirname";

#
#   if it's cleanup time and this directory already exists, 
#   get rid of it and entire tree.  rmtree is in "File::Path"
#     Treatment of errors unknown.  In particular it does NOT return a status
  if ( ($cleanup eq "yes") && (-d $dir) ) {    
    eval { rmtree($dir) };
    $@ && print $tracefile "$dwnld_err_stamp: rmtree $dir failed: $@\n";
  }
#
#   mode used by mkdir looks at lowest 9 bits
  (-e $dir) ||
      mkdir ($dir,493) ||
	  print $tracefile " $dwnld_err_stamp: mkdir $dir failed: $!\n";
       
  return $dir;
}


sub bundle_em_up {
  
  chdir "$objdir";
#   Change #s in names of downloaded files if user asked 
  if ($renaming_files) {
    &add_history("BEGIN_FILE_RENAME","");
    ((-e $renamer_script) && (-r _)) || &uh_oh ("No access to $renamer_script - either file does not exist or cannot be read");
    $command = "perl -w $renamer_script $varvalsepchar";
    ($results,$exit_status,@status_info) = &backtick("$command");
    print $tracefile " $dwnld_id_stamp: doing: $command \n";
    if ($exit_status != 0) {
#       Don't expect anything in $results. Don't expect to come back here to
#       die, either.
      ($results) ?
        &uh_oh (&format_backtick_return_status
          ($command,$exit_status,@status_info,"return from command = $results")
                )
                        :
        &uh_oh (&format_backtick_return_status($command,$exit_status,@status_info)
                );
      die ("Unexpected return from  &uh_oh  after failed download-4 moresmallfiles renaming");
    }
    &add_history("END_FILE_RENAME","");
  }
#
# determine which archiving and compression routines to use
#
  if ( index($compress,"tar") > -1 ) {
#     use UNIX type utilities
#     UNIX compress selected by default (use ./* to avoid warning msg)
    $all = "./*";
    if ( $compress eq "targz" ) {
      $comp = "$compgz";
      $compext = "$compgzext";
    } else {
      ($compress eq "tar" ) && ($comp = "");
    }
  } else {
#     use PC/Mac type utilities
    $all = ".";
    $bundle = "$pcbundle";
    $pkgtype = "$pcpkgtype";
    $comp = "$pccomp";
  }
#
#    OK ... do bundle and optional compression
#    
  $tarfile = "$pkgname"."$pkgtype";
  $command = "$bundle $tarfile $all";
  print $tracefile " $dwnld_id_stamp: doing: $command \n";
  &add_history("BUNDLE_COMMAND",$command);

#   stdout redirect is not supposed to have anything useful, I guess.  Output file
#   is not referenced again in any OOserver perl file (incl this one).  File is not
#   always empty.  For example, it may include per-file zipping commentary.  Output file
#   IS included in what's finally sent to user
  ($results,$exit_status,@status_info) = &backtick("$command > bundle.out");
  &add_history("BUNDLE_STATUS",$exit_status);
  if ($exit_status != 0) { 
#     Don't expect anything in $results. Don't expect to come back here to
#     die, either.
    ($results) ?
	&uh_oh (&format_backtick_return_status
			($command,$exit_status,@status_info,
					"return from command = $results")
	       )
			:
	&uh_oh (&format_backtick_return_status
					($command,$exit_status,@status_info)
	       );
    die ("Unexpected return from  &uh_oh  after failed download-4 bundling");
  }
  $fnlpkg = "$tarfile";

#   compress archive file if user requested it
  if ($comp) {
    $command = "$comp $tarfile";
    $compfile = "$tarfile"."$compext";
    print $tracefile " $dwnld_id_stamp: doing: $command to make $compfile \n";
#     Comment above about "bundle.out" is also valid for "compress.out"
    ($results,$exit_status,@status_info) = &backtick("$command > compress.out");
    if ($exit_status != 0) { 
#	Don't expect anything in $results. Don't expect to come back here to
#	die, either.
      ($results) ?
	&uh_oh (&format_backtick_return_status
			($command,$exit_status,@status_info,
					"return from command = $results")
	       )
			:
	&uh_oh (&format_backtick_return_status
					($command,$exit_status,@status_info)
	       );
      die ("Unexpected return from  &uh_oh  after failed download-4 compression");
    }
    $fnlpkg = "$compfile";
  }

  print $tracefile " $dwnld_id_stamp: pkgd data: $objdir/$fnlpkg \n";
  return $fnlpkg;
}


sub copy_data_doc {
my ($status,$ext_URL);
#   copy the info (documentation) file for this data object
#	Note this cannot be done in general.  No reason that
#	info for object lives on node that serves its data.  Need
#	infoserver part of extended URL, lost by time we get to OOserver.
  chdir "$objdir";
  $docfile="$objnameonly".".htm";

#  Feb '10 info, etc status
#	There are 2 sets of problems.  First, which info to use; and 2nd,
#  what to pass it.  OOserver was never designed to use info, but downloader
#  did.  At first, it used INFOSERVER, which is the OOserver's own info
#  program, which might work if OOserver and data server are on
#  same box.  (? Not if data and OOservers had different roots ...
#  how DID the original download succesfully get info?!)  At some point, the
#  host associated with the data was used to access the info, as well as the
#  data.  This was OK as long as there was no INFOSERVER associated with
#  the data.  There's a problem if there WAS an INFOSERVER, since outer 
#  never passed the extended URL to the OOserver.  outer 3.3 will pass the 
#  extended URL to the OOserver.  otheropt 2.2f will pass it to the 
#  downloader.  download-1, 2, & 3 (each v 3.2 will) get that information
#  here (download-4 v 3.2).
#	The 2nd issue is what arguments to feed to info.  Original infos
#  (v1s - csh version; v2s - perl conversion of last v1 plus enhancements)
#  took an object spec from PATH_INFO.  Not sure if that spec could include
#  a remote host, since info ran strictly on the offset from jgofs_root/objects
#  where jgofs_root/htmlbin is where info lived.  info v3s (BCO-DMO hook)
#  wanted host information.  Somebody noticed that the link generated by 
#  outer included a "data=" portion of the extended URL.  The assumption was
#  made that that would always be there.  The OOserver in general and
#  the downloader in particular never provided that portion of the URL.
#  download4 v 3.2 will honor a data= in the extended URL (outer 3.3
#  does NOT send it).  If not present, a data= extended URL will be
#  constructed from env var URLOBJX (which is why outer 3.3 doesn't need
#  to send it).  One could argue that life would be easier if each of
#  outer, dir and info send a full {dir=,info=,data=}.  Stay tuned ...
#	Note that info v 3 et seq are still stuck with what to do if
#  they do NOT have an extended URL passed to them.  Go talk to the info
#  people ... (lots of people speak about themselves in 3rd person -
#  I get to be 4th and 5th, etc person, too!)

#	In case we happen to want OOserver's own infoserver
#  $objserver = "$protocol"."$OOserverinfo"

#   Build an extended URL to pass to whatever info we end up calling
#   Old info's should ignore it.  Newer info's should be happy!
#     Remove any leading http:// or // or whatever.  Could rely on
#   doc but this is easier.  Note that object specs that include jg/serv
#   can't have embedded //s.  Gee, I ought to write an object that does
#   NOT get invoked via serv, just to see what happens
  $ext_URL =   ($ENV{'PATH_INFO_data'})   ?   $ENV{'PATH_INFO_data'} : $urlobjx;
  ($dummy1,$dummy2,$dummy3) = (split m"//",$ext_URL,-1);
  if ($dummy3) {
    print $tracefile " $dwnld_err_stamp: Error copy_file_doc: "
			. "embedded // in object spec $ext_URL.  "
			. "Trying to get doc w/o extended URL \n";
    $ext_URL = "";
  } else {
    ($ext_URL = $dummy2) || ($ext_URL = $dummy1);
    $ext_URL = "{data=$ext_URL}";
  }

  if ($infofile = $dobj_infoserver) {
    $infofile = "http://" . $infofile;
  } else {
#     must handle local and remote objects differently
#     $objnode & $orig_objdir set up via parse_object_spec up top
    $host = ($objnode) ? $objnode : "$ENV{'SERVER_NAME'}";
    $objserver = "$protocol"."$host"."/jg/info";
    $infofile = "$objserver/$orig_objdir/$objnameonly";
  }
  $infofile .= $ext_URL;

  print $tracefile " $dwnld_id_stamp: getting  $infofile \n";

  $status = "NG";
  if (head("$infofile")) {
#	OK, we found the info file, so retrieve and print it to a local file
#	(well, would be better if we actually looked at http status ...)
    getstore "$infofile","$docfile";
    $status = "OK";
  } else {
#
# does it make sense to re-try with a statically defined INFOSERVER 
# (I don't think so.  WJS 21 Jan 09)
#    $infofile = "$protocol"."$OOserverinfo"."$objpath";
#    if (head("$infofile")) {
#     getstore "$infofile","$docfile";
#     $status = "OK";
#    } else {
     print $tracefile 
      " $dwnld_err_stamp: Error copy_file_doc: $dobject info file not found \n";
#    }
  }
  return $status,$infofile;
}


sub get_column
#   Input: file name of list executable
#	   object spec (form where sel/proj list is parenthesized after obj name)
# 	   name of var to extract from obj
#   Output: status string ("OK" or something else); followed by
#	      EITHER array of desired data (if status string = "OK")
#	      OR     status message (if status string != "OK")
{
  my ($list,$object,$key) = @_;
  my ($tmp,$command,$obj,$varlist,@varlist,$key_col);
  my ($LIST_FH) = "LIST_IN";

#   Apostrophes in next line to take care of empty string $list (I hope)
  (-e $list) || return "NON-EXISTENT_EXE","Could not find executable \'$list\'";
  (-x $list) || return "NON-EXECUTABLE_EXE","No x access for executable $list";

#   Be sure $key is in projection list of $object.
  ($obj) = ($object =~ /^\s*(.+)\)\s*$/);
  if ($obj) {
    $obj .= ",$key)";
  } else {
    $obj = "$object($key)";
    ($obj eq "($key)") &&
      return "EMPTY_OBJECT","No non-whitespace characters in object spec";
  }

#   Need -t in case data has embedded blanks or commas.  -z is a performance
#   win.  -forceheader in case all the data get selected out.  -l for
#   potential long (>4096 byte) records
  $command = "$list -t -f -c -forceheader -z -l \"$obj\"";
  $! = 0;
  (open ($LIST_FH, "$command |")) ||
			return $!,"Could not open pipe to command \'$command\'";

#   First line of output is the tab-separated varlist.  Find the $key variable
#   in this varlist.  Most of the time, there will be no list - what comes back
#   from list will be the single column resulting from the projection of $key.
#   However, this could change if the object spec includes projections and/or
#   the object defn includes projections.  First, there is a bug in the logic
#   that combines projection lists such that "sub-projections" are ignored, so
#   that if the object spec includes a non-$key variable, the resulting list
#   output will always include that variable.  Second, even if that bug gets
#   fixed, it's possible the object spec projection list will NOT include $key
#   (because that data is not wanted in the results).  In such a case, we
#   should throw out all the object spec projections, but that would involve
#   separating the projections from the selections in the object spec.
#   (Note that we cannot just throw out the whole sel/proj list - the selections
#   make a difference to the output of this routine)  Accordingly, we bite the 
#   bullet and set up to process a whole list
#     NB: potential white-space-in-varname issues are ignored.  Informal JGOFS
#   spec says embedded whitespace is illegal.  Don't know what it says about
#   leading/trailing.  Because of this, we don't fool w/ $key either.

  ($status,$rec,@err_array) = &get_JGOFS_record($LIST_FH);
  ($status eq "OK") || 
	return "READ_PROBLEM",&format_get_JGOFS_record_return_status($command,@err_array);

  chomp $rec;
  @varlist = split /\t/,$rec;
  for ($key_col = 0; $key_col < @varlist; $key_col++) {
    ($varlist[$key_col] eq $key) && last;
  }
  ($key_col == @varlist) && 
		return "KEY_NOT_FOUND",
		    "Could not find expected variable $key in object list $rec";

  $nvals = 0;
  ($status,$rec,@err_array) = &get_JGOFS_record($LIST_FH);
  while ($status eq "OK") {
    chomp $rec;
#     Special-case the normal, 1-column situation
#     For the general case (and maybe the special, too), could probably build
#	a regex to pick the data without splitting.  However, too lazy to
#	tangle w/the issue of empty fields, etc.  Besides, this logic is
#	actually easy to understand.
    if (@varlist == 1) {
#       Don't know why there's a trailing tab, but seems to be...
#	Reason: bug in list; fixed in list 1.6c
      $tmp = $/;
      $/ = "\t";
      chomp $rec;
      $/ = $tmp;
      $column[$nvals++] = $rec;
    } else {
      @var_vals = split /\t/,$rec;
      $column[$nvals++] = $var_vals[$key_col];
    }
    ($status,$rec,@err_array) = &get_JGOFS_record($LIST_FH);
  }
  ($status eq "EOF") || 
	return "READ_PROBLEM",&format_get_JGOFS_record_return_status($command,@err_array);
  return "OK",@column;
}


sub bad_confirmation {
  # user was unhappy with selections, and did not confirm them
  # what do they want to do now?

  if ($user_confirm eq "help") {
    # user gives up and has asked for help 
    $button="Help";
    $submit_msg=" to submit a request for assistance, ";
    print <<ENDOFTEXT;
    <H3>OK ... let's give up on this one ...</H3>
    <form method=POST action="$jgscdir/download-problem/">
ENDOFTEXT

    foreach $item (sort keys %form_info) {
      print qq|<input type="hidden" name="$item" value="$form_info{$item}"> \n|;
    }

  } else {
    # user wants to bo back and try again
    if ($dobjext eq "NO_VALID_DOBJEXT") {
      print <<ENDOFTEXT
      <H3>Sorry, we have lost our return checkpoint<br>
      Please use the browser back button and/or history to find a restart position
      </H3>
ENDOFTEXT
    } else {
      $button="Try again";
      $submit_msg=" to go back and remake $objnameonly selections, ";
      print <<ENDOFTEXT;
      <H3>OK ... let's go back and try working on the $objnameonly data again ...</H3>
      <form method=POST action="$jgscdir/download-1$dobjext?$orig_subsels">
      Press <input type="submit" value="$button" width="80" style="background:blue;color:white"> $submit_msg
      </form></H3>
ENDOFTEXT
    }
  }
#
# also give them the option of returning to a previous location
#
  print <<ENDOFTEXT;


  <H3>... or perhaps you would like to go back to the
  <A HREF="$back_to_opts">Download and Other Options menu</A> and start over again 
  or use your browser's 'Go' menu to return and relocate the data object.</H3>
ENDOFTEXT

}


sub create_readme {
# make a README logfile for this data request
#
  my ($save_stat);
#
  $! = 0;
  (open (LOGF, "> $logfile")) || (return $!); 
#
  $! = 0;
  print LOGF "README file for requested data object: $dispobj \n";
  print LOGF (scalar localtime()),"\n \n";
  $save_stat = $!;
#
  close LOGF;
  return $save_stat;
}

sub create_history {
# make a HISTORY for this data request
#
  $! = 0;
  (open (LOGH, "> $historyfile")) || (return $!); 
  close LOGH;
  return 0;
}


sub add_note {
  my (@comment)= @_;
#  
# add comment to the log file 
  if ( -w "$logfile" ) {
     open (LOGF, ">> $logfile");
     print LOGF "@comment \n";
     close LOGF;
  }
}

sub add_history {
  my (@tagged_comments)= @_;
  my ($hist_sep_string) = ' | ';
  my ($now,$i);
#  
# add timestamped, tagged comment to the history file 
  $now = localtime();
  if ( -w "$historyfile" ) {
    open (LOGH, ">> $historyfile");
    $i = 0;
    while (defined $tagged_comments[$i]) {
      print LOGH $now,$hist_sep_string;
      print LOGH $tagged_comments[$i++],$hist_sep_string;
      (defined $tagged_comments[$i]) && (print LOGH $tagged_comments[$i++]);
      print LOGH "\n";
    }
    close LOGH;
  }
}


sub mis_match {
  my ($det_act, $det_exp)= @_;
#
# $det_act is the actual parameter name found by list
# $det_exp is the user-specified parameter we expected to match
#
# We need to notify user of a problem. 
# annotate an error log file for user
  if ( -w "$logfile" ) {
     open (ERRTXT, ">>"."$logfile") ;
     print ERRTXT "Working on: $selection \n";
     print ERRTXT "   unable to process request due to parameter mismatch: \n";
     print ERRTXT "   user selected parameter [ $det_exp ] is not equal to\n";
     print ERRTXT "   [ $det_act ] the actual parameter found in the data object\n";
     close ERRTXT;
  }
}

sub send_email
{
  my ($recipient,$subject,$message) = @_;
  my ($command,$status,$host_wo_port);
#   Can do job w/email client name, or can connect to port 25 of local
#   host or another host, or ???

  $status = &pre_validate_email($recipient);
  ($status eq "OK") || return $status;

  ($host_wo_port) = split /\:/,$ENV{"MYADDR"};
  $host_wo_port || ($host_wo_port = $ENV{"MYADDR"});

  $! = $? = 0;
#   From: before Subject: or you will live in interesting times
#   This stuff works empirically only.  Did not, for example, work with
#   mailx mail client
  $! = $? = 0;
  $mail_pid = open (MAIL_HANDLE,"| $email_sender $recipient");
  defined ($mail_pid) || return "open_failure__\$!=$!;__\$?=$?";
  $! = 0;
  print MAIL_HANDLE 'From: download@' . $host_wo_port . "\n";
  ($! == 0) || return "print_failure__\$!=$!";
  print MAIL_HANDLE 'Subject: ' . $subject . "\n";
  ($! == 0) || return "print_failure__\$!=$!";
  print MAIL_HANDLE "\n";
  ($! == 0) || return "print_failure__\$!=$!";
  print MAIL_HANDLE $message . "\n";
  ($! == 0) || return "print_failure__\$!=$!";
  close MAIL_HANDLE;
  return (($! == 0) && ($? == 0)) ? "OK" : "close_failure__\$!=$!;__\$?=$?";
}

sub pre_validate_email
{
  my ($recipient) = @_;
  ((-e $email_sender) && (-x _)) ||
			return "existence/access_problem_with_$email_sender";
  (($recipient =~ tr/@//) == 1)  || 
			return "badly_formatted_email_address_$recipient";
  return "OK";
}

sub make_complete_obj_spec_1
#  Given 2 pieces of an object spec, make a good one
#  Named _1 since there may be more of these
#  In this one, piece 1 is of the form
#	objname(
#	   or
#	objname(sel_proj
#  Piece 2 is a projection, possibly empty
{
  my ($piece1,$piece2,$dummy) = @_;
  my ($piece1_frag1,$piece1_frag2,$complete_objspec);
  ((defined $piece2) && ( ! (defined $dummy))) ||
		&uh_oh("Internal error: make_clean_obj_spec_1 called w/wrong # args");
  $piece1 || 
	&uh_oh("Internal inconsistency: make_clean_obj_spec_1 expects X( or X(Y; got empty string (or 0)");

#   Note that a selection can have (s in it, so we cannot test for only 1 (
  ($piece1_frag1,$piece1_frag2) = split /\(/,$piece1;
  (defined $piece1_frag2) || 
	&uh_oh("Internal inconsistency: make_clean_obj_spec_1 expects X( or X(Y; got $piece1");

  $piece1_has_sel_proj = ($piece1_frag2 ne "");
  if ($piece2 eq "") {
    $complete_objspec = ($piece1_has_sel_proj) ?   $piece1 . ')'  :  $piece1_frag1;
  } else {
    $complete_objspec = ($piece1_has_sel_proj) ?
		$piece1 . ',' . $piece2  . ')'   :    $piece1 . $piece2  . ')';
  }	
  return $complete_objspec;
}

sub uh_oh {
#
# We encountered a fatal error.  Inform user with copy of 
# error message, close the html page and exit this program.
#
  @errmsg = @_ ;
  $errsta = "0";
  print $tracefile " $dwnld_err_stamp: Download Fatal Error Condition: \n";
  print $tracefile " $dwnld_err_stamp: @errmsg \n";

  &add_note ("Fatal error msg: @errmsg");

  $msg1 = ($dispobj) ? "processing the $dispobj data" : "";
  print <<ENDOFSUB1;
    Sorry, we have encountered a problem $msg1:<BR>
    @errmsg <BR>
  <BR>
ENDOFSUB1

  (-e $logfile) && print "There may be additional " .
    			"<A HREF=\"$url_of_logfile\">information </A> " .
			"about the processing status.<BR>";
  
  
  print <<ENDOFSUB;
    <PRE><H3>Please <A 
    HREF="$back_to_opts">return</A> to the Download and Other Options menu
    or try using your browser's 'Go' menu to return and relocate the data object.</H3></PRE>
  
    <form method="post" action="$jgscdir/download-problem">
    <input type="hidden" name="levelparams" value="$levelparams">
    <input type="hidden" name="compress" value="$form_info{'compress'}">
    <input type="hidden" name="list_options" value="$list_options">
    <input type="hidden" name="format" value="$form_info{'format'}">
    <input type="hidden" name="dobject" value="$form_info{'dobject'}">
    <input type="hidden" name="dobjext" value="$form_info{'dobjext'}">
    <input type="hidden" name="dobj_dirserver" value="$form_info{'dobj_dirserver'}">
    <input type="hidden" name="dobj_infoserver" value="$form_info{'dobj_infoserver'}">
    <input type="hidden" name="dispobj" value="$dispobj">
    <input type="hidden" name="bulk" value="$form_info{'bulk'}">
    <input type="hidden" name="compress" value="$form_info{'compress'}">
    <input type="hidden" name="subsels" value="$subsels">
    <input type="hidden" name="subsdisp" value="$subsdisp">
    <input type="hidden" name="errsta" value="$errsta">
    <input type="hidden" name="errmsg" value="@errmsg">
  
    <H3>&nbsp or press <font color="blue"><input width="80" type="submit" value="help"></font> 
          to submit a request for assistance.</H3>
    </form>

    <p><HR SIZE=4 NOSHADE>   
ENDOFSUB
  
# 
# Close html file cleanly and exit this program.
#
  print &HtmlBot;
  exit;
}
