#!perllocation
#
#  script name:  info
#  used from  :  jgofsdir/htmlbin
#  converted from info (/bin/csh script) originally written by Glenn Flierl
#  modified to read from .info files by Christine Hammond
#
# NOTE: /images/dir.gif and /images/datadisp.gif are used by this script 
#  if you do not have these buttons, you can get them on anonymous ftp at
#  dataone.whoi.edu (128.128.80.28) in /pub/images
#
# Modified September 10, 1999, clh:  take the object information
#   only from the path_info, in query_string are any current subselections
#   Historically we were checking both for the objectname.
#
# Modified 14 February 2000, clh:  determine the $ddir (path from 
#   objectroot to location of .info file) as "start of path_info up to 
#   the character where we found the objectname starting". logic had
#   been ".. up to the objectname", which did not allow for a sub-dir
#   named same as objectname (in this case, $ddir was wrong, .info not found)
#
################################################################
$dirlink="";
$datalink="";
$imagedir="imagedirectory";
#
# tell browser to display as html
#
   print "Content-type: text/html\n\n";
#
# get the arg, use tail only - should be objectname[+params]
#
# NOTE: info allows for either form: /jg/info?/path/obj
#                                    /jg/info/path/obj   <--- newer
# September 10, 1999: clh remove 'old' QS form of object 
#
 if ($ENV{'PATH_INFO'}) {
    $arg = $ENV{'PATH_INFO'};
 }
 if ($ENV{'QUERY_STRING'}) {
    $param = $ENV{'QUERY_STRING'};
 } 
#print STDERR $arg,"\n";
#print STDERR $param,"\n";
#
# Check for an extended URL 
#
 $ndx = index($arg,'{');
 if ($ndx >= $[) {
   $pathobj=substr($arg,0,$ndx);
   $extent=substr($arg,$ndx);
 } else {
   $pathobj=substr($arg,0);
   $extent="";
 }
#
# Check the object's type - htmlx, info, brevx - remove type
#
 $ndx = rindex($pathobj,'/');
 $obj = substr($pathobj,$ndx+1);
 if ($obj =~ /\.[hibj]+/) {
   $obj = substr($obj,0,(index($obj,".")));
 }
#print STDERR "object is $obj\n";
#
# arg's head is the path from top of object tree
#
 $ddir = substr($pathobj,0,$ndx);
#print STDERR "path to obj is $ddir\n";
#
# parse the extension to the URL, get Data URL if present
#
if ($extent) {
  if ($datapiece=index($extent,"data=")) {
    $datalink=substr($extent,$datapiece+5);
# 
# remove the final curly brackets from datalink 
#
    chop($datalink);
  }
#
# and get the Directory URL if present
#
  if (($ndx=index($extent,"dir=")) >= $[) {
    $dirlink=substr($extent,$ndx+4,$datapiece-6);
  }
}

#
# for returning to data object display, need new extension, to dir and info
#
$newextent="{dir="."$dirlink".",info=";
$newextent.="$ENV{'SERVER_NAME'}".":"."$ENV{'SERVER_PORT'}";
$newextent.="/jg/info"."$pathobj"."}";
#
# go to top of objects tree, plus current dir
# NOTE:  this assumes a standard jgofs structure with directories
#         htmlbin/ and objects/ at the first level subdirs of jgofsdir
#
   chdir("../objects$ddir");
#
# show the buttons for directory, data at top of screen
#
  if ($dirlink) {
     print "<a href=\"http://$dirlink\"><img alt=\"[Directory]\" \
        border=0 src=\"$imagedir/dir.gif\"></a> \n";
  }
  if ($datalink) {
     print " <a href=\"http://$datalink$newextent?$param\">
             <img alt=\"[Data...]\" \
        border=0 src=\"$imagedir/datadisp.gif\"></a>\n";
  }
#
# show the objectname for which we have a .info 
#
   print "<h1> $obj </h1>\n";
   print "<pre>\n";
#
# display contents of objectname.info file in current dir
#
 unless (open(INFILE, "$obj.info")) {
       print "No documentation found\n";
 }
 while (<INFILE>) {
     print $_;
 }
 close(INFILE);
#
# turn off pre tag set above 
#
   print "</pre>\n";
   print "<hr>\n";