#!/usr/bin/perl -w
#   add-persistent.pl
#    Create a jgofs object (w/trimmings) from PATH_INFO/QUERY_STRING combo
#    Problem: user has gone through optionserver and done something; say, joined
#	2 objects.  User would like to come back tomorrow and not have to go
#	through the joining again.
#    Solution: save the results of the join as a jgofs object "somewhere"
#	(read on)
#    Architecture:
#	We need a directory for .objects & .remoteobjects entries for this
#	object.  Decided to
#	    a) keep these objects on OO server
#	    b) have a {OO_objectroot}/persistent_object object  root
#	    c) under that root, have "many" directories
#	      By default, use REMOTE_ADDR/REMOTE_HOST string
#	       [Someday] allow user to create a directory
#	       [Someday] change default directory to a "personal" directory
#			(after login?)
#	Let user name object (.objects & .remoteobjects files) and provide
#	    .remoteobjects comment.  Any temp files user needs will be kept
#	    in a per-object subdirectory of {USETEMPDIR}/persistent_object.
#	    A particular set of temp files should carry
#	    a unique stamp.  This will leave a trail if the object changes. 
#	Basic object is a .remote_objects entry of what comes in, not
#	    requiring re-serving or temporary files (or .objects file entry)
#	    at all.  Optionally, however, make a copy of the data and serve
#	    the copy w/defgb & jgof_read.pl.  This DOES require a .object
#	    file entry and "temporary" files (how long temporary is remains
#	    an interesting question)
#	Make an info entry consisting of the URL of an/the input object.
#	    Idea is that user of saved object can reach doc for a real object
#	    eventually.
#	Someday, lock .remoteobjects and .objects  against other use while
#	    either is being modified.  This will be a bigger problem when we
#	    allow changes & deletes, which have to look things up.

$version = "add_persistent.pl  version 1.3a   5 Sep 2014";
#		*** See "someday" sentences in synopsis above for future work.
#		*** Remove" someday"s when work is done!. 
#   5 Sep 14.  version 1.3a  WJS
#     Replace `` with call to backtick
#     Protect path info string from shell when giving it to parse_path_info.  Don't
#   know why this ever worked if it's needed now ...
#  29 Aug 14.  version 1.3a  WJS
#     Get location of  mv  program from build-env subsystem
#  25 Aug 07.  version 1.3  WJS
#     Be sure per-user .objects files have entries for joinmethod, etc
# 	Otherwise, they might not be able to save objects generated on 
#	OOserver itself.  For example, if user does join and wants to
#	save it, obj defn in .remoteobjects is 
#		//optserver/jg/serv/user-persistent_dir/optjoin(obj1,obj2)
#  27 Aug 05.  version 1.2a  WJS
#     Bug fix - test for existence of env vars before testing their values
#     Bug fix - test for existence of objects/persistent_objects
#  27 Oct 04.  version 1.2  WJS
#     Allow deletion of object.  Note this does NOT clean up any persistent
#	data files (including timecnv defgb optional files, etc).  In its
#	generality, that problem is intractable, since it requires parsing
#	a .objects file entry, knowing about defgb, etc.
#  21 Sep 04.  version 1.2  WJS
#     "Copy of data" stuff needs better parsing of QUERY_STRING
#     Add delete option - not yet implemented
#  20 Aug 04.  version 1.2  WJS
#     Combine w/add_persistent_driver.pl
#     Option to make copy of data, and serve it w/defgb(jgof_read.pl(file))
#     Remove special timecnv hooks.
#     Change perl location
#     Change some debug stuff to point to optserv1
#     Validate more input fields.  In particular, don't trust stuff we thought
#	arrived as a "hidden" variable
#     Use algorithm instead of list to ID "local" objects
#	[Needs wjs_web_perl_utilities.pl]
#	[Begin 1.2]

#  23 May 04.  version 1.1b  WJS
#      Put version in html output as a comment (although since there is no
#    html display from this module, don't know if it'll do much good)
#      Automatically change user-supplied blanks in object name to underscores
#    per Bob's request.  Don't allow #s in name to match restriction in
#    download (although that's a file name and this isn't)
#      Make no objectname a separate error from name w/illegal character
#       [Begin 1.1b]
#  16 Jul 00.  version 1.1a  WJS
#      Add statisticker to list of local objects.
#	[Begin 1.1a]
#  17 May 00.  version 1.1  WJS
#      No more distinction between "optmethod"s and "datamethod"s.
#	[Begin 1.1]
#  13 Sep 99.  version 1.0a  WJS
#      Add time stamp to info files we generate
#   9 Sep 99.  version 1.0a  WJS
#      Bug fix: datajoinumethod, etc come from OO_server's top level .objects
#    file.  Refine logic with respect to "empty" .objects subdir - when 
#    does this mean "not spec'd" and when does it mean "want top level"
#      Improve error message about allowable chars in remobj name
#	[Begin 1.0a]
#   3 Aug 99.  version 1.0  WJS
#      Add timecnv hook.
#  22 Jul 99.  version 1.0  WJS
#	[Needs cgi-lib.pl]
#	[Needs pid_file_cleanup.pl, which needs valid_number.pl]
#	[Begin 1.0]

