#!/usr/local/bin/perl -w
# about.pl
#Obtains information from the U.S. GLOBEC Georges Bank data management
#system about the cruiseid, chief scientist, etc.
$version="V1.16/June 27, 2003";
# Modified: June 27, 2005. V1.16. Replace last print with print STDOUT.
# Fix checking for existance of array by using first element in
# test. rcg
# Modified: June 15, 2005. V1.15. Add $debug flag to help debugging.
# rcg
# Modified: July 2, 2003. V1.14. Check for presence of wild card symbol
# "*" in search string, and replace with ".*" since comparison fails
# with just the "*". Also, check for the presence of multiple words
# when searching the remoteobject files and look for each word
# by itself. May want to do this for the inventory search as well. rcg
# Modified: June 18, 2002. V1.13. Fix parsing in URL to not strip away
# unscores within object names. This is done using the magic
# number of $desc_index equal to 12. Try to suppress quotes marks
# in Description field. Remove code to suppress quotes elsewhere.
# rcg
# Modified: June 25, 2001. V1.12. Fix parsing of URL in remoteobjects
# to accept a second "=" in the URL (e.g. for selections)
# Modified: December 29, 2000. V1.11. Fix parsing of URL in remoteobjects
# files to handle missing /jg/serv/ string. rcg
# Modified: September 5, 2000 V1.10. Add to stop this tag before
# next output material. Add searching of .remoteobjects files. rcg
# Modified: August 13, 1999 V1.01. Add -z to list options to remove
# extra spaces. Change split code to parse using tab not \s. rcg
# Original version: V1.00/August 11, 1999
# R. Groman
$|=1;
$error="
&x";
$warning="
#";
$debug = "no";
print STDOUT ("Content-type: text/html\n\n",
"\nU.S. GLOBEC Georges Bank Cruise About Utility",
"\nU.S. GLOBEC Georges Bank About Utility",
"\n
\n\n\n\n");
$get_remoteobjects =
'/data/rgroman/scripts/dot_remoteobjects/list_dot_remoteobjects.pl';
$remoteobjects_root = '/data5/globec/objects/globec/gb';
$option = `/data/rgroman/Inventory/scripts/poststring`;
chomp $option;
$option =~ s/\s//g;
unless (defined $option and ($option =~ m/\w+/) ) {
print STDOUT ("No about string present. Please hit the",
" \"Back\" button on your browser resubmit.\n",
"\n");
exit;
}
$option_nu = $option;
$option_nu =~ s/_/ /g;
print STDOUT ("Looking up information about ",
$option_nu, ". Please wait...
\n");
$option_uc = uc $option;
$option_uc =~ s/\*/\.\*/g;
$option_uc =~ s/\.\./\./g;
$inventoryobject="/globec/gb/inventory";
$prev_inventory_key=".";
$last_inventory_param=8;
@required_keys = ("project", "platform", "year_p_start", "month_p_start",
"day_p_start", "year_p_end", "month_p_end", "day_p_end", "name_prin",
"data_type", "siname", "status", "description");
@output_heading = ("Cruiseid/Project", "Platform", "Start
Year",
"Start
Month",
"Start
Day", "End
Year", "End
Month", "End
Day",
"PI", "Instrument", "SI", "Status",
"Description");
#Try lookup with string as cruiseid
# $desc_index is location of description field within array used below
# Needed so that underscore is not removed from object name
$desc_index = 12;
$object=$inventoryobject . "\\(project,platform," .
"year_p_start,month_p_start," .
"day_p_start,year_p_end,month_p_end," .
"day_p_end,name_prin,brief_desc,data_type,siname," .
"status,description\\)";
#print STDOUT ("\n
**debug, object=$object\n\n");
unless (open INVENTORY, "/data5/globec/bin/list -f -c -t -n -z $object |") {
&sendmessage ($error, "
Could not open inventory file, error=$! ",
"Contact the DMO");
exit;
}
@array = ;
close INVENTORY;
@fieldnames = split /\t/, $array[0];
print STDOUT ("**debug, arrary[0] (field names)=$array[0]\n")
if $debug eq 'yes';
for ($i=0; $i <= $#fieldnames; $i++) {
($fieldnames[$i],$qual) = split /\[/, $fieldnames[$i];
print STDOUT ("
**debug, fieldnames[$i]=$fieldnames[$i]\n")
if $debug eq 'yes';
}
undef $qual;
@saveindex = ();
#Search for option string somewhere in the inventory
for ($i=1; $i <= $#array; $i++) {
print STDOUT ("
**debug, array[$i]=$array[$i]\n")
if $debug eq 'yes';
$record_uc = uc $array[$i];
print STDOUT ("
**debug, record_uc=$record_uc\n\t",
"option_uc=",$option_uc,"\n") if $debug eq 'yes';
if ($record_uc =~ m/$option_uc/ ) {push @saveindex, $i; }
}
#print table heading
if ( $#saveindex >= 0 ) {
print STDOUT ("
\n\n");
$output = "";
for ($i=0; $i <= $last_inventory_param; $i++) {
$output = $output . "| " . $output_heading[$i] . " | ";
}
print STDOUT ("$output
\n");
foreach $i (@saveindex) {
&print_inventory_info ($option, $array[$i]);
}
print STDOUT ("
\n");
}
else {
print STDOUT ('
There are no matches for ',
$option_nu, ' in the inventory file. ');
if ($option_nu =~ m/\s/ ) {
print STDOUT ("\n
Try entering a single word ",
"on which to search.\n");
}
}
# Check the .remoteobjects files on the main server
unless (open REMOTEOBJECTS, "$get_remoteobjects $remoteobjects_root |") {
&sendmessage ($error, "
Could not access remoteobjects files, error=$! ",
"Contact the DML");
exit;
}
@array = ;
close REMOTEOBJECTS;
print STDOUT ("\n
Checking the remote objects files. Please wait ...
\n");
&process_remoteobjects;
#Add other places to check latter.
undef $error;
undef $warning;
print STDOUT ("
Version: ",$version, "\n\n");
exit 0;
#---------------------------------------------------------------------------
sub sendmessage {
#Send a message to the user.
#The message sent will be in the strings $_[1] and $_[2]
#The prefix string is in $_[0]
my ( @args, $mailfile, $message0, $message1, $prefix, $who);
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst);
$prefix=$_[0];
$message0=$_[1];
$message1=$_[2];
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime(time);
if ($year > 97 and $year < 100 ) {$year = $year + 1900; }
$mon++;
if ($mon < 10) { $mon = "0" . $mon; }
if ($mday < 10) {$mday = "0" . $mday; }
if ($hour < 10) { $hour = "0" . $hour; }
if ($min < 10) { $min = "0" . $min; }
if ($sec < 10) { $sec = "0" . $sec; }
$mailfile=">/tmp/sendmess" . $year . $yday . $hour . $min . $sec . ".tmp";
if ( open TEMPFILE, $mailfile) {
if ( exists $ENV{'REMOTE_HOST'} ) {$who=$ENV{'REMOTE_HOST'} ; }
elsif (exists $ENV{'REMOTE_ADDR'} ) {$who=$ENV{'REMOTE_ADDR'} ; }
else {$who="not available"; }
print TEMPFILE ("Message from $0\n");
print TEMPFILE (" Date of message: $year/$mon/$mday $hour:$min\n");
print TEMPFILE (" From: $who\n");
print TEMPFILE (" $message0\n");
print TEMPFILE (" $message1\n");
close TEMPFILE;
`/usr/bin/mail -w dmo\@globec.whoi.edu <$mailfile`;
unlink $mailfile;
}
print STDOUT ($prefix,"Message from $0\n");
print STDOUT ($prefix," Date of message: $year/$mon/$mday $hour:$min\n");
print STDOUT ($prefix," $message0\n");
print STDOUT ($prefix," $message1\n");
return;
}
#-------------------------------------------------------------------------
sub print_inventory_info {
# Passed parameters are the keyword used to match on and
# the inventory record that matches the match
# criteria. These parameters are separated by tabs.
# Assumption: @fieldnames contains the field names from the object.
# @required_keys contain the fieldnames of those fields we want to
# display. @output_heading contains the headings for the table
# corresponding to the required keys. $last_inventory_param contains
# the field number of the last field name that will be used as the
# "key" in order to better display the results. $prev_inventory_key
# is contains the "old key" so we know when to "break" the table
# and start a new "major" row.
my ($header, $inventory_key, $i, $j, @local_values, $keyword, $output,
$required_key, @values, %values);
$keyword = $_[0];
@values = split /\t/, $_[1];
unless ($#values == $#fieldnames) {
&sendmessage ($error,"Unexpected condition. No. of values ($#values)",
"does not equal no. of fieldnames ($#fieldnames)");
exit;
}
print STDOUT ("\n");
$j=-1;
#print STDOUT ("***Debug, size of fieldnames=$#fieldnames
\n");
for ($i=0; $i <= $#fieldnames; $i++) {
foreach $required_key (@required_keys) {
if ($required_key eq $fieldnames[$i]) {
$j++;
$local_values[$j] = $values[$i];
# print STDOUT ("
***Debug, local_values[$j]=",
# "$local_values[$j]
\n")
# if $j == $desc_index;
$local_values[$j] =~ s/_/ /g unless $j == $desc_index;
$local_values[$j] =~ s/"//g if $j == $desc_index;
last;
}
}
}
#Create "key"
$inventory_key = "";
$output = "
";
for ($i=0; $i <= $last_inventory_param; $i++) {
$inventory_key = $inventory_key . $local_values[$i];
$output = $output . "| " . $local_values[$i] . " | ";
}
if ($inventory_key ne $prev_inventory_key) {
if ($prev_inventory_key ne "." ) {
print STDOUT ("\n
\n");
$header = "";
for ($i=0; $i <= $last_inventory_param; $i++) {
$header = $header . "| " . $output_heading[$i]
. " | ";
}
print STDOUT ("$header\n");
}
$prev_inventory_key = $inventory_key;
print STDOUT ("$output\n");
print STDOUT ("
\n\n",
"
\n");
$output = "";
for ($i=$last_inventory_param+1; $i <= $#required_keys; $i++) {
$output = $output . "| " .
$output_heading[$i] . " | ";
}
print STDOUT ("$output
\n");
}
$output = "";
for ($i=$last_inventory_param+1; $i <= $#required_keys; $i++) {
unless (defined $local_values[$i]) { next; }
$output = $output . "" . $local_values[$i] . " | ";
}
print STDOUT ("$output\n");
return;
}
#--------------------------------------------------------------------
sub process_remoteobjects {
# Process the remote object entries contained in the array @array.
# Assumptions:
# Input lines contists of the following, separated by tabs
# full file spec for location of object
# object=url or pseudo url
# contact or PI name
# short description
my ($command, $contact, $description, $i, $location,
$newoption, $object,
@option, $record, $url, @yes_list);
@yes_list = ();
@option = split /[_\.\s,]/, $option;
print STDOUT ("Looking for: /\n");
for ($i=0; $i<= $#option; $i++) {
$option[$i] =~ s/\*//g;
print STDOUT ("$option[$i]/");
}
print STDOUT ("\n");
unless (defined $option[0]) {$option[0] = $option}
#print STDOUT ("\n**debug, size of array=$#array
\n");
for ($i=0; $i <= $#array; $i++) {
# print STDOUT ("\n**debug, array[$i]=$array[$i]\n
");
foreach $newoption (@option) {
unless ($array[$i] =~ m/$newoption/i ) {
next;
}
else {
# print STDOUT ("\n**debug, option=$option, ",
# "array[$i]=$array[$i]\n
");
push @yes_list, $i;
last;
}
}
}
#print STDOUT ("\n**debug, size of yes_list=$#yes_list
\n");
if ($#yes_list > -1) {
print STDOUT ("\n\n");
print STDOUT ("| Object name | Contact or PI | ",
"Short description |
\n");
foreach $i (@yes_list) {
($location, $url, $contact, $description) = split /\t/, $array[$i];
($object, $command) = split /=/, $url, 2;
$command =~ s/\(/\?/;
$command =~ s/\)//;
# print STDOUT ("\n***debug, command=$command
\n");
unless ($command =~ m/\/jg\//i ) {
$command =~ s/(^\/+\w+\.\w+\.\w+\.*\w*)\/(.*)/$1\/jg\/serv\/$2/;
# print STDOUT ("\n***debug after replacement, command=$command
");
# print STDOUT ("\n***debug, 1=$1, 2=$2
\n");
}
unless ($command =~ m/\.html/i or $command =~ m/\.brev/i ) {
$command = $command . ".html0";
}
print STDOUT (
"
",
"| $object | ",
"$contact | ",
"$description | ",
"
");
}
print STDOUT ("\n
\n");
}
else {
print STDOUT ('
There are no matches for ',
$option_nu, ' in the remote object files. ');
if ($option_nu =~ m/\s/ ) {
print STDOUT ("\n
Try entering a single word ",
"on which to search.\n");
}
}
}
#-------------------------------------------------------------------------