#!/usr/bin/perl -w { $version = "plotopt version 2.2 1 Jun 2012"; # 1 Jun 12. WJS v 2.2 # Recode read loop to properly check for errors # 4 Jun 09. WJS v 2.1 # Comment out the require for backtick, since it apparently gets # imported when we do opt-build-env.pl. Some day I'll figure out # this scoping stuff ... # 29 May 09. WJS v 2.1 # Not really necessary to `cat file` to read a 1-line file! # But IS necessary to check the 1 line (don't know exactly how, # but there were errors in log - presumably from some follow-every- # link bots) # Change from SUBSELS_QS to SUBSELS. SUBSELS_QS was untrigrammed # (and also htmlesc'ed (eg, could have had had < rather than <) # except that I don't think html escapes could ever make it into # QUERY_STRING). This is a housekeeping move, in prep for # SUBSELS to trigram more stuff. # 20 Jul 08. WJS v 2.1 (apparently never used! since apparently # never finished!!) # Check some stuff we think we get from build-opt-env.pl # Get varlist from wjs_web_perl_utilities.pl routine # 27 Jul 05. WJS v 2.0 # Rewrite in perl. More transcription than rewrite except for next items require ("cgi-lib.pl"); require "wjs_web_perl_utilities.pl"; # require "backtick.pl"; # We get backtick in the require for build-opt-env require "build-opt-env.pl"; &printheader(); $object = &check_build_opt_env_var('OBJECT',$build_opt_env); $tempdir = &check_build_opt_env_var('USETEMPDIR',$build_opt_env); $bindir = &check_build_opt_env_var('OPTHOME',$build_opt_env) . "/bin"; $dispfull = $callurl = $callfull = $object; if ($subsels = $ENV{'SUBSELS'}) { $dispfull .= "($ENV{'DISPSS'})"; $callurl .= "?$subsels"; $callfull .= "($subsels)"; } $listvar = "$bindir/listvar"; &check_x_access ($listvar); $curopt_file = "$tempdir/plotopt"; $curopt_list = &get_current_options($curopt_file); ($x_var,$x_axis,$y_var,$y_axis,$symbol,$dummy) = split (' ',$curopt_list); $symbol || &quit ("Not enough fields in $curopt_file record","record = $curopt_list"); $dummy && &quit ("Too many fields in $curopt_file record","record = $curopt_list"); $cleanploturl = '/jg/cleanplot' . $object . '.plotopt?' . $subsels; print <Simple XY Plotting

Simple XY Plot

Current object is: $dispfull

Note: this routine plots non-numeric data at (-9999,-9999)
You may wish to go to the Subsetting Data page and remove known
non-numeric data such as "nd"s or "NaN"s

Select this link, if the form looks incomplete.

XXstuffXX # May want to play w/caching and/or coordinate it with cleanplot button # The undef and the 0 are the things to be played with - see doc (undef,@def_varlist) = &get_cached_varlist($listvar,$tempdir,$callfull,0); &print_variable_selection('x',$x_var); &print_axis_selection('x',$x_axis); print "
\n"; &print_variable_selection('y',$y_var); &print_axis_selection('y',$y_axis); print "
\n"; &print_symbol_selection($symbol); print < if the selected options are satisfactory. XXstuffXX undef $version; # Avoid "1-time" use diagnostic. $version used by &quit exit 0; } sub get_current_options { my ($curopt_file,$dummy) = @_; my ($curopt_list,$nlines); $dummy && &quit("Internal error - get_current_options called w/ too many args"); $curopt_file || &quit("Internal error - no file passed to get_current_options"); (open (CUROPT,$curopt_file)) || &quit("Could not read $curopt_file","\$! = $!"); $nlines = 0; while (! eof(CUROPT)) { $nlines++; (defined ($curopt_list = )) || &quit ("Error reading $curopt_file record $nlines; ","\$! = $!"); } close (CUROPT); ($nlines == 0) && &quit ("System inconsistency - empty $curopt_file"); ($nlines > 1) && &quit ("System inconsistency - $nlines records in $curopt_file"); return $curopt_list; } sub print_variable_selection { my ($xy,$default) = @_; my ($temp); if ($xy eq 'x') { $temp = "an X"; } elsif ($xy eq 'y') { $temp = "a Y"; } else { &quit ("print_variable_selection received unknown arg $xy"); } # Note that code prints $default in the next line even if $default # does not happen to be in variable list of object. This duplicates # original csh coding... print "Select $temp variable ($default):
\n"; return; } sub print_axis_selection { my ($xy,$default) = @_; print "Select a reverse or log " . uc($xy) . " axis ($default):
\n"; return; } sub print_symbol_selection { my ($default) = @_; print "Select a symbol for plotting the values ($default): " . "
\n"; return; }