{
  require ("pid_file_cleanup.pl");
  require ("cgi-lib.pl");
  require ("wjs_web_perl_utilities.pl");

  $this_programs_file_spec = $0;

  $build_opt_env = "./build-opt-env.pl";

  $pid_file_cleanup_debug_env_var = "PID_FILE_CLEANUP_DEBUG";

#   NB: Excellent chance that as of v 1.2, debug stuff is flaky
  $debug = $ENV{"ADD_PERSISTENT_DEBUG"};
  defined($debug) || ($debug = "F");
  $debug = ($debug =~ /^(TRUE|true|T|t|Y|y|1)$/) ? 1 : 0;
  $debug_driver = $ENV{"ADD_PERSISTENT_DRIVER_DEBUG"};
  defined($debug_driver) || ($debug_driver = "F");
  $debug_driver = ($debug_driver =~ /^(TRUE|true|T|t|Y|y|1)$/) ? 1 : 0;
  $debug_either = ($debug || $debug_driver);

  if ($debug_either) {
    ($test_path_info = $ENV{"PATH_INFO"}) ||
	($test_path_info = "//optserv1.whoi.edu:8200/mathmethod.html0");
    $test_server = "optserv1.whoi.edu";
#       Try to choose an "unreal" port, mostly so that JGTEMP, below,
#	won't have nobody-"somebody" ownership problems.
    $test_port = "32767";
    $test_remote_host = "fleetlink.whoi.edu";
    $test_path_info = "//globec.whoi.edu:8081/globec/gb/test/test.html0";
    $test_server = "optserv1.whoi.edu";
    $ENV{"SERVER_NAME"} = $test_server;
    $ENV{"SERVER_PORT"} = $test_port;
    $ENV{"PATH_INFO"} = $test_path_info;
    $ENV{"REMOTE_HOST"} = $test_remote_host;
    $ENV{"OPTHOME"} = "/data/wsass/port8200/experimental";
    $ENV{"OPTRUNDIR"} = "optbin";
    $ENV{"MYADDR"} = "$test_server:$test_port";
    $ENV{"DEFAULT_PORT"} = $test_port;
    $ENV{"JGTEMP"} = "/tmp/$test_port";
#	Purpose of next line was to point to a DIFFERENT build-opt-env.pl
#	However, at moment, don't have one
    $build_opt_env = $ENV{"OPTHOME"} . "/" . 
				$ENV{"OPTRUNDIR"} . "/build-opt-env.pl";

    &printheader();
  }

#     Hard to tell if do command works.  It's doc'ed to return the last
#     evaluated line of the "done" file.  However, what if file isn't
#     there, or there are compilation errs, etc?  Some testing seems to
#     show that $! is set to "No such file" even if do works.  However,
#     if $! is NOT "No such file", it seems to indicate an appropriate
#     error; eg, "Permission denied".  Wouldn't expect $? to be set
#     and it's not.  $@ had a chance, but isn't set either...
#     Decided to test for read access; otherwise let chips fall...
#	-r does NOT set $! for "Permission denied", so set it up
#     ourselves.  Seems to be set for "file not found"...  Fun w/
#     string/numeric context trying to set $!, too.
#     (Since we're perl "do"-ing, -r is needed rather than -x... I think)
  $! = 0;
  if ( ! -r $build_opt_env) {
    $msg = ($! == 0) ? "Permission denied" : $!;
    &quit ("Cannot read $build_opt_env: $msg");
  }

#   Note that when invoked as action routine of form, we do NOT have
#   the PATH_INFO & QUERY_STRING-related output of build-opt-env
  require "$build_opt_env";

###  if (1) {
  $debug_either && &dump_environment_variables();

#    Directories
  foreach ('OPTHOME','JGTEMP','USETEMPDIR','OPTRUNDIR','JGSCRIPTDIR','MVPROG') {
#	JGSCRIPTDIR does NOT come from $build_opt_env (as of Aug 05), 
#	but we do not know that here. (It comes from opt-build-env.pl via
#	$build_opt_env)
    defined ($ENV{"$_"}) || 
      &quit ("Internal problem.  ",
			"Did not get defined env var $_ from $build_opt_env");
  }
  $tmpdir_root = &abs_filespec($ENV{"JGTEMP"},"Env var JGTEMP");
  $tmpdir = &abs_filespec($ENV{"USETEMPDIR"},"Env var USETEMPDIR");
  $jgofs_root= &abs_filespec($ENV{"OPTHOME"},"Env var OPTHOME");
  $htmlbin_dir = &rel_filespec($ENV{"OPTRUNDIR"});
  $jg_cgi = &rel_filespec($ENV{"JGSCRIPTDIR"});
#   object_root		Directory (absolute) from which directories
#			that contain .objects files descend 
#   persistent_object_root	Directory (absolute) from which directories
#				that contain persistent objects'
#				.objects files descend
#				Must be a subdir (to some depth) of object_root
  $object_root = "$jgofs_root/objects";
  $persistent_object_root = "$object_root/persistent_objects";
  &check_r_access($persistent_object_root);

#    Form action routine
  $form_action = &file_system_to_web_cgi
			($this_programs_file_spec,"/$jg_cgi",$jgofs_root);

  ($remote_host) = ($tmpdir =~ m"^$tmpdir_root/(.+)$");
  $remote_host  || ($remote_host = "?");

  $htmlbin_dir = "$jgofs_root/$htmlbin_dir"; # Where dir, etc are
  $bin_dir = "$jgofs_root/bin";		# Where listvar, etc are
  $util_dir = $bin_dir;			# Where parse_path_info stuff is
  $methods_dir = "$jgofs_root/methods";	# Where defgb is

#   Next 3 lengths empirically determined.
  $maxlen_remobj_name = 17;
  $maxlen_remobj_investigator = 21;
  $maxlen_remobj_comment = 50;

  ($debug) ? &get_dummy_form_info() : &ReadParse(*form_info);

#     Main purpose of putting form action routine on form as a hidden
#   variable is to distinguish between use of this program in the
#   "put the form up" and "process the form results" modes.  
#   That's because ReadParse looks at QUERY_STRING for input as well as 
#   at the form.
#     The consistency check is just on general principles - anyone who de-
#   liberately mis-routes things here can change the hidden value as well.
  $after_submit = &get_form_var("form_action","OPT","FILESPEC");
  if ($after_submit) {
      ($after_submit eq $form_action) ||
	 &quit ("Submit action routine should be same as form value"   ,
		"Action = $form_action; Form value = $after_submit"     );
  }

  if ($after_submit) {
     &process_form;
  } else {
     &print_form;
  }

#   $version used in &quit, which gets in here via require.  Hence we
#   have a "used only once" diagnostic
  undef $version;

  exit;
}

