#!/usr/bin/perl -w
# mathopt - set up an  exec  of  /jg/serv/mathmethod after getting
#	formulae from user
#
# NB: this file belongs in the directory configured as ScriptAlias /jg/
#     on this HTTPD server.  (typically htmlbin or optbin)
#
$version = "mathopt 3.0b 13 Mar 15";
#  13 Mar 15.  WJS
# Replace all local listvar code w/call to get_cached_varlist
#  24 Jan 15.  WJS
#	Replace perl system command w/entry from backtick to see if bad listvar 
#    diags get better
#               [begin v 3.0b]
#   3 Apr 13.  WJS
#	Remove debug statements
#               [begin v 3.0a]
#   9 Mar 13.  WJS
#	Rewrite to include math-form here
#	Rewrite to use  serv  directly to run mathmethod.  Old version
#    built a URL and then used perl built-in html  get  to access the URL
#	Among the consequences of the rewrite is that parse_path_info gets
#    called, dealing w/the apache 2 //->/ issue.  Problem code was math-form,
#    which was still in its  csh  version (which did not call parse_path_info)
#               [begin v 3.0]
#  13 May 10.  WJS
#       Add version number.  Call the 25 Jul 09 mod version 2
#       Encode # formulae into method name so that selection page can
#         make better guess about what's a selection/projection and what's not
#       Use port information in case OOserver not running on port 80
#               [begin v 2.1]
#  25 Jul 09.  WJS
#       Allow equations of form "var := 0"
#       Replace call to math-form-error
#         a) There was a string, formatted like a URL, but called via system
#         b) The string did not protect its shell-sensitive characters
#       Do some commenting & reformatting
#       Whole logic of invoking mathmethod, from the object name, etc
#         manipulation to the "get" from the LWP package is probably
#         suspect.  At the very least, it's not parallel w/the rest of
#         the OOserver
#   4 Sep 08.  WJS
#       Define undefined variables
#       Execute build-opt-env.pl out of the ./ directory
#  16 Mar 05.  WJS
#       Hardcode perl location - obviates need for template file
# December 8, 1998, clh: correction to parsing of path_info to form
#     OBJ and EXT - was depending on an extension present - may not be
#
########################################
{

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

# Keep printheader "near top" in case it's needed for error messages
# I suspect that the routines in wjs_web_perl_utilities.pl take care of this
# anyway, but seems to me that it's a good idea nonetheless
&printheader();

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

#   Define form action routine and form var name that will eventually point to it
$form_action_routine = $ENV{"SCRIPT_NAME"} ? $ENV{"SCRIPT_NAME"} : "/jg/mathopt.pl";
$form_action_form_var_name = "form_action";

$object_form_var_name = "object";

#   Coded this way, the help file must be in the OOserver's document root 
#   and the button gif in the OOserver's document root /images subdirectory
$help_file = "/math-help.html";
$help_button = "/images/helpbutton.gif";

#   A formula is of the form  left_hand_rootNformula := right_hand_rootNformula
#   max_formulae must be at least 2 or (2..$max_formulae) stuff will get weird
$max_formulae = 4;
$left_hand_root = 'lhs';
$right_hand_root = 'rhs';


&ReadParse(*input);
#   This code is a combination of routines, some of which use form_info and some of
#   which use input.  Take lazy way out.
%form_info = %input;

#   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.  The
#   consistency check is just on general principles - anyone who de-
#   liberately mis-routes things here can change the hidden value as well.
  if (  $after_submit = (defined $form_info{$form_action_form_var_name})  ) {
      ($form_info{$form_action_form_var_name} eq $form_action_routine) ||
	&quit ("Submit action routine should be same as form value"   ,
		  "Action = $form_action_routine; " .
			"Form value = $form_info{$form_action_form_var_name}"     );
  }

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

sub print_form
{

#### &dump_input_info (',',%input);

$jgofs_root = &check_build_opt_env_var("JGOFSDIR",$build_opt_env);
$bin_dir = "$jgofs_root/bin";              # Where listvar is
$listvar = "$bin_dir/listvar";
&check_x_access($listvar);

#   Check that build-opt-env set up things as expected and build variants
#   of object spec
$object = &check_build_opt_env_var("OBJECT",$build_opt_env);
$dispfull = $object_spec = $object;
if ($subsels = $ENV{'SUBSELS'}) {
#   DISPSS must be defined and non-empty if SUBSELS is defined and non-empty
  $dispss = &check_build_opt_env_var("DISPSS",$build_opt_env);
  $object_spec .= "($subsels)";
  $dispfull .= "($dispss)";
} else {
#   Cannot use &check_build_opt_env_var because that insists on non-empty
#   as well as defined.  Empty is OK
  defined ($ENV{'SUBSELS'}) ||
	&quit ("Internal problem.  ",
    		"Did not get defined env var SUBSELS from $build_opt_env");
}
#   scratch directory - most effective if common one all OOserver routines use
  $cache_dir = &check_build_opt_env_var("USETEMPDIR",$build_opt_env);
  
print << "XXSTUFFXX_00";
<html>
<head><title>Mathematical operations</title></head>
<body>
<a href=$help_file>

<img alt="[HELP]" align=right border=0 src=$help_button></a>
<h1>Mathematical operations</h1>
<b>Current object is:  $dispfull</b></br>
<hr noshade>
<p>
<ul>
<li>Create a variable by placing it on the left side of the equation.
<li>Legal operators are <tt>sin, cos, exp, ln, log10, int, +, -, *, /,^</tt>
<li>There are spaces for 4 formulas. Enter multiple formulas, if you wish.
</ul>
<b>Example:  <tt>rho:=28.5-0.2*temp+0.7*(sal-35)</tt></b>

<form action="$form_action_routine" method="POST">

<b><font size="5">Enter formula(s) below:</font></b>
<p>
<pre>      Variable    Formula to use to create it
</pre>
<ol>
<b>
XXSTUFFXX_00

print qq|<li><input name="| . $left_hand_root . qq|1" type="text" size="8">|;
print qq| := |;
print qq|<input name="| . $right_hand_root . qq|1" type="text" size="25">\n|;

print << "XXSTUFFXX_10";
<font color=00cfcf size="5"><input type="submit" value="Go"></font>
<input type="reset" value="Clear all">
<p>
</b>
</ol>
Existing variables in this data object are:<br><b>
XXSTUFFXX_10

# Next code will list varnames on a single line because html ignores the 
# whitespace (including \n's) produced by listvar.
# Similar code in wjs_web_perlroutines.pl worries about clearing PATH_INFO
# but the predecessors of this program never did.  Let's try it w/o, first.
# Surprise! worrying was in order!  Use library routine which takes care of all this junk
(undef,@varlist_by_levels) = &get_cached_varlist($listvar,$cache_dir,$object,0);
# varlist comes back in def format.  Get rid of the >s.  print
# sloppily and see what html does with it
$varlist = join "",@varlist_by_levels;
$varlist =~ s/\>//g;
print $varlist;

print qq|</b>\n|;
print qq|<ol START="2">\n|;
foreach (2..$max_formulae) {
  print qq|<li><input name="| . $left_hand_root . $_ . qq|" type="text" size="8">|;
  print qq| := |;
  print qq|<input name="| . $right_hand_root . $_ . qq|" type="text" size="25">\n|;
}
print qq|</ol>\n|;

#   Put object name and selproj strings into form as hidden variables
$h = "input type=\"hidden\"";
print qq|<$h name="$object_form_var_name" value="$object_spec">\n|;
#   Put name of form action routine on form
print qq|<$h name="$form_action_form_var_name" value="$form_action_routine">\n|;

print qq|</form><p>\n|;

print qq|</body></html>\n|;

return;
}

sub process_form
{

# File spec of serv image
$serv = "./serv";

#### &dump_input_info (',',%input);

# No point in continuing if we don't have the object spec
$object_spec = &get_form_var($object_form_var_name,"REQ","OBJSPEC");

$n_formulae = 0;
$left = $left_hand_root . '1';
$right = $right_hand_root . '1';

if ( $input{$left} && defined($input{$right}) && ($input{$right} ne "") ) {
  $formula = "$input{$left}" . ":=" . "$input{$right}";
  $n_formulae++;
} else {
#   Probable reason for reaching here is that a GET was done rather than
#   a POST.
  print "<html><pre>";
  if ($ENV{"REQUEST_METHOD"} eq "GET") {
    print STDERR "This page called via http method GET rather than POST\n";
    print "This page called via http method GET rather than POST\n";
    print "Please go back to the previous page and use the GO button\n";
  } else {
    $problem_side = ($input{$left}) ? "Right" : "Left";
    print STDERR $problem_side .
        " hand side of formula 1 (previous page) must not be empty\n";
    print $problem_side .
        " hand side of formula 1 (previous page) must not be empty\n";
    print "If you didn't fill that in, please go back and do so\n";
    print "If you DID fill it in, we have a coding error - apologies\n";
  }
  print STDERR "$version\n";
  print "$version<br>\n";
  print "</pre></html>";
  return;
}

#   The selection page (at least) has problems because it needs to know
#   which pieces of query string are sel/proj and this info is not available
#   As a kludge, there is a mechanism to encode the number of NON-sel/proj
#   pieces there are.  The kludge requires an entry in the .objects file
#   for each possible number of non-sel/proj arguments.
#       Since mathopt was coded with only 4 formulae allowed, this works
#   out nicely.  However, it means that if we change the 4 here, we need
#   to change the .objects file.
#       Lest you think how neat this is, note that there's nothing to
#   stop the "right hand side" from including multiple formulae (eg;
#   left hand side = "var1" & right hand side = "formula1,var2=formula2")
#   Should probably count commas, but am not in mood for a bomb-proofing
#   run on mathopt at the moment.
foreach $pair (2..$max_formulae) {
  $left = $left_hand_root;
  $right = $right_hand_root;
  $left .= $pair;
  $right .= $pair;
#   Impressive checking for presence/absence for both halves of formula
#   follows [not]
  if ($input{$left} && $input{$right}) {
     $this_formula = "$input{$left}" . ":=" . "$input{$right}";
     $formula .= "," . "$this_formula";
     $n_formulae++;
  }
}

# +1 for the object being "math'ed"
$n_mathmethod_args = $n_formulae+1;
$math_object = "math_" . $n_mathmethod_args . "_args";

# Initial slash indicates that spec is something in a .objects file rather than
# another form of object spec.  See src/lib/dctsearch*.doc if you must
$path_info_for_serv = "/" . $math_object . ".html0";
$query_string_for_serv = "$object_spec,$formula";

($serv_status,$serv_bang,$serv_process_status,$serv_command) = 
		&let_serv_do_it($serv,$path_info_for_serv,$query_string_for_serv);
if ($serv_status ne "OK") {
  if ($serv_command) {
    &quit($serv_status,"\$!=$serv_bang; \$?=$serv_process_status running command ",
	  $serv_command);
  } else {
    &quit($serv_status);
  }
}

return;	
}
# =============== Old code that we presumably no longer need below
#			$tmp=$ENV{'PATH_INFO'};
#
# if there is an extension on the object name, remove it
# Impressive use of parse_path_info follows [not]
#
#			if (rindex($tmp,".") > rindex($tmp,"/")) {
#			  $OBJ=substr($tmp,0,rindex($tmp,"."));
#			  $EXT=substr($tmp,rindex($tmp,".")+1);
#			} else {
#			  $OBJ=$tmp;
#			  $EXT="html0";
#			}
#			$FULLOBJ=$OBJ;
#			$QS="";
#  Impressive preservation of environment follows [not]
#  Might be that the delete is not necessary after mod to use
#    LWP:simple's GET; ie, the "transfer" program might have required
#    a clean PATH_INFO.  The get doesn't care about PATH_INFO, and I
#    doubt that htmlesc does, either.  However, not in mood to get rid
#    of statement now.
#			delete $ENV{'PATH_INFO'};

#			if ($ENV{'QUERY_STRING'}) {
#   Impressive checking for successful backtick [not]
#			  $QS=`$ENV{'OPTHOME'}/bin/htmlesc "$ENV{QUERY_STRING}"`;
#			  $FULLOBJ="$OBJ"."("."$QS".")";
#			}

#
# below replaces transfer program - use 'get' from LWP package to fetch URL
#
#   See comments above about the [non-]robustness of the next line
#   +1 accounts for the input object spec
#					$myaddr="$ENV{'MYADDR'}";
#					$port = $ENV{'DEFAULT_PORT'} ?     ""     :    ":" . $ENV{'DEFAULT_PORT'};
#   Impressive handling of problems with "get" follows

#		print (get "http://$myaddr$port/jg/serv/$method.$EXT?$FULLOBJ,$formula");