#!/usr/local/bin/perl
#
# build-opt-env.pl
#    November 6, 1998 clh
#        used by Perl scripts in JGOFS OtherOptions server
#        to establish an operating environment
#    December 15, 1998 clh
#	 conditional use of REMOTE_HOST
#    April 15, 1999 clh
#	 add env var USETEMPDIR
#        add make_common_object_env_vars
#    October 25, 1999 clh
#        attempt to provide a bit more error handling
#        list of environment variables established:
#
#	OPTHOME == top of tree
#	OPTRUNDIR == to be appended to OPTHOME to find this directory
#	MYADDR == how to refer to host running these scripts
#	DEFAULT_PORT == which port on this host to use
#	JGTEMP == top level temporary space
#	USETEMPDIR == temporary space to use as tree for current object
# *** 
#   and then, a set of commonly used strings referring to the object
# ***
# given a JGOFS object: http://usjgofs.whoi.edu/test(press>100)
#
#	OBJECT == a jgofs object string (no jg/serv/, no extension)
#  		//usjgofs.whoi.edu/test
#	OBJEXT == same as above, with extension (not used often)
#  		//usjgofs.whoi.edu/test.html0
#	URLOBJX == object spec as usable from a browser (jg/serv and ext.)
#  		//usjgofs.whoi.edu/jg/serv/test.html0
#	URLOBJ == object spec as above without the ext. (calling scripts)
#  		//usjgofs.whoi.edu/jg/serv/test
#	PROTOLEV == just the extension
#		html0
#	SUBSELS == subselections list used to pass to scripts/programs
#		press>100 ( or for string compare: press%20gt%20100)
#	DISPSS == un-trigram'ed subselections for displaying in browser
#		press>100 ( or for string compare: "press gt 100")
#
#    December 7, 1999 clh
#	add another variable DISPOBJ, the display-style object,
#	complete with subselections if present
#
# 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
#
#!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
#
# NVB: until a better way is found, when changing this file:
#    Please edit the .tmp (template) file in source tree, and
#    modify build-opt-env.tmp with same changes you make here
#
#!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
#
#  
$topdir = "jgofsdir";
$ENV{'OPTHOME'} = $topdir;
$rundir = "scriptloc";
$ENV{'OPTRUNDIR'} = $rundir;
#
$ENV{'MYADDR'} = "myaddr";
$ENV{'DEFAULT_PORT'} = portaddr;
$tempdir = "temporaryfiledir";
#
# we need this directory to exist so that a subdir can be created
#
if (!-e $tempdir) {
  $success = mkdir($tempdir,493);
  if (not $success) {
    print STDERR "*** ALERT:  $tempdir could not be created ***\n";
    die "***    reason from mkdir:  $!\n";
  }
}
#
# REMOTE_HOST might be set, but HTTP guarantees REMOTE_ADDR
#
$ENV{'JGTEMP'} = $tempdir;
if ($ENV{'REMOTE_HOST'}) {
  $remotehost = $ENV{'REMOTE_HOST'};
} else {
  $remotehost = $ENV{'REMOTE_ADDR'};
}
#
# check that the temporary directory exists and that it has all setup
#    info/data in it that any of the menu items needs
#  mod November 2, 1998 - clh - move here so all items need not dup code
#
$realtempdir = "$tempdir"."/"."$remotehost";
if (!-e $realtempdir) {
#
# MODE arg for mkdir is in decimal, max (o777) is 511
#    we want to turn off group and other write bits (umask 022)
#    and, 022 is 18 decimal, so:  511 - 18 == 493
#
  $success = mkdir($realtempdir,493);
  if (not $success) {
    print STDERR "*** ALERT:  $realtempdir could not be created ***\n";
    die "***    reason from mkdir:  $!\n";
  }
}

$success = opendir(DIR,"$topdir/setup");
  if ($success) {
      @setup_files = readdir(DIR);
      closedir(DIR);
#
# if any of the setup files do not exist in tempdir, copy 'em
#
      foreach $i (@setup_files) {
        $setupfile = "$realtempdir"."/"."$i";
        if (! -e $setupfile) {
          &copy_file("$topdir/setup/$i", $setupfile);
        }
      }
  } else {
      print STDERR "*** ALERT:  cannot access $topdir/setup directory ***\n";
      print STDERR "***    reason:  $!\n";
  }

$ENV{'USETEMPDIR'}=$realtempdir;
&make_common_object_env_vars;
#&print_to_stderr_env;
#
#*********** subroutines
#
sub copy_file()
{
 $to = pop(@_);
 $from = pop(@_);

 open(FROM,"$from");
 open(TO,"> $to");
 
 while (<FROM>) {
   print TO;
 }
 
 close(FROM);
 close(TO);
}

sub make_common_object_env_vars{
  $path_info_string=`$topdir/bin/parse_path_info`;
  chomp($path_info_string);
  %path_info=split(/[,=]/,$path_info_string);
  $object=$path_info{"object"};
  $protocol=$path_info{"protocol"};
  $level=$path_info{"level"};

#
# there are potentially more items in the jgofs url which are options
#  not dealt with here. see path_info_routines documentation
#

  $ENV{'OBJECT'}="$object";
  if ($object ne "") {
    $urlobj=`$topdir/bin/fixurl $object`;
    chomp($urlobj);
    $ENV{'URLOBJ'}="$urlobj";
    $urlobj .= "."."$protocol"."$level";
    $ENV{'URLOBJX'}="$urlobj";
    $ENV{'OBJEXT'}="$object"."."."$protocol"."$level";
    $ENV{'PROTOLEV'}="$protocol"."$level";
    $ENV{'SUBSELS'} = "";
    $ENV{'DISPSS'} = "";
    $ENV{'DISPOBJ'} = "$object";
  }
#
# deal with the sub-selections, if any
#
  if ($ENV{'QUERY_STRING'}) {
    if ($ENV{'QUERY_STRING'} ne "") {
      $subsels_qs = "$ENV{'QUERY_STRING'}";
      $ENV{'SUBSELS_QS'} = "$subsels_qs";
#
# Check QS for htmlescaped operator - if found, unescape for subsels
#      ex: press&lt;200 --->  press<200
#
      if ($subsels_qs =~ /[&;]/) {
         $subsels = `$topdir/bin/htmlunesc "$subsels_qs"`;
      } else {
         $subsels = "$subsels_qs";
      }
      $ENV{'SUBSELS'} =  `$topdir/bin/trigram_util "$subsels"`;
#
# Check QS for operator that should be htmlescaped for displaying
#      ex: press<200 --->  press&lt;200
#
      if ($subsels =~ /[<>]/) {
         $dispss = `$topdir/bin/htmlesc "$subsels"`;
      } else {
         $dispss = "$subsels_qs";
      }
      $disp_style = `$topdir/bin/trigram_util -un "$dispss"`;
      $ENV{'DISPSS'} = "$disp_style";
      $ENV{'DISPOBJ'} = "$object"."("."$disp_style".")";
    } 
  }
}

sub print_to_stderr_env{

print STDERR "environment established at present\n";
while (($key,$value) = each %ENV) {
  print STDERR "$key=$value\n";
}
}