sub print_form
{
{
#  add_persistent_driver.pl			WJS  Jul 99
#  Basic job is to copy .shtml form to stdout.  While doing so, it
#    inserts some environment stuff as hidden variables, so that
#    add_persistent.pl, the form's submit routine, can have them.  It also
#    creates a unique id for temp files used in this connection, and passes
#    that along.  It also "handles" the .shtml file's #include statements,
#    while ignoring #execs

  $unique = $$;

#   Send along PATH_INFO and QUERY_STRING.  Values from $build_opt_env
#   not always exactly what we want.  Also, we may eventually want
#   extended URL stuff.  If we don't have a PATH_INFO, odds are excellent
#   that we are dead.  However, for all we know, $build_opt_env is smarter
#   than we are (as of Jul 99, it needs PATH_INFO, so this is moot), so
#   struggle a little bit
  $path_info = $ENV{"PATH_INFO"};
  $path_info || ($path_info = $ENV{"OBJEXT"});
  $path_info || ($path_info = $ENV{"OBJECT"});
  $path_info || &quit ("No object information reached this program");
  (defined ($query_string = $ENV{"QUERY_STRING"})) || ($query_string = "");

  $html_dir = ".";			# Where add_persistent.shtml lives

#    Assuming no protection problems, either user has temp
#    directory, but no persistent object directory, or
#    there is no node-specific temp directory for this user
#    Latter shouldn't happen, but if we're running online and
#    forget to set REMOTE_, that's the situation we're in.
#    build-opt-env.pl doesn't like this at the moment (Jul 99),
#    but maybe some day it will be legal.
  $per_host_persistent_object_root = $persistent_object_root;
  $remote_host && ($per_host_persistent_object_root .= "/$remote_host");

#    Form action routine
  $form_action = &file_system_to_web_cgi
			($this_programs_file_spec,"/$jg_cgi",$jgofs_root);

#    Data files
  $html_file = "$html_dir/add_persistent.shtml";

  $debug_driver && &redefine_files();

#    #include values in add_persistent.shtml that we will deal with.  Anything
#    not on this list makes us issue an error
  $directory_key = "add_persistent.directory";
  $object_key = "add_persistent.objectname";
  $hidden_key = "add_persistent.hidden";
  $name_text_key ="add_persistent.name_text";
  $comment_text_key ="add_persistent.comment_text";

#    Presumably build-opt-env.pl took care of temp dir stuff.  However,
#    leave it here  1) in case we want to change location from that in
#    build-opt-env  2) build-opt-env doesn't check that dir was created OK, etc
  &make_dir($tmpdir);

#    Get "display object" out of environment (put there by build-opt-env)
  ($dispobj = $ENV{"DISPOBJ"}) ||
			&quit("No object information reached this program");

  &printheader();

#    Copy .shtml file to stdout, detecting and acting on #include
#    directives and inserting proper form action routine
  open (FILE,$html_file) || &quit ("Cannot read $html_file : $!");

  $need_to_print_form_action=1;

  while (<FILE>) {
#     Look for <!--#include file="filename", allowing embedded blanks
    if (/<!-- *#include +file *= *"(.*)"/) {


      if ($1 eq $directory_key) {
#	  Give user choice of where new object should live.  For now,
#	  list all directories in JGTEMP, defaulting to "theirs"
#	  (Note that although we list JGTEMP, the resulting directory will
#	  be in the object directory tree, not the temp tree)
#	  Don't list directories if they can't be used - see can_update_files
	$choices = 0;
	(opendir(DIR,$tmpdir_root)) || &quit ("Cannot open $tmpdir_root: $!");
	while (defined ($dir = readdir(DIR))) {
#	    Skip non-directory files and . and ..
	  (-d "$tmpdir_root/$dir") || next;
	  (($dir eq ".") || ($dir eq "..")) && next; 
	  $selected = ($dir eq $remote_host) ? " selected" : "";
	  $selected &&  &make_dir($per_host_persistent_object_root);
	  if (&can_update_files("$persistent_object_root/$dir")) {
	    print "<option$selected>$dir";
	    $choices++;
	  }
	}
	if ($choices == 0) {
#	    Should never get here.  If build-opt-env has made "usual"
#	    default directory, make_default_persistent_obj_dir will have
#	    been called above, and should have done an acceptable job
#	    as far as can_update_files is concerned.  However, who knows?
	  &make_dir($per_host_persistent_object_root);
	  &can_update_files($per_host_persistent_object_root) ?
	    print "<option selected>$per_host_persistent_object_root"  :
	    &quit ("Cannot find/make proper directory for persistent object");
	}


      } elsif ($1 eq $hidden_key) {
#	  Pass parameters to add_persistent.pl via hidden variables in form
	$h = "input type=\"hidden\"";
	print "<$h name=\"form_action\" value=\"$form_action\">\n";
	print "<$h name=\"path_info\" value=\"$path_info\">\n";
	print "<$h name=\"query_string\" value=\"$query_string\">\n";
	$tmp = $ENV{"SERVER_NAME"};
	print "<$h name=\"server_name\" value=\"$tmp\">\n";
	$tmp = $ENV{"SERVER_PORT"};
	print "<$h name=\"server_port\" value=\"$tmp\">\n";
	print "<$h name=\"unique\" value=\"$unique\">\n";
#	  Next may someday come from form
	print "<$h name=\"investigator\" value=\"$remote_host\">\n";

      } elsif ($1 eq $object_key) {
	print $dispobj;

      } elsif ($1 eq $name_text_key) {
	print "<input type=\"text\" name=\"rem_obj_name\"" .
	      " size=$maxlen_remobj_name>\n";

      } elsif ($1 eq $comment_text_key) {
	print "<input type=\"text\" name=\"descrip\"" .
	      " size=$maxlen_remobj_comment>\n";

      } else {
	&quit("Don't recognize requested #include $_");
      }


#     Look for <form method="post", allowing embedded blanks.  If found,
#     replace with action routine from this file.
    } elsif (/< *form +method *= *\"post\"/) {
#	Ignore commented out form action lines
      if ( ! /^< *!/ ) {
	$need_to_print_form_action ||
		&quit (">1 uncommented form action line in $html_file");
        print "<form method=\"post\" action=$form_action>\n";
        $need_to_print_form_action = 0;
      }

    } else {
      print $_;
    }

  }

  close FILE;
}

sub can_update_files
#   See if user can update .objects and .remoteobjects in given directory
#   If either file doesn't exist, user must be able to create it
#   Presumably if directory doesn't exist at all, we'll get FALSE out of this
{
  my ($dir) = $_[0];
  my ($okobj,$okremobj);
  $okobj = (-e "$dir/.objects") ? (-w "$dir/.objects") : (-w $dir);
  $okremobj = (-e "$dir/.remoteobjects") ?
				(-w "$dir/.remoteobjects") : (-w $dir);
  return ($okobj && $okremobj);
}

sub redefine_files
{
  $bin_dir = "$jgofs_root/bin";		# Where listvar is
  $util_dir = $bin_dir;			# Where parse_path_info stuff is
  $html_dir = ".";			# Where timecnv.shtml lives
  $object_root = "$jgofs_root/objects";	# Where objects are
  $persistent_object_root = "$object_root/persistent_object";

  $form_action = &file_system_to_web_cgi
			($this_programs_file_spec,"/$jg_cgi",$jgofs_root);

  $html_file = "$html_dir/add_persistent.shtml";

#	Testing from my home directory on globec
  $object_root = "/data5/globec/objects/globec/gb/test";
  $persistent_object_root = "$object_root/persistent_object";
}
}

