#!/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.18/July 20, 2012"; # Modified: July 20, 2012. V1.18. Replace poststring with # return_web_form_data.pl routine. Replace local sendmessage.pl # with library area send_message.pl. Update mail sent to include # a subject line of the name of the program. Add scoping. rcg # Modified: March 26, 2007. V1.17. Stqart remoteobjects search # at globec level (one higher) so can see the SOGLOBEC and # NEP data sets. Temporarily using the list_dot_remoteobjects_new.pl # program since it has changes. Should change this to .active # after creating such a soft linked file. Still to do is the # expansion to look at the inventories of all three data sets, # not just one. It is worth a try to just create a loop around # the applicable code and cycle through all three subdirecties. rcg # 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 unshift (@INC, "/home/rgroman/perllib"); require ('send_message.pl'); require ('return_web_form_data.pl'); use lib "/home/rgroman/perllib"; $|=1; my $error="
&x"; my $warning="
#"; my $debug = "no"; print STDOUT ("Content-type: text/html\n\n", "\nU.S. GLOBEC Georges Bank Cruise About Utility", "\n

U.S. GLOBEC About Utility", "\n

\n\n\n\n"); my $get_remoteobjects = '/data/rgroman/scripts/dot_remoteobjects/list_dot_remoteobjects_new.pl'; my $remoteobjects_root = '/data5/globec/objects/globec'; #$option = `/data/rgroman/Inventory/scripts/poststring`; my $param_ref = &return_web_form_data(); my %param = %$param_ref; foreach my $key(keys %param) { $param{$key} =~ s/ /_/g; $param{$key} =~ s/\n/_/g; $param{$key} =~ s/\t/_/g; $param{$key} =~ s/\r/_/g; $param{$key} =~ s/,/_/g; $param{$key} =~ s/__/_/g; } unless (defined $param{'keyword'}) { print STDOUT ("

No keyword key from about routine. Please contact", " dmo\@whoi.edu. Sorry for the inconvenience\n", "\n"); exit; } my $option = $param{'keyword'}; 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; } my $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; my $inventoryobject="/globec/gb/inventory"; my $prev_inventory_key="."; my $last_inventory_param=8; my @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"); my @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 my $desc_index = 12; my $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 |") { &send_message ($error, "

Could not open inventory file, error=$! ", "Contact the DMO"); exit; } my @array = ; close INVENTORY; my @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; my @saveindex = (); #Search for option string somewhere in the inventory for (my $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 (my $i=0; $i <= $last_inventory_param; $i++) { $output = $output . ""; } print STDOUT ("$output\n"); foreach my $i (@saveindex) { &print_inventory_info ($option, $array[$i]); } print STDOUT ("
" . $output_heading[$i] . "

\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 |") { &send_message ($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 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) { &send_message ($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 . ""; } print STDOUT ("$header\n"); } $prev_inventory_key = $inventory_key; print STDOUT ("$output\n"); print STDOUT ("
" . $output_heading[$i] . "

\n

\n", " \n"); $output = ""; for ($i=$last_inventory_param+1; $i <= $#required_keys; $i++) { $output = $output . ""; } print STDOUT ("$output\n"); } $output = ""; for ($i=$last_inventory_param+1; $i <= $#required_keys; $i++) { unless (defined $local_values[$i]) { next; } $output = $output . ""; } 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 ("
" . $output_heading[$i] . "
" . $local_values[$i] . "
\n\n"); print STDOUT (" ", "\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 ( "

", "", "", "", ""); } print STDOUT ("\n
Object name Contact or PIShort description
$object$contact$description

\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"); } } } #-------------------------------------------------------------------------