#!/usr/bin/perl -w
#
# getobj2
#  purpose is to assign the second join object after a user selects
#  it from a 'dir'-like window, and then to issue a form allowing
#  the user to subselect from among the object's variables, which
#  are sent on to get2andjoin
#
# NB: this file belongs in the directory configured as ScriptAlias /jg/
#     on this HTTPD server.  (typically htmlbin or optbin)
#     Generated from a template by a makefile in the source tree
#
$version = "getobj2 version 2.5  9 Apr 13";
#   9 Apr 13.  WJS
#	Use listvar 1.4 and backtick to get the object's list of variables
#   7 Apr 13.  WJS
#	Parse info from dir-join2 w/parse_path_info to get around Apache //->/
#     "feature".  Nothing guarantees that dir-join2 uses that format, however, but
#     the odds are good, I think.
#	This is most easily done by using wjs_web_perl_utilities.pl, which means
#     we can quit instead of die, see that .exe's are executable etc, so make
#     some of those mods
#	Change the 3 Jun 05 "postfix"es to "undef"s.  At this time, I have no
#     idea about the  $mainlocation  stuff, and I did not investigate it at all
#		[begin v 2.5 - let's call csh v 1 & its conversion to perl v 2]
#   3 Jun 05.  WJS
#       Postfix some empty strings to get rid of "used only once" warnings.  In
#     most cases, these are read-ony uses of symbols presumably defined
#     in some earlier "do 'x.pl'".  However, $mainlocation is a write-only
#     case.  Presumably this .pl file is itself "done", and the "do-er"
#     needs that defn.  Presumption not checked.
#  16 Mar 05.  WJS
#       Hardcode perl location - obviates need for template file
#

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

#   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;

$mainlocation = "$realtempdir"."/";
$listvar = "$topdir/bin/listvar";
$parse_path_info = "$topdir/bin/parse_path_info";

MAIN:
{
  &printtop;

#   Parse the PATH_INFO from our call.  Presumably it contains "a real PATH_INFO"
#   Typically it comes from a  dir  variant called  dir-join2  or  dir-join2-new  or
#   some such.  This variant is on data servers, not the OOserver, and it is not part
#   of the standard data server distribution.  One gets to it from the OOserver page
#   jgofsroot/htdocs/alljg-dir-join.html, which is hand-edited to point to each data
#   server that "needs to join" (and, hopefully, has a dir-join2).  Once "there", 
#   dir-join2  eventually exits by calling us "here" w/the object the user selected "there"
  &check_x_access($parse_path_info);
  $command = "$parse_path_info -nonewline";
  ($results,$exit_status,@status_info) = &backtick($command);
  ($exit_status == 0) ||
	&quit (&format_backtick_return_status
				($command,@status_info,"return from command = $results"));
  %path_info_fields = split(/[,=]/,$results,-1);
#   Defaults for empty protocol & level fields come from original getobj2 code
  $object2 = $path_info_fields{'object'};
  (  ($status = &bad_path_info_piece($object2)) eq "OK") || 
		&quit ("$status object name returned from parse_path_info of $ENV{'PATH_INFO'}");
  $protocol = $path_info_fields{'protocol'};
  (  ($status = &bad_path_info_piece($protocol)) eq "ERROR") && 
		&quit ("$status protocol field returned from parse_path_info of $ENV{'PATH_INFO'}");
  (  ($status = &bad_path_info_piece($protocol)) eq "OK") || ($protocol = "html"); 
  $level = $path_info_fields{'level'};
  (  ($status = &bad_path_info_piece($level)) eq "ERROR") && 
		&quit ("$status level field returned from parse_path_info of $ENV{'PATH_INFO'}");
  (  ($status = &bad_path_info_piece($level)) eq "OK") || ($level = 0); 
  $EXT = $protocol . $level;
#
# if object has been served with a set of projections/selections
#
  (defined ($query_string = $ENV{'QUERY_STRING'})) || ($query_string = "");
  $obj2origsels = ($query_string eq "") ? "none" : $query_string;

  print "<b><font size=\"4\">Second object is: $object2</font></b>\n";

  &check_x_access($listvar);
  $command = qq|$listvar -1 "$object2"|; 
  ($results,$exit_status,@status_info) = &backtick($command);
  ($exit_status == 0) ||
	&quit (&format_backtick_return_status
				($command,@status_info,"return from command = $results"));

  @object2vars = split ' ',$results;
  &getprojs4obj2;

}

# avoid "1-time use" diagnostics
undef $realtempdir;
undef $topdir;
undef $mainlocation;
undef $version;

sub bad_path_info_piece {
  my ($input,$dummy) = @_;
  (defined $dummy) && &quit("bad_path_info_piece called w/too many args");
  (defined $input) || return "UNDEFINED";
  ($input eq "") && return "EMPTY";
  ($input eq "***ERROR***") && return "ERROR";
  return "OK";
}

################### printtop
sub printtop{
 print "Content-type: text/html\n\n";
 print "<HTML><HEAD><TITLE>Offer projections on Object 2</TITLE></HEAD>\n";
 print "<BODY BGCOLOR=\"ffffff\">\n";
}
################### askforprojs
sub getprojs4obj2 {
#
# ask user if any projections from second object are desired
#

print "<form method=\"POST\" action=\"/jg/get2andjoin$object2\" TARGET=\"_top\">";

print <<ENDOFTEXT;
 <input type="hidden" name="obj2origsels" value="$obj2origsels">
 <input type="hidden" name="ext" value="$EXT">
<p>
<b>You may control which parameters from this object are included in the result.<br>
<font color="0000ff">Note: DO include the parameters in common with the first object!</font></b>
<p>
<table align="center">
<tr>

<td border=0>
<font size="4">
<input type="radio" name="quant" value="only" CHECKED>Use <b>only selected</b> parameters
</font>
</td>

<td border=0>
<font size="5" color="0000ff"><b>Or  </b></font>
<font size="4">
<input type="radio" name="quant" value="all">Keep <b>all</b> parameters
</font>
</td>

<tr>
<td align="center" border=0>
<select multiple name="obj2newsels" size=10 align=middle>
ENDOFTEXT

foreach (@object2vars) {
  print "<option>$_";
};

print <<ENDOFSUB;
</select>
</td>

<td valign="middle" colspan=2>
        <b><font size="5" bgcolor="Silver" color="0000ff">
        <input type="submit" value="Continue">
</td>
</table>

</form>
</BODY>
</HTML>
ENDOFSUB
}