sub process_form
{
### &dump_input_info (',',%form_info); # Comma should be irrelevant here
#	path_info		"Original" PATH_INFO (w/html escapes removed)
#	query_string		"Original" QUERY_STRING (w/html escapes removed)
#   Get input
#		From form
#     Name of persistent .objects directory 
#     Object name and possibly comments
#     Flag allowing/disallowing overwrite of existing object 
#     Object creator (investigator field of .remoteobjects)
#     brev/html flag
#		From driver routine
#     unique		Some string unique to this job
#     myaddr		Possible JGOFS alias for this node:port
#     server_name	$ENV{"SERVER_NAME"}
#     server_port	$ENV{"SERVER_PORT"}
#     path_info		$ENV{"PATH_INFO"} or desperate attempt
#     query_string	$ENV{"QUERY_STRING"}
#		Optionally from driver routine
#     Lengths of fields of .remoteobjects file entries
# NB: other OO programs remove "htmlescape"s from PATH_INFO & QUERY_STRING
#     before putting them on form.  add_persistent_driver does not.  Not
#     sure what trouble we get into...

#     persistent_object_data_root Directory (absolute) from which directories
#				that contain persistent objects' data (like
#				defgb .ind files) descend.  Data files
#				start in this dir - get moved to an object-
#				specific subdir of this root
  $persistent_object_data_root = "$tmpdir/persistent_objects";

#   Get "this node"'s name:number.  Logically, could come from
#   server logicals or our alias.  Treat port 80 as unspec'd (idea stolen from
#   dir code as of Jul 99)
  $server = &get_form_var("server_name","REQ");
  $server_port = &get_form_var("server_port","OPT","NUMBER");
  ($server_port eq "80") && ($server_port = "");
  $server_port && ($server .= ":$server_port");
  $myaddr = &get_form_var("myaddr","OPT");
  $myaddr || ($myaddr = $server);

#   Files/directories
#     persistent_object_dir_file Directory (abs or relative) for this
#				  persistent object's .objects file
#				Must be a subdir (to some depth) of object_root
  $persistent_object_dir_file =
		&get_form_var("persistent_object_dir_file","REQ","FILESPEC");

#   Programs
  $htmlesc = "$bin_dir/htmlesc";
  $parse_path = "$util_dir/parse_path_info";
  $dir_program = "$htmlbin_dir/dir";
  $jgof_read = $ENV{"OPT"} . "jgof_read.pl";
  $defgb_method_name = $ENV{"OPT"} . "defgb";
#   Security books suggest avoiding potential problems with PATH, so
#   don't just use  mv ... and hope that MVPROG not defined as just  mv  !
#   If no MVPROG provided, go for the default defn, which DOES include a directory spec
  ($mv = $ENV{"MVPROG"}) || ($mv = `which mv`);
  chomp $mv;
  &check_x_access($mv);
  &check_x_access($htmlesc);
  &check_x_access($parse_path);
  &check_x_access($dir_program);

  $path_info = &get_form_var("path_info","REQ","NOCHECK");
  $query_string = &get_form_var("query_string","OPT","NOCHECK");
   
  $change_add_delete = &get_form_var("change_add_delete","REQ");
  ($change_add_delete =~ /^(change|add|delete)$/) || 
      &quit("For form variable change_add_delete, ",
	"please provide a value of either \'change\', \'add\', or \'delete\'",
	"string causing problem: $change_add_delete");

  $unique = &get_form_var("unique","REQ");

#   Re-generate pieces of path_info (don't get this from build-opt-env
#   while in form processing routine
  $parse_path_command = $parse_path . " -nonewline " . '"' . $path_info . '"';
	($path_info_string,$exit_status,@status_info) = &backtick($parse_path_command);
	($exit_status == 0) || &quit (
                            &format_backtick_return_status
					($parse_path_command,$exit_status,@status_info,"return from command = $path_info_string")
                                );
  %path_info = split(/[,=]/,$path_info_string);
  $object = $path_info{"object"};
  ($protocol = $path_info{"protocol"}) || ($protocol = "html");
  ($level = $path_info{"level"}) || ($level = 0);

#   Pieces of .remoteobjects entry
  $remoteobjects_name = &get_remoteobjects_name
				($change_add_delete,($object =~ m".*/(.*)"));
  $comment = &get_remoteobjects_comment();
  $investigator = &get_remoteobjects_investigator();

  $htmlbrev = &get_form_var("htmlbrev","OPT");


  $persistent_object_dir = (persistent_object_dir_file =~ m"^/") ?
		 $persistent_object_dir_file  :
		"$persistent_object_root/$persistent_object_dir_file";
  (  ($persistent_object_dir_file)
		  = ($persistent_object_dir =~ /^$object_root(.*)/)  )
	||
    &quit("$persistent_object_dir not a subdir of $object_root");
  $source_remoteobjects = "$persistent_object_dir/.remoteobjects";
  $source_objects = "$persistent_object_dir/.objects";

  $copy_remoteobjects = "$tmpdir/remoteobjects_copy$unique";
  $copy_objects = "$tmpdir/objects_copy$unique";
#   Note: the way we do things, $copy_remoteobjects should never be left
#   after we're done.  However, a) it's logically a temp file and we might
#   change things so it is left  b) this program could always die before
#   removing it...
  push (@tempfiles,$copy_remoteobjects);
  push (@tempfiles,$copy_objects);

  if ($change_add_delete eq "delete") {
    (-e $source_remoteobjects) || 
      &quit ("Cannot delete object $remoteobjects_name - " .
	     " file containing object names does not exist",
	     "File: $source_remoteobjects");
    @old_remoteobjects_entry = &copy_file_wo_target_entry
	($remoteobjects_name, $source_remoteobjects, $copy_remoteobjects, "3");
    ($old_remoteobjects_entry[0]) || 
      &quit ("Cannot find object $remoteobjects_name in order to delete it",
	     "(Note that only persistent objects can be deleted)");
    &switch_files($source_remoteobjects,$copy_remoteobjects);
#	OK if .objects file/entry do not exist - they are only used w/
#	persistent objects
#	Note atomicity problem - we don't enforce both switch_files
#	succeed or both fail.  Oh well.
###	 For initial implementation, leave "dangling" .objects entry
###	 around.  It's our link to any persistent data files we might
###	 want to clean up.  If object is re-made, the logic (in
###	 make_objects_file_entry) does NOT check change/add consistency
###	 w/.remoteobjects entry, which works out well for us here
###    if (-e $source_objects) {
###      ($temp,undef) = &copy_file_wo_target_entry
###		($remoteobjects_name, $source_objects, $copy_objects, "1");
###      $temp && &switch_files($source_objects,$copy_objects);
###    }
    &exit_to_dir;
  }

  if (-e $source_remoteobjects) {
    @old_remoteobjects_entry = &copy_file_wo_target_entry
	($remoteobjects_name, $source_remoteobjects, $copy_remoteobjects, "3");
    $open_mode = ">>";
    $append_file = ($old_remoteobjects_entry[0]) ?
				$copy_remoteobjects : $source_remoteobjects;
  } else {
    $open_mode = ">";
    $append_file = $source_remoteobjects;
  }
    
#   Make new object defn in ".remoteobjects" format
#     object string needs /jg/serv
#     Implement future html<->brev protocol switch (as of Jul 99 will
#	always be html)
#     Be ready to fool w/level.  For now, use what we were sent
#     Discard extended URL, but who knows?  Info might be useful some day

#   query_string gets included in ".objects file" format; eg, parenthesized
#   Don't think it needs htmlesc attention; we're not sending string to
#   html.  Don't think it needs trigramming either - if in doubt, trigram
  $qs_w_paren = $query_string ? "($query_string)" : "";

#   If user so specified, run object to a .jgof file, and serve it from
#   there via defgb & jgof_read
  if (&get_form_var("copydata","REQ","NUMBER")) {

    &make_dir($persistent_object_data_root);
    $persistent_object_data_dir =
  			"$persistent_object_data_root/$remoteobjects_name";
    &make_dir($persistent_object_data_dir);

    $data_file = "$persistent_object_data_dir/$remoteobjects_name.jgof";
    &generate_jgof_format_data($object,$qs_w_paren,$data_file);

    $objects_defn = "$defgb_method_name({$jgof_read($data_file)})";

    &make_objects_file_entry ($source_objects,
			      $remoteobjects_name,
			      $objects_defn);

#     Set up pieces of .remoteobjects entry
#     Deliberately leave $subdir undefined
#     Could also set $level to 0...
    $node_port = "";		# This server
    $local_object = $remoteobjects_name;
    $query_string = $qs_w_paren = "";

  } else {
#   Intend to use .remoteobjects object format http://node/jg/serv/object
#   so get a valid node, port, etc
    (undef,$node_port,undef,$subdir,$local_object) = &parse_obj_spec($object);
}

  $local_object || &quit("Object spec $object missing expected object name");
#   Assume that empty subdir means "user did not spec subdir" instead of
#   "user explicitly wants top-level dir"
  ($subdir eq "") && undef $subdir;

#   No node_port means this node_port... I hope!
  $node_port || ($node_port = $myaddr);

#   For objects which could have come from OO server, assume they do, so
#   if no subdir present, set to top level .objects directory
  if (  
	(  ($node_port eq $server) || ($node_port eq $myaddr)  )  &&
	&OO_object("$object_root/.objects",$local_object)  
     ) 									{
    (defined $subdir) || ($subdir = "");
  }

#   Switch protocols if appropriate and if user supplied a value
  (  (($protocol eq "html") || ($protocol eq "brev")) && $htmlbrev  )
						&& ($protocol = $htmlbrev);

#   Default subdir.  If defaulted to non-empty (or if it has non-empty
#   value anyway) append slash.  Note that defined but empty string is
#   significant ( = top level .objects file).  Of course, default value has
#   leading slash, while subdir that comes out of parse_obj_spec doesn't -
#   consistency!?!
  (defined $subdir) || ($subdir = &rel_filespec($persistent_object_dir_file));

#   Use of $obj_name may now be redundant, but there used to be a choice 
#   related to $obj_name at this point in v 1.1; said choice no longer happening
##  $obj_name = ($local_object =~ /^timecnv/) ? $remoteobjects_name : $local_object;
  $obj_name = ($subdir) ? "$subdir/$local_object" : $local_object;

#   Make new .remoteobjects file entry
#     Assume we can just concatenate protocol and level (sigh... properly
#     this should be another make_obj_spec_string parsing program)
  $remoteobjects_entry[0] =
    "$remoteobjects_name=" .
      "http://$node_port/$jg_cgi/serv/$obj_name.$protocol$level$qs_w_paren\n";
  $remoteobjects_entry[1] = "- $investigator\n";
  $remoteobjects_entry[2] = "- $comment\n";

  (open (APPEND,"$open_mode $append_file")) ||
			&quit("Cannot open $append_file for append: $!");
  (print APPEND @remoteobjects_entry) ||
			&quit("Cannot write $append_file: $!");
  (close APPEND) || 	&quit("Problem closing $append_file: $!");

#   If necessary, switch appended file into "real" location
  ($append_file eq $copy_remoteobjects) &&
		&switch_files($source_remoteobjects,$copy_remoteobjects);

#  ##############
#  #	Make .objects file entry if necessary, and .info file
#  #   Some persistent objects require a .objects entry, as well as some
#  #   mucking w/file locations.  As of Jul 99, this is only timecnv, but
#  #   maybe this .objects system is general.
#  #	We arrive here w/an object name of the form timecnv_pid.  There
#  #   are a series of data files for this object in persistent_object_data_root.
#  #   The file names are of the form objname.*.  There also is an objname.objects
#  #   file containing a .objects entry for this object, and an objname.info
#  #   file containing an appropriate .info file.
#  #	We rename the object to its .remoteobjects name.  We create a
#  #   directory persistent_object_data_root/remoteobjects_name and move all
#  #   the objname.* files into it.  We edit the .objects file entry to
#  #   reflect the new object name and the new file locations, and append it
#  #   to the .objects file.  We copy the .info file appropriately.
  $info_file = "$persistent_object_dir/$remoteobjects_name.info";
#    if ($local_object =~ /^timecnv/) {
#  
#      $persistent_object_data_root = 
#  			&get_reqd_form_var("persistent_object_data_root");
#      $persistent_object_data_dir =
#  			"$persistent_object_data_root/$remoteobjects_name";
#      &make_dir($persistent_object_data_dir);
#  
#  #     The ,objects file entry is required.  Use it to see if an mv
#  #     is actually required.  There's no move if we're going back to
#  #     the form, then hitting the Submit button w/o regenerating the form
#      $objects_template = "$persistent_object_data_dir/$local_object.objects";
#      if ( ! -e $objects_template) {
#        $mv_command = "$mv -f $persistent_object_data_root/$local_object.* " .
#  						$persistent_object_data_dir;
#        &move_files($mv_command);
#      }
#  
#      $copy_objects = "$tmpdir/objects_copy$unique";
#      push (@tempfiles,$copy_objects);
#      if (-e $source_objects) {
#        $old_objects_entry = &copy_file_wo_target_entry
#  	  ($remoteobjects_name, $source_objects, $copy_objects, "1");
#        $open_mode = ">>";
#        $append_file = ($old_objects_entry) ? $copy_objects : $source_objects;
#      } else {
#        $open_mode = ">";
#        $append_file = $source_objects;
#      }
#  
#      $objects_defn = &edit_objectsfile_entry
#  ($objects_template,$persistent_object_data_root,$persistent_object_data_dir);
#  
#  #     Add to appropriate .objects file and switch into place if necessary
#      (open (APPEND,"$open_mode $append_file")) ||
#  			&quit("Cannot open $append_file for append: $!");
#      (print APPEND "$remoteobjects_name=$objects_defn\n") ||
#  			&quit("Cannot write $append_file: $!");
#      (close APPEND) || 	&quit("Problem closing $append_file: $!");
#      ($append_file eq $copy_objects) &&
#  				&switch_files($source_objects,$copy_objects);
#  
#  #     Move info file to appropriate place
#      $source_info_file = "$persistent_object_data_dir/$local_object.info";
#      if (-e $source_info_file) {
#        $mv_command = "$mv -f $source_info_file $info_file";
#        &move_files($mv_command);
#      }
#  
#    } else {
#   Make an appropriate info file if we can
  &make_info($info_file,$object,$query_string);
#    }
##############

#   Bring user's persistent object .objects file "up to date"
#   with respect to "passthrough" object definitions like mathmethod
#   We could probably do this only once, when the user's .objects file
#   is created, but this way if we add any passthrough objects to 
#   the OOserver's .objects file, they will automatically get propagated
  ($status,$status_info) = &merge_passthru_object_specs
				("$object_root/.objects",$source_objects);
  ($status eq 'OK') || 
	&quit("Problem merging passthrough objects:",$status,$status_info);

#	We're done!
  &exit_to_dir;
}

