#!/usr/bin/perl -w
{
# join-form1.pl Dec 08 WJS
# .csh-replacement/repl-2-files-w-1/simplification/etc
# In particular, removes necessity of cross-referencing between
# document root and jg cgi directories
# Replaced, etc files are htdocs/joinu.shtml and jg/putshtmlenv (CLH ~98)
#
# see build-opt-env.pl for the definitions for environment vars
# 1. creates a file in $USETEMPDIR (see build-opt-env.pl) called join-object-1
# which contains the name of the current object
# 2. creates a file 'parameters' containing the current selections/projections
# 3. creates a file 'from_loc' containing the referring program
$version = "join-form1.pl version 1.1 25 Apr 2009";
# 25 Apr 09 v1.1 WJS
# Fix typo that caused "" to be sent to "parameters" file instead
# of "none". Best guess is that there was no effect of this error
# except to generate a "used only once" diagnostic
# [begin v 1.1]
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);
require $build_opt_env;
# Check that build-opt-env.pl set up things as expected
$tempdir = &check_build_opt_env_var("USETEMPDIR",$build_opt_env);
$myaddr = &check_build_opt_env_var("MYADDR",$build_opt_env);
$object = &check_build_opt_env_var("OBJECT",$build_opt_env);
($params = $ENV{"SUBSELS"}) || ($params = "none");
# Env var below part of cgi environment. Not clear what to do if it's
# not defined (of interest primarily if this script not executed in web
# environment, which is unlikely). Note choice of "otheropt" loses
# any potential otheropt2, etc.
($refering = $ENV{"HTTP_REFERER"}) || ($refering ="$myaddr/jg/otheropt");
&write_one_line("$tempdir/join-object-1",$object);
&write_one_line("$tempdir/from_loc",$refering);
&write_one_line("$tempdir/parameters",$params);
&printheader();
print << "EOF_HTML";
Join form
<![CDATA[
<H3>Frames-capable browser required</H3>
To learn how to obtain Netscape Navigator, visit the <A HREF="http://home.netscape.com/">Netscape
Home Page</A>.
]]>
EOF_HTML
undef $version;
exit;
}
sub write_one_line
{
my ($outfile,$record,$dummy) = @_;
my $status;
$dummy && &quit ("Internal problem. Too many args passed to write_one_line");
(defined $record) ||
&quit ("Internal problem. Not enough args passed to write_one_line");
$status = open (OUT,">$outfile");
$status || &quit("Problem opening $outfile for write. Status=$status");
chomp $record;
$status = print OUT "$record\n";
$status || &quit("Problem writing to $outfile. Status=$status");
$status = close OUT;
$status || &quit("Problem closing $outfile. Status=$status");
return;
}