sub exit_to_dir
{
#   Put user in dir, in directory containing new object
#   dir wants trailing /; uses initial / to set up "You are here" gif
  $ENV{"PATH_INFO"} = "/$persistent_object_dir_file/";
  delete ($ENV{"QUERY_STRING"});
  system($dir_program);

#   If we're debugging this routine, debug pid_file_cleanup, too
#   Othewise, we might want to leave files un-deleted anyway...
#     Really ought to save orig pid_file_cleanup_debug_env_var and restore
#     it, but we're leaving this program directly
  $debug && ($ENV{$pid_file_cleanup_debug_env_var} = $debug);

#   Note we want to do cleanup even if we don't make these files this
#     time - there could be old files it would be nice to clean up
  &pid_file_cleanup($unique,@tempfiles);

  exit;
}

###########################################################################
sub make_objects_file_entry
{
  my ($orig_objects,$name,$defn) = @_;
  my ($old_objects_entry,$open_mode,$append_file);

  if (-e $orig_objects) {
    $old_objects_entry =
	&copy_file_wo_target_entry ($name, $orig_objects, $copy_objects, "1");
    $open_mode = ">>";
    $append_file = ($old_objects_entry) ? $copy_objects : $orig_objects;
  } else {
    $open_mode = ">";
    $append_file = $orig_objects;
  }

  &add_to_file ("$open_mode $append_file","$name=$defn");

  ($append_file eq $copy_objects) && 
				&switch_files($orig_objects,$copy_objects);

  return;
}

sub generate_jgof_format_data
#   Create a .jgof format file by running defgb on an object
#   Can NOT reliably run serv, which only works on local objects
{
  my ($object,$qs_w_paren,$data_file) = @_;
  my ($command,$defgb_arg);
  my ($save_bang,$save_child_status);
  my (@data_file_lines);
  my ($max_error_lines) = 20;

  my ($defgb) = "$methods_dir/" . $defgb_method_name;

  my ($blank_path_info) = "PATH_INFO=;export PATH_INFO;";
  my ($blank_query_string) = "QUERY_STRING=;export QUERY_STRING;";

  $defgb_arg = "{" . $object . $qs_w_paren . "}";

  &check_x_access($defgb);
  $command = $blank_path_info . $blank_query_string . $defgb . " " .
			&shell_protect($defgb_arg) . ">" . $data_file;

  $! = $? = 0;
  system ($command);

  if (  ! (($! == 0) && ($? == 0))  ) {
   $save_bang = $!;
   $save_child_status = $?;
#     defgb error stuff might be at end of $data_file.  Try to get it
   if ((-e $data_file) && (-s $data_file)) {
     @data_file_lines = `/usr/bin/tail -$max_error_lines $data_file`;
     unshift (@data_file_lines,
	("The rest of this message is the last $max_error_lines lines",
	 " produced by $defgb.",
	 "It may contain error info and/or the ",
	 " last data processed before the problem",
	 "======================================================"),
	     );
   } else {
     @data_file_lines = ();
   }
   &quit("Failure of command \'$command\'",
	 "\$! = $save_bang, \$? = $save_child_status",
	 @data_file_lines);
  }

  return;
}

sub get_remoteobjects_name
{
  my ($cad,$guess_at_name) = @_;
  my ($name,$maxlen);

#   Default object name for deletes.  Note a bad guess_at_name
#   will be incorrectly reported as coming from the form
#   Thought is that using form verification routine is better than 
#   trying to duplicate the verification code
  ($cad eq "delete") && (! $form_info{"rem_obj_name"}) &&
			(  $form_info{"rem_obj_name"} = $guess_at_name  );

#   Change whitespace to underscores as a courtesy (per Bob)
#   Prohibit #s (at least for now), which cause trouble w/download
  $name = &get_form_var("rem_obj_name","REQ","SPACEOK");
  ($name =~ /[^\#]+/) ||
    &bad_form_var("rem_obj_name",$name,
		  "string","a-z,A-Z,0-9,-,_, & space");
  $name =~ s/\s+/_/g;

  (length($name) > $maxlen_remobj_name) &&
    &quit("Name \"$name\" too long.  Max = $maxlen_remobj_name");

  return $name;
}

sub get_remoteobjects_comment
{
  my ($comment,$maxlen);

  $comment = &get_form_var("descrip","OPT","SPACEOK");

#   Seems to be a problem w/ info URL if comment is empty, so...
  $comment || ($comment = "... created " . localtime);

#   Comment string only gets printed, but if it has weird html, that could
#   be a hassle ...  Try escaping it. Maybe the weird stuff will come
#   out literally
  $comment = `$htmlesc '$comment'`;
  $?  && &quit("Failure validating description: $comment: $?");

  (length($comment) > $maxlen_remobj_comment) &&
      ($comment = substr($comment,0,$maxlen_remobj_comment));

  return $comment;
}

sub get_remoteobjects_investigator
{
  my ($investigator,$maxlen);

  $investigator = &get_form_var("investigator","OPT","NOCHECK");
  ($investigator =~ /^[\w\-\_ \.]+$/) || 
    &bad_form_var("investigator",$investigator,
		  "string","a-z,A-Z,0-9,-,_, space & period");

  if (length($investigator) > $maxlen_remobj_investigator)  {
#     If "investigator" seems to be node name (2 embedded .s), truncate
#     (Turns out Bob has "J.J.Bisagni";  hope such folks have short names!)
#     Otherwise die.  ("node names" related to investigator because as of
#     v 1.2, we don't ask for investigator.  Instead, we use node name in
#     this field)
    ($investigator =~ /^.+\..+\..+$/)	?
      $investigator = substr($investigator,0,$maxlen_remobj_investigator)  :
      &quit
	("Investigator \"$investigator\" too long.  " .
	 "Max = $maxlen_remobj_investigator")     ;
  }

  return $investigator;
}

sub move_files
{
  my ($mv_command) = $_[0];
  my ($status);

  if ($status = `$mv_command`) {
#   Presumably anything on stdout is an error msg...
    chomp $status;
    $status = ": $status";
  }
  ($status || $?)  &&  &quit("Cannot $mv_command$status: exit status = $?");

  return
}

#  #  sub edit_objectsfile_entry
#  {
#  #   Get (only) line from $infile.  Get what's to right of =.  In that
#  #   string, replace $repl_target with $repl_source
#    my ($infile,$repl_target,$repl_source) = @_;
#    my ($record,$object_defn,$tmp);
#  
#    (open (INFILE,$infile))	|| &quit("Cannot open $infile for read: $!");
#    $record = <INFILE>;
#    defined($tmp = <INFILE>)	&& &quit(">1 record in $infile.  Que pasa?");
#    (close INFILE) 		|| &quit("Problem closing $infile: $!");
#  
#    (undef,$object_defn) = split (/=/,$record,2);
#    $object_defn || &quit("Bad .objects file format (no =).  Entry: $record");
#  
#    return join(  $repl_source, split(/$repl_target/,$object_defn)  );
# 
#  }

sub OO_object
#   Test whether object is "special", defined as
#     a) its name ends in "method"
#     b) its defn does not include arguments
#   These special objects are things like mathmethod, joinumethod, etc
{
  my ($objects_file,$object) = @_;
  my ($rec,$is_OO_object,$object_defn);

  ($object =~ /method$/) || return 0; 

  $is_OO_object = 0;

  (open (OBJECTS_FILE,"<$objects_file")) ||
			&quit("Cannot open $objects_file for read: \$!=$!"); 
  while (defined(<OBJECTS_FILE>)) {
    if (/^$object=(.+)/) {
      ($object_defn) = split (' ',$1);	    # Get rid of trailing env var defns
      $is_OO_object =  ($object_defn !~ /\(/);	# No ( means no args
      last;
    }
  }

  close OBJECTS_FILE;
  return $is_OO_object;
}

sub copy_file_wo_target_entry
{
#   If file $infile contains an entry corresponding to
#     $entry, make a copy of $infile to $outfile, removing
#     (and returning) the $entry entry
#   Try to handle the situation where user made persistent object and
#     then changed mind about its name...
#   Assumed format: There are exactly $lines_per_entry lines/entry.
#     Entry names occur on the first line of an entry.  They start in
#     col 1 and end with an = with no blanks

  my ($entry,$infile,$outfile,$lines_per_entry) = @_;

  my (@old_entry) = "";
  my ($save_RS) = $/;
  my ($infile_data);
  my ($before);
  my ($after);
  my ($extra);

#		Lock files here, or, better, in main program before
#		calling this.  Unlock would be done in main pgm

#   Get whole input file
  (open (INFILE,$infile))	|| &quit("Cannot open $infile for read: $!");
  undef $/;
  $! = 0;
#   Prepend \n so all names including the first are
#   enclosed between \n and =
  $infile_data = "\n" . <INFILE>;
  $/ = $save_RS;
  ($! == 0)			|| &quit("Cannot read $infile: $!");
  (close INFILE) 		|| &quit("Problem closing $infile: $!");

#   Split file into "before $entry" and "after $entry" pieces
#   Take appropriate actions if $entry found or not.
  ($before,$after,$extra) = split (/\n$entry=/,$infile_data,3);
  (defined ($extra)) && &quit("$infile appears to have >1 entry for $entry");
  (defined ($after)) || return @old_entry;
  ($change_add_delete eq "add") && &quit ("Object $entry already exists");

#   If $outfile exists, we could be in "user changed mind about
#   something" scenario, which would mean we could use $outfile as is,
#   and, if user changed mind about object name, previously entered name
#   would be gone as wanted.  However, there's no guarantee that user
#   isn't making 2 entries for same object, so forget about it.
#     Note that as far as $outfile is concerned, an old entry, once deleted,
#   is gone - $outfile existence is irrelevant.  See discussion in
#   switch_files...

  (open (OUTFILE,">$outfile")) || &quit("cannot open $outfile for write: $!");

#   Copy stuff before entry.  Remove leading \n we inserted and add
#   trailing \n since original trailer is part of separator string
  if ($before) {
    (print OUTFILE substr($before,1) . "\n") ||
					&quit("cannot write $outfile: $!");
  }

#   Extract all lines for entry and reconstitute it
  (@old_entry) = split (/\n/,$after,$lines_per_entry + 1);
  $old_entry[0] = "$entry=$old_entry[0]\n";
  foreach (1..$lines_per_entry-1) {
    $old_entry[$_] .= "\n";
  }

#   Copy stuff after entry
  if ($old_entry[$lines_per_entry]) {
    (print OUTFILE $old_entry[$lines_per_entry]) || 
				&quit("cannot copy $infile to $outfile: $!");
  }

  (close OUTFILE) || &quit("Problem closing $outfile: $!");

  return @old_entry;
}

sub get_dummy_form_info
{
  $form_info{"form_action"} = $form_action;
  $form_info{"path_info"} = $test_path_info;
  $form_info{"query_string"} = "//globec.whoi.edu/globec/gb/test,leg1:=leg+1";
  $form_info{"change_add_delete"} = "change";
  $form_info{"unique"} = "UNIQUE";
  ($form_info{"rem_obj_name"} = $ENV{"REM_OBJ_NAME"}) ||
				  ($form_info{"rem_obj_name"} = "Durutte");
  $form_info{"descrip"} = "Test";
  $form_info{"investigator"} = "Big W";
  $form_info{"htmlbrev"} = "html";
  $form_info{"server_name"} = $test_server;
  $form_info{"server_port"} = $test_port;
  $form_info{"persistent_object_dir_file"} = $test_remote_host;
  $form_info{"copydata"} = 1;

  return;
}

sub switch_files
#  Rename $source to $old and $copy to $source
#    Note that if $old exists, we have the capability of an "undelete"
#  function to recover an erroneously overwritten object entry.  However,
#  this assumes no other change has been made while user was thinking about
#  this one... and locking in this program doesn't handle it.  Probably
#  better to implement undelete via a log file of removed entries... better
#  maybe but lots harder!
{
  my ($source,$copy) = @_;
  my ($old) = "$tmpdir/remoteobjects_old$unique";
  my ($status);

  push (@tempfiles,$old);

#   Use mv child proc instead of link/unlink perl so that we don't have
#   to worry about partition crossing
  &move_files ("$mv -f $source $old");

#   Slightly different - try to recover if next mv fails.
  $mv_command = "$mv -f $copy $source";
  if ($status = `$mv_command`) {
#     Presumably anything on stdout is an error msg...
    chomp $status;
    $status = ": $status";
  }
  if ($status || $?) {
#     Try to move old one back... worth a shot.  Only report orig problem
    my ($orig_code) = $?;
    system ("$mv -f $old $source");
    &quit("Cannot $mv_command$status: exit status = $orig_code");
  }

  return;
}

sub make_info
#  Info file normally consists of link back to $object.  However, if
#  $object is on OO box, $object is probably a constructor like math, and
#  it would be more useful to have pointer back to the input(s) to $object
#  which is probably the "original" object.
#    We would love to make all these backlinks .brev, but we don't know if
#  a remote object would support that.  Besides, it only saves us if it's
#  a 1 level object...
#    We duplicate some parsing in here, but  a) some of it had to be done
#  anyway   b) protect ourselves in case we change various defns above.
{
  my ($info_file,$object,$qs) = @_;
  my ($obj_node_port,$obj_node,$obj_port,$obj_dir,$obj_name);
  my ($obj1,$obj2,$obj1_spec,$obj2_spec,$obj1_name,$obj2_name,$obj_spec);

  (open (INFO,">$info_file")) || &quit("Cannot open $info_file for write: $!");
  $! = 0;

#   Try to see if object is "on" this node.  Look at SERVER_? env vars
#   and MYADDR env var
  (undef,$obj_node_port,undef,$obj_dir,$obj_name) = &parse_obj_spec($object);

  print INFO "<title> $object </title>";
#   ? localtime is documented to give numeric time back.  However, when
#   used in this program (above) it gives "readable" time (possibly a
#   matter of what context it gets executed in).   Here, it looks good in
#   info file, but seems to print in hex when displayed by lynx.  Sigh.
  $tmp = "... created " . localtime;
  print INFO "<pre> 			$tmp\n</pre>";

  if (  ($obj_node_port eq $server) || ($obj_node_port eq $myaddr)  )  {
#     In testing for "special" objects, we assume that they are special
#     no matter which subdir of the object root they are in.
#     Note that "real" object could itself be a "special" object in
#     which case we might want to try recursion.  Sigh.

    if ($obj_name eq "mathmethod") {
#	math's source object is in query string.  Might be followed
#	by parenthesized selection/projection list.  For doc purposes
#	decided to remove that list.  (perl ? means a) minimal matching
#	as in .*?,  b) 0 or 1 rep as in (foo)?  or  c) don't "return"
#	matching string (ie, no backreference) as in (?:foo)... maybe
#	more meanings!  We use 'em all.  Go ahead - try to parse a
#	URL where we need a literal ? as well!!)
      ($object) = ($qs =~ /^(.*?)(\(.*?\))?(,|$)/);
      (undef,$obj_node_port,undef,$obj_dir,$obj_name) =
						&parse_obj_spec($object);
      $obj_spec = "http://$obj_node_port/$jg_cgi/serv/$obj_dir/$obj_name.html0"; 

      if ($obj_name =~ /^(data)?(math|joinu)method$/) {
	print INFO "<pre> This object contains mathematically derivable" .
		   " variables from</pre>";
	print INFO "<pre> $qs </pre>";
	print INFO "<pre> which itself is constructed from other objects</pre>";
      } else {
	print INFO "<pre> This object comes from object </pre>";
	print INFO "<a href=\"$obj_spec\">$object</a>";
	print INFO "<pre> It probably includes at least 1 new variable " .
		 "that is mathematically derivable from the\n" .
		 " variables in the original object </pre>";
      }

    } elsif ($obj_name eq "joinumethod") {
#	join's component objects are the first 2 query string args
#	See math comment, above
      ($obj1,$obj2) = ($qs =~ /^(.*?)(?:\(.*?\))?,(.*?)(\(.*?\))?(,|$)/);

      (undef,$obj_node_port,undef,$obj_dir,$obj1_name) = &parse_obj_spec($obj1);
      $obj1_spec = "http://$obj_node_port/$jg_cgi/serv/$obj_dir/$obj1_name.html0"; 

      (undef,$obj_node_port,undef,$obj_dir,$obj2_name) = &parse_obj_spec($obj2);
      $obj2_spec = "http://$obj_node_port/$jg_cgi/serv/$obj_dir/$obj2_name.html0"; 

      if (  ($obj1_name =~ /^(math|joinu)method$/) ||
	    ($obj2_name =~ /^(math|joinu)method$/)   )  {
	print INFO "<pre> This object is a join of 2 objects, at least" .
		   " one of which is itself constructed somehow\n";
	print INFO " Below is a string in which the original source" .
		   " objects might be found </pre>";
	print INFO "<pre> $qs </pre>";
      } else {
	print INFO "<pre> This object is a join of object </pre>";
	print INFO "<a href=\"$obj1_spec\">$obj1</a>";
	print INFO "<pre> and object</pre>";
	print INFO "<a href=\"$obj2_spec\">$obj2</a>";
      }

    } else {
#	Not join or mathmethod, nor is it a "special" method like
#	timecnv, which has written an info file for us (and therefore
#	this subr is not being called)
      print INFO "<pre> Sorry, no additional information at this time </pre>";
    }

  } else {

#     This object is not on OO server box.  Most likely it's a
#     selection/projection
    print INFO "<pre> This object comes from object </pre>";
    $obj_spec = "http://$obj_node_port/$jg_cgi/serv/$obj_dir/$obj_name.html0"; 
    print INFO "<a href=\"$obj_spec\">$object</a>";
    print INFO "<pre> It is most like a subset of that object </pre>";

  }

  print INFO "<pre> Going to a source object and following" .
	     " its documentation links may provide more info </pre>";

  ($! == 0) || &quit("Problem writing $info_file: $!");
  (close INFO) || &quit("Problem closing $info_file: $!");

  return;
}

sub parse_obj_spec
#  [http:][//node[:port]][/jg/jgofs-cgi][/subdir_of_obj_root]/obj_name
#	Note we assume ".html0{blah}" not present.  Can parse_path_info
#	them off before calling this routine... as long as parse_path_info
#	isn't confused by http://a.b.c/jg/serv!! (which it wasn't designed
#	to handle)
#	We further assume that if the relevant punctuation is there, the
#	fields are non-empty.  We also assume that all the punctuation
#	is relevant... at least I think we assume that
#    @x = &parse_obj_spec($_);
#    print "Proto -->$x[0]<--\n";
#    print "Node/port -->$x[1]<--\n";
#    print "Cgi -->$x[2]<--\n";
#    print "Subdir -->$x[3]<--\n";
#    print "Obj -->$x[4]<--\n";
#    print "\n";
{
#				                      /jg/serv          /objname
  my(@x) = (  $_[0] =~ m"^(.+?\:)?(//.+?(?:\:\d+)?)?(/$jg_cgi/.+?)?(/.+)?(/.+)$"  );
#		           http:    //node:port	                 /subdir
  my($jg_len) = length("/$jg_cgi/");

  if ($x[0]) { chop $x[0]; }		   # Remove : from http:
  else	     { $x[0]=""; }

  $x[1] = ($x[1]) ? substr($x[1],2) : "";  # Remove // from //node-port
  $x[2] = ($x[2]) ? substr($x[2],$jg_len) : "";  # Remove /jg/ from /jg/cgi
  $x[3] = ($x[3]) ? substr($x[3],1) : "";  # Remove initial / from /subdir
  $x[4] = ($x[4]) ? substr($x[4],1) : "";  # Remove initial / from /object

  return @x;
}

sub merge_passthru_object_specs
  #  Args are an input .objects file and a .objects file to be updated	
  #  Look through input file for "passthrough" object defns like	
  #		joinumethod=join					
  #  Characterization: right side has no input args (but might have	
  #  env var defns).  If output file doesn't have a particular		
  #  defn, append it to the output file				
  #  Returns 2 args.  First arg is status.  If status is 'OK', 2nd arg is
  #  # records written to updated file.  If status not 'OK, 2nd arg is 
  #  error info.
  #  This code not really a good idea since it is parsing .objects files
  #  and there should be an API using dctsearch for this purpose.  However,
  #  not holding breath until such a thing is written
{
  my ($in,$update,$dummy) = @_;
  my (%in_objs,%update_objs);
  my ($obj_name,$obj_defn,$method);


  $in || return "NO_INFILE_ARG","";
  $update || return "NO_UPDATEFILE_ARG","";
  $dummy && return "TOO_MANY_ARGS","";

#   One could argue that no input file is OK; just return after
#   performing the "null update".  However, in practice, no point in
#   calling this routine if no input file
  (-e $in) || return "NO_INFILE","File: $in";
  ($status,$status_info,%in_objs) = &get_passthrough_defns($in);
  ($status eq 'OK') || return $status,$status_info;
#   If no passthrough entries in input file, no updates needed
  (keys(%in_objs) == 0) && return 'OK',0;

#   Not a problem if file to be updated does not exist		
  if (-e $update) {
    ($status,$status_info,%update_objs) = &get_passthrough_defns($update);
    ($status eq 'OK') || return $status,$status_info;
  }

  while (($obj_name,$obj_defn) = each %in_objs) {
    if (exists $update_objs{$obj_name}) {
      ($status,$status_info) = 
		&compare_object_defns($obj_defn,$update_objs{$obj_name});
      if ($status eq 'MATCH') {
	delete $in_objs{$obj_name};
      } elsif ($status eq 'NOMATCH') {
	return "OBJ_NAME_CONFLICT",
		"Defns for object $obj_name in $in & $update conflict\n" .
		$status_info;
      } else {
	return ($status,$status_info);
      }
    }
  }
#   If no unaccounted-for entries in input file, no updates needed
  (keys(%in_objs) == 0) && return 'OK',0;

  $n_updates = $! = 0;
#   Add the previously unfound defns to the end of the file needing updating
  (open (UPDATE,">> $update")) || 
	return "BAD_UPDATE_OPEN_FOR_APPEND","File: $update; Status: $!";
  while (($obj_name,$obj_defn) = each %in_objs) {
    $n_updates++;
    $status = (print UPDATE "$obj_name=$obj_defn\n");
    ($status == 0) && 
	return "BAD_UPDATE_WRITE",
	    "File: $update; Status: $!; Problem occurred w/update #$n_updates";
  }
  close UPDATE;
  return 'OK',$n_updates;
}

sub get_passthrough_defns
{
  my ($in,$dummy) = @_;
  my ($obj_name,$obj_defn,$method,%in);

  ($in && (! $dummy)) || return "BAD_ARGS","";

  $! = 0;
  (open (IN,$in)) || return "BAD_OPEN_FOR_READ","File: $in; Status: $!";
  while (<IN>) {
    chomp;
#     Not sure if blank lines are allowed, but let's be tolerant	
    $_ || next;
#     Doing it this way finesses issue of multiple =s on line	
#     First one is the one that "counts"			
    ($obj_name,$obj_defn) = split '=',$_,2;
    if ( ! ($obj_name && $obj_defn)) {
      close IN;
      return "BAD_OBJ_DEFN","File: $in; defn_line: $_";
    }
#     Whitespace is tricky in non-passthrough obj defns.  It is
#     permitted within the method arguments.  Since we aren't interested
#     in method arguments, though, we can just split away.  See comment
#     up top about using a (as yet non-existent) API to the dct routines.
    ($obj_name) = ($obj_name =~ /\s*(.*)\s*/);
    ($method,undef) = split ' ',$obj_defn;	# split off env vars
    if ( ! ($obj_name && $method)) {
      close IN;
      return "BAD_OBJ_DEFN","File: $in; defn_line: $_";
    }
#     Don't want remote objects or objects w/input args
#     Remote objects lead off with //; input args will have open parens
#     before any whitespace
    ($method =~ q"^//") || ($method =~ q"\(")  || ($in{$obj_name} = $obj_defn);
  }
  close IN;
  return 'OK',"",%in;
}

sub compare_object_defns
#  Test if 2 "passthrough" .objects defns are the same.  The method strings
#  must be identical.  Env var strings must be identical but can
#  occur in any order.  Return 'BAD_ARGS', 'MATCH' or 'NOMATCH'.  If the 
#  latter, return more info about what was different.
{
  my ($defn1,$defn2,$dummy) = @_;
  my (%env_vars1,$method1,%env_vars2,$method2);

  ($defn1 && $defn2 && (! $dummy)) || return 'BAD_ARGS',"";

#    Can't figure out how to make split work on "string a or string b"
#    bud I DO know how to make it work on "char a or char b".  Sigh
  $defn1 =~ s/\s+/ /g;
  $defn2 =~ s/\s+/ /g;
  ($method1,%env_vars1) = split /[=\s]/,$defn1;
  ($method2,%env_vars2) = split /[=\s]/,$defn2;

  ($method1 eq $method2) || return 'NOMATCH','Method name mismatch';

#   Check that each env var defined in $defn1 is defined in $defn2, and
#   is defined to the same value
  while (($env_var_name,$env_var_value) = each %env_vars1) {
    (exists $env_vars2{$env_var_name}) ||
      return 'NOMATCH',
	"Env var $env_var_name defined in one obj defn but not the other";
    ($env_var_value eq $env_vars2{$env_var_name}) ||
      return 'NOMATCH',
	"Value for env var $env_var_name differs between obj defns";
    delete $env_vars1{$env_var_name};
    delete $env_vars2{$env_var_name};
  }

#   All env vars defined in both objects have matched and been removed
#   from the hashes.  Any env vars remaining in either list constitute
#   a mismatch
  (($env_var_name,undef) = each %env_vars1) &&
      return 'NOMATCH',
	"Env var $env_var_name defined in one obj defn but not the other";
  (($env_var_name,undef) = each %env_vars2) &&
      return 'NOMATCH',
	"Env var $env_var_name defined in one obj defn but not the other";

  return 'MATCH',"";
}