[Thread Prev][Thread Next][Index]
Re: Getting scripts to run in LAS
Thanks Joe and Lynn,
I have it working now (at least LAS is processing the file) by
putting:
<properties>
<ferret>
<script_prefix>pom_</script_prefix>
</ferret>
</properties>
in dataset definition for this cdf file. Now it processes
pom_std_gif.tmpl. I tried it with a jnl extension but it didn't work.
After looking at the FAQ again I see what the problem is:
<FAQ>
The server code (server/Ferret.pl) uses the following algorithm to decide
which script to use:
# 1) look for template file with script prefix
# 2) look for template file without script prefix
# 3) look for journal file with script prefix
# 4) look for journal file without script prefix
</FAQ>
Since I am using a prefix, if I want to process a journal file like
pom_std_gif_xyref.jnl, then I will have to delete the std_gif.tmpl file so
it will go on to try to find the jnl file. However, this will make the
other datasets not work. I would have to either:
a. Create a set of jnls for each data set (or set of data sets)
and delete the std_gif.tmpl file.
or
b. Never use any jnl files but keep the std_gif.tmpl file.
I would prefer it if the algorithm swapped 2 and 3. I've just had a look
at the code in Ferret.pl and I've tried a solution that seems to work and
have attached Ferret.pl.new for any that are interested.
Is there a reason for doing it this way that I'm not seeing? Will this
change in the upcoming version?
I am also wondering if the upcoming version will have the ability to have
seperate map files for each dataset.
Thanks,
Steve
_____________________________________________________________
Steve Cousins Email: cousins@umit.maine.edu
Research Associate Phone: (207) 581-4302
Ocean Modeling Group
School of Marine Sciences 208 Libby Hall
University of Maine Orono, Maine 04469
On Fri, 2 Feb 2001, Joe Sirott wrote:
> Hi Steve,
>
> LAS caches the results of a given request. If you change the server code, but the LAS request is same, the new code will never be executed because LAS will just use the results in the cache. This might be the problem.
>
> Unfortunately, there is currently no easy way of disabling LAS caching. Alternatives are:
>
> - Delete all the files in the lasxml/server/output directory to clear the cache between requests
> - Change the LAS request -- use a slightly different region, for instance.
>
> You can verify that LAS is using the script that you configured by putting an invalid command in the script. If you request data from LAS, a page will be returned indicating that there is an error.
>
> Finally, you can get ideas on how to generalize your template files by looking at the .tmpl scripts that included with LAS. Take a look at std_gif.tmpl, or draw_2d.tmpl (documentation on the templating language that is used by LAS is available by typing perldoc Template). To solve your specific
> problem, you could use:
>
> shade [% args.variable_name %], 'X','Y'
#
# Driver for Ferret in Live Access Server
#
# Original code J Callahan
# XML based redesign and rewritten by J Sirott
#
# $Id: Ferret.pl,v 1.43.4.2 2000/08/18 01:00:02 sirott Exp $
require("Ferret_config.pl");
use strict;
use CLC;
use POSIX;
package LAS::Server::Ferret;
#
# Set up inheritance from Handler base class
#
@LAS::Server::Ferret::ISA = qw(LAS::Server::Handler);
#
# Main Ferret module.
# This module 'drives' Ferret.
# Main entry points:
# init
# Initialize the LAS::Server::Ferret object with a LAS::Request
# object and an output file
# run
# Run the Ferret program
use LAS;
use LAS::Server;
my $Config = &LAS::Server::getConfig;
sub validateNumber {
my $innum = shift;
$innum =~ s/\s//g;
if ($innum !~ /^[+-]?\d*\.?\d*([eE][+-]?\d+)?$/){
die "Invalid number '$innum'\n";
}
}
sub validateDate {
my $datein = shift;
if ($datein){
my $looksLikeDate = scalar(split('-', $datein)) > 1;
if (!$looksLikeDate){
validateNumber($datein);
} else {
my $date = new LAS::Date($datein);
if (!$date->isOK){
die "Invalid date '$datein'\n";
}
}
}
}
# Static method to validate range/point types
# No bounds checks, just make sure that it's parseable
# Only validate t and z, since applet should validate x and y
sub validateArg {
my ($type, $lo, $hi) = @_;
if ($type eq "t"){
validateDate($lo);
validateDate($hi);
} elsif ($type eq "z"){
validateNumber($lo);
validateNumber($hi);
}
}
# Get dataset name and variable name from variable
# Static function.
sub getDataAndVarName {
my ($var) = @_;
my $url = $var->getURL;
my $frag = $url->frag;
$url =~ s/file://;
$url =~ s/#.*$//;
my $dsetname = $url;
my $varname = $frag;
$varname = $var->getName if ! $frag;
return ($dsetname, $varname);
}
sub fixArg {
my $arg = shift;
# Ferret dies if a climatology isn't specified as a climatology
# in dataset metadata (modulo attribute). So,
# with strings such as "1-jan" (i.e. no year specified). we *should* just
# append a '0000'.
my ($lo,$hi) = ($arg->getLo, $arg->getHi);
my $lodate = new LAS::Date($lo);
$lo = $lodate->toFerretString;
my @values = split('-',$lo);
if (scalar @values == 2){
$lo .= "-0000";
}
$arg->setLo($lo);
my $hidate = new LAS::Date($hi);
$hi = $hidate->toFerretString;
my @values = split('-',$hi);
if (scalar @values == 2){
$hi .= "-0000";
}
$arg->setHi($hi);
}
sub fixLongitude {
# Ferret has problems with longitudes < 0
my ($xlo, $xhi) = @_;
if ($xlo ne "" && $xlo < 0){
$xlo += 360;
if ($xhi ne ""){
$xhi += 360;
}
}
if ($xhi ne "" && $xhi < 0){
$xhi += 360.;
}
return ($xlo, $xhi);
}
# Default properties
my %DefaultProperties =
{
do_shade => 1, do_contour => 0, rank => 2
};
sub debugProps {
my ($self, $name, $props) = @_;
return if ! defined $props;
#
# Dump to debug
foreach (keys %{$props}){
my $obj = $props->{$_};
if (ref($obj) eq 'ARRAY'){
debug("$name prop array: $_ = (",
join(',', @{$obj}), ")\n");
} else {
debug("$name prop: $_ = $obj\n");
}
}
}
# Initialize based on LAS::Request object, output file
sub init {
my ($self, $req, $output) = @_;
#
# Make sure ferret has write access to this directory
#
die "CGI process needs write access to server directory"
if ! -w '.';
$self->{req} = $req;
$self->{output_file} = $output;
#
# Get the variable and region. For now, there should only one region
#
my @children = $req->getChildren;
my @vars = ();
my @regions = ();
$self->{vars} = \@vars;
$self->{regions} = \@regions;
foreach (@children){
my $class = ref ($_);
if ($class eq "LAS::Variable"){
push(@vars, $_);
} elsif ($class eq "LAS::Region"){
push(@regions, $_);
}
}
die "Missing variable arguments" if ! scalar @vars;
die "Missing region argument" if ! scalar @regions;
my $var = $vars[0];
my $region = $regions[0];
#
# Merge all properties
#
my $config = $req->getConfig;
$self->{props} = &LAS::mergeProperties($self->{props},
scalar $config->getProperties('ferret'),
scalar $var->getDataset->getProperties('ferret'),
scalar $var->getProperties('ferret'),
scalar $req->getProperties('ferret'));
my $props = $self->{props};
#
# Get all custom properties
#
my @customProps = ();
foreach (@vars){
my $props = $_->getProperties('custom');
push(@customProps, $props) if defined $props;
}
$self->{custom} = \@customProps;
$self->debugProps('custom (var 0)',$self->{custom}->[0]);
$self->debugProps('custom (var 1)',$self->{custom}->[1]);
#
# Get dataset_name, variable_name
#
($props->{dataset_name}, $props->{variable_name}) =
getDataAndVarName($var);
if ($req->getOp->getName eq 'vector'){
#
# In case this is a vector plot...
#
my $firstDsetName = $props->{dataset_name};
my @varNames = ($props->{variable_name});
for (my $i = 1; $i < scalar @vars; $i++){
my ($dsetName, $varName) = getDataAndVarName($vars[$i]);
die "Attempted vector plot with variables ",
"from multiple datasets -- not supported"
if $dsetName ne $firstDsetName;
push(@varNames, $vars[$i]->getName);
}
$props->{variable_name} = \@varNames;
}
#
# Get the view, legacy x_lo, etc. crud
#
my $view;
my @regChildren = $region->getChildren;
my $count = 0;
foreach my $arg (@regChildren){
my $type = $arg->getAttribute("type");
die "No axis type for range" if ! $type;
die "Invalid range type: $type" if ($type !~ /x|y|z|t/);
$view .= $type if ref($arg) eq "LAS::Range";
validateArg($type, $arg->getLo, $arg->getHi);
fixArg($arg) if $type eq 't';
my ($lo,$hi) = ($arg->getLo, $arg->getHi);
debug("Region: $lo $hi $type\n");
$props->{$type . '_lo'} = $lo;
$props->{$type . '_hi'} = $hi;
}
$view =~ tr/A-Z/a-z/;
$props->{'view'} = $view;
$props->{rank} = length($view);
if ($props->{y_lo} < $props->{y_hi}) {
$props->{diag_direction} = "up";
} else {
$props->{diag_direction} = "down";
}
$props->{refmap_view} = "box";
if ( $view =~ /.*x.*/i ) {
if ( $view !~ /.*y.*/i ) {
$props->{refmap_view} = "xline";
}
} elsif ( $view =~ /.*y.*/i ) {
$props->{refmap_view} = "yline";
} else {
$props->{refmap_view} = "point";
}
# X Range strings
($props->{x_lo}, $props->{x_hi}) =
fixLongitude($props->{x_lo}, $props->{x_hi});
$props->{jnl_x} = [];
$props->{jnl_y} = [];
$props->{jnl_z} = [];
$props->{jnl_t} = [];
if ( $props->{x_lo} ne "" ) {
$props->{refmap_xlo} = $props->{x_lo};
if ( $props->{x_hi} eq "" || $props->{x_hi} eq $props->{x_lo} ) {
$props->{refmap_xhi} = $props->{x_lo};
push(@{$props->{jnl_x}}, $props->{x_lo});
} else {
$props->{refmap_xhi} = $props->{x_hi};
push(@{$props->{jnl_x}}, $props->{x_lo});
push(@{$props->{jnl_x}}, $props->{x_hi});
}
}
# Y Range strings
if ( $props->{y_lo} =~ /([0-9\.]*)s/i ) { $props->{y_lo} = -1.0 * $1; }
if ( $props->{y_lo} =~ /([0-9\.]*)n/i ) { $props->{y_lo} = $1; }
if ( $props->{y_hi} =~ /([0-9\.]*)s/i ) { $props->{y_hi} = -1.0 * $1; }
if ( $props->{y_hi} =~ /([0-9\.]*)n/i ) { $props->{y_hi} = $1; }
if ( $props->{y_lo} ne "" ) {
$props->{refmap_ylo} = $props->{y_lo};
if ( $props->{y_hi} eq "" || $props->{y_hi} eq $props->{y_lo} ) {
$props->{refmap_yhi} = $props->{y_lo};
push(@{$props->{jnl_y}}, $props->{y_lo});
} else {
$props->{refmap_yhi} = $props->{y_hi};
push(@{$props->{jnl_y}}, $props->{y_lo});
push(@{$props->{jnl_y}}, $props->{y_hi});
}
}
# Z Range strings
if ( $props->{z_lo} ne "" ) {
if ( $props->{z_hi} eq "" ) {
push(@{$props->{jnl_z}}, $props->{z_lo});
} else {
push(@{$props->{jnl_z}}, $props->{z_lo});
push(@{$props->{jnl_z}}, $props->{z_hi});
}
}
# T Range strings
if ( $props->{t_lo} ne "" ) {
if ( $props->{t_hi} eq "" ) {
push(@{$props->{jnl_t}}, $props->{t_lo});
} else {
push(@{$props->{jnl_t}}, $props->{t_lo});
push(@{$props->{jnl_t}}, $props->{t_hi});
}
}
#
# Initialize default properties (if not already done)
#
foreach my $key (keys %DefaultProperties){
$props->{$key} = $DefaultProperties{$key}
if ! defined $DefaultProperties{$key};
}
$self->debugProps('ferret', $props);
}
sub setSymbol($$$) {
my ($self,$key,$value) = @_;
$self->command("define symbol $key = " . $value);
}
sub preExecute {
my ($self) = @_;
# Before starting, get rid of the "ferret.jnl" and ".gif" files
# from previous runs.
unlink 'ferret.jnl';
unlink '.gif';
# Create communication with ferret
# Create a bunch of useful variables
# Create a list of unrecognized parameters
my $ferret = $self->{ferret} = new CLC($Config->{which_ferret}, "yes? ");
$ferret->accept_error("*** NOTE: ");
my @symbol_names = $self->unrecognized_parameters;
# Invoke Ferret
$ferret->start($Config->{ferret_args});
$ferret->wait_for_prompt;
$self->command("cancel mode verify");
my $interp_mode = $self->{props}->{interpolate_data};
if ($interp_mode && $interp_mode eq 'true'){
$self->command("set mode interp");
} else {
$self->command("cancel mode interp");
}
# Use all of the unrecognized name-value pairs from the
# form to create ferret symbols which may be used by
# modified journal scripts.
foreach my $symbol_name (@symbol_names) {
my $symbol_value = $Config->{$symbol_name};
$self->command("define symbol $symbol_name = $symbol_value") if $symbol_value;
}
# 'GO "initialization_script~"
my $init_script = $self->{props}->{init_script};
if ( $init_script ) {
my $command = "GO $init_script";
$self->command($command);
}
#
# Evaluate expressions, if present
#
my $props = $self->{props};
my @exprs = ($props->{expression}, $props->{expression2});
foreach my $expr (@exprs){
if ($expr){
my $err = "Invalid option: Evaluate Expression: $expr";
#
# Only allow characters in algebraic expressions
#
die $err if $expr !~ /^[\s\d\*\+\?\-\/\^eE\$\.]*$/;
#
# Must have at least one $ reference because contour/fill plotting
# chokes on constant expressions (and gives error message that can't
# be distinguished from too-small regions)
#
die $err if $expr !~ /(\$)+/;
#
# Let Perl evaluate the validity of the expression for us
#
my $lastwarn = $SIG{'__WARN__'};
$SIG{'__WARN__'} = sub { $@ = $_[0]};
$expr =~ s/\$/\$foo/g; # Temporary placeholder for $
eval "use strict; my \$foo = 1; $expr";
$expr =~ s/\$foo/\$/g;
die $err if $@;
$SIG{'__WARN__'} = $lastwarn;
}
}
#
# Strip white space out of contour and fill properties
#
$props->{contour_levels} =~ s/\s+//g if $props->{contour_levels};
$props->{fill_levels} =~ s/\s+//g if $props->{fill_levels};
}
sub execute {
my ($self, $method) = @_;
eval('$self->' . $method);
if ($@){
unlink $self->{output_file};
die $@;
}
}
sub postExecute {
my ($self) = @_;
my $ferret = $self->{ferret};
$ferret->send_command("quit");
# Save a record of the transaction and close the communication
debug($ferret->{TRANSCRIPT});
$ferret->close;
if (defined $ferret->{ERROR}) {
die($ferret->{TRANSCRIPT});
}
$self->{ferret} = undef;
}
use CGI::Carp qw(croak);
sub close {
my $self = shift;
my $kill = shift;
my $ferret = $self->{ferret};
if ($ferret){
$ferret->close($kill);
}
}
sub command {
my ($self, $comm, @args) = @_;
my $out_string = $comm;
foreach (@args){
my $val = $self->{props}->{$_};
$val = $self->{$_} if ! defined $val;
$val = ' ' if ! defined $val;
my $outVal;
if (ref($val) eq "ARRAY"){
foreach my $v (@{$val}){
$outVal .= '"' . $v . '"';
}
$outVal =~ s/\"\"/\" \"/g;
} else {
$outVal .= '"' . $val . '"';
}
debug("command: props is: ", $self->{props}, " arg is: '$_' val is: $outVal\n");
$out_string .= " $outVal";
}
$out_string .= "\n";
$self->{ferret}->do_command($out_string);
}
#
# Setup a Ferret region. Moved functionality from GO script and
# into Perl to allow embedded quotes
#
sub setup_region {
my $self = shift;
my $props = $self->{props};
my @args = ();
my @defaults = qw(0e:360 09s:90n k=1 l=1);
my @axes = qw(x= y= z= t=);
my $index = 0;
foreach my $arg ($props->{jnl_x}, $props->{jnl_y},
$props->{jnl_z}, $props->{jnl_t}) {
# Quote each argument
my @qarg = ();
foreach my $limit (@{$arg}){
push(@qarg, qq/"$limit"/);
}
# If non-empty, join arguments with ':'
if (scalar @qarg == 0){
push(@args, $defaults[$index]);
} else {
my $newarg = $axes[$index] . join(':', @qarg);
push(@args, $newarg);
}
$index++;
}
my $comm = "set region/" . join('/',@args);
$self->command($comm);
}
#
# Use Perl Templates to avoid hassles with Ferret
# scripting language
#
sub template($$$){
my ($self, $file, $args, $extraArgs) = @_;
my $propList = {};
# Lists in args are joined with ','
foreach (@{$args}){
my $val = $self->{props}->{$_};
$val = $self->{$_} if ! defined $val;
$val = '' if ! defined $val;
if (ref($val) eq "ARRAY"){
$val = join(@{$val}, ',');
}
$propList->{$_} = $val;
debug("template: props is: ", $self->{props}, " arg is: '$_' val is: $val\n");
}
# Lists in extraArgs are left as is
if (defined $extraArgs){
foreach (@{$extraArgs}){
$propList->{$_} = $self->{props}->{$_};
}
}
# Add any custom arguments
$propList->{custom} = $self->{custom};
# Set up calls to template module
my $vars = {args => $propList};
my $templateConfig = {INCLUDE_PATH => ['.','jnls'], EVAL_PERL => 1};
my $template = Template->new($templateConfig);
my $outfile = "/tmp/lasgo$$" . int(rand(10000000)) . ".jnl";
$template->process($file, $vars, $outfile) || die $template->error();
$self->command("GO \"$outfile\"");
# die $outfile;
unlink $outfile;
}
#
# Run a templated journal file or a regular journal file
# Search strategy is:
# 1) Look for template file with script prefix
# 2) Look for template file without script prefix
# 3) Look for journal file with script prefix
# 4) Look for journal file without script prefix
#
sub runJournal($$) {
my ($self, $templateName, $args, $extraArgs, $jnlName, $jnlArgs) = @_;
$extraArgs = [] if ! defined $extraArgs;
$jnlName = $templateName if ! defined $jnlName;
$jnlArgs = $args if ! defined $jnlArgs;
my $script_prefix = $self->{props}->{script_prefix};
#############################################################################
# Original code:
#############################################################################
# my @templateNames = ('jnls/' . $script_prefix . $templateName . '.tmpl',
# 'jnls/' . $templateName . '.tmpl');
# my @jnlNames = ('jnls/' . $script_prefix . $jnlName . '.jnl',
# 'jnls/' . $jnlName . '.jnl');
# foreach my $template (@templateNames){
# if (-r "$template"){
# debug("\nRunning template file $template\n");
# $self->template($template, $args, $extraArgs);
# return;
# }
# }
# foreach my $jnl (@jnlNames){
# if (-r "$jnl") {
# debug("\nRunning journal file $jnl\n");
# $self->command(qq/GO "$jnl"/, @{$jnlArgs});
# return;
# }
# }
#############################################################################
# New code:
#############################################################################
my @scriptNames = ('jnls/' . $script_prefix . $templateName . '.tmpl',
'jnls/' . $script_prefix . $jnlName . '.jnl',
'jnls/' . $templateName . '.tmpl',
'jnls/' . $jnlName . '.jnl');
my $script_num = 0;
foreach my $script_name (@scriptNames){
if (-r "$script_name"){
if ( $script_num % 2 ){
debug("\nRunning journal file $script_name\n");
$self->command(qq/GO "$script_name"/, @{$jnlArgs});
return;
}
else
{ debug("\nRunning template file $script_name\n");
$self->template($script_name, $args, $extraArgs);
return;
}
}
$script_num++;
}
#############################################################################
# End of new code
#############################################################################
my $dieMess = "Can't open either template file for template $templateName or journal file for $jnlName";
$dieMess .= "\n with script_prefix $script_prefix"
if defined($script_prefix);
die $dieMess;
}
#
# Generate a Ferret graphic
#
# Currently supports line and shade plots
#
sub draw {
my ($self, $noContours, $noExpressions) = @_;
$self->setup_region;
my $props = $self->{props};
my $size = $props->{size} ? $props->{size} : "0.25";
$self->command("SET WINDOW/SIZE=$size");
$self->needReferenceMap;
# More featuritis. Handle expressions
my $expr = $props->{expression};
if (! $noExpressions && $expr){
my $var = $props->{variable_name};
$expr =~ s/\$/$var/g;
my $comm = qq/let data = $expr/;
$self->command($comm);
$props->{variable_name} = 'data';
}
# 'GO std_gif_~ ...'
my $view = $props->{view};
$props->{magnify} = $self->magnification;
my $command;
if ( $view =~ /xy/ ) { # "Normal" xy view
my $aspect = $self->aspectRatio;
debug("Aspect: $aspect\n");
$self->command("set win/asp=$aspect");
}
# Add contours if xy or xz view
my $do_contour = 0;
if (!$noContours && $view eq 'xy' || $view eq 'xz'){
$props->{do_contour} = 1;
}
# Set up template
my @args = qw(dataset_name variable_name fill_type view
fill_levels contour_levels magnify palette draw_reference
do_shade do_contour do_overlay rank title
overlay_variable_name);
my @extraArgs = qw(overlay_labels);
my $numaxes = $props->{rank};
my $jnlName = "std_gif_" . $view . "ref";
my @jnlArgs;
if ($numaxes == 2){
@jnlArgs = qw(dataset_name variable_name fill_type
fill_levels contour_levels magnify palette
draw_reference);
} else {
@jnlArgs = qw(dataset_name variable_name draw_reference);
}
$self->runJournal('std_gif', \@args, \@extraArgs,
$jnlName, \@jnlArgs);
# 'GO std_refmap ...disabled for variable comparisons'
if ($self->{draw_reference}) {
@jnlArgs = qw(refmap_xlo refmap_xhi refmap_ylo refmap_yhi
refmap_view magnify);
$self->runJournal('std_refmap', \@jnlArgs);
}
$self->command(qq:FRAME/FORMAT=gif/FILE="$self->{output_file}":);
}
sub isClimatology {
my ($expr) = @_;
return 0 if ! defined $expr;
my @vals = split('-', $expr);
return !$vals[2] || $vals[2] == 1 ;
}
# Add N/S labeling for x or y axis, clean up climatology for t axis
sub filterLabel {
my $hash = shift;
foreach my $key (keys %{$hash}){
my $val = $hash->{$key};
if ($key eq 'x'){
$val = POSIX::fmod($val, 360);
if ($val > 180){
$val -= 360;
}
if ($val < 0){
$val = -$val;
$val .= 'W';
} else {
$val .= 'E';
}
} elsif ($key eq 'y'){
if ($val < 0){
$val = -$val;
$val .= 'S';
} else {
$val .= 'N';
}
} elsif ($key eq 't'){
$val =~ s/\-0000//;
}
$hash->{$key} = $val;
}
}
sub setupCompare {
my ($self) = @_;
$self->{is_compare} = 1;
my @vars = @{$self->{vars}};
my @regions = @{$self->{regions}};
die "Compare needs two variables" if scalar @vars != 2;
die "Compare needs two regions" if scalar @regions != 2;
my ($data1,$var1) = getDataAndVarName($vars[0]);
my ($data2,$var2) = getDataAndVarName($vars[1]);
my @names = ($vars[1]->getLongName, $vars[1]->getDataset->getLongName,
$vars[0]->getLongName, $vars[0]->getDataset->getLongName);
#
# Get variable points and regions
#
my (@var_pts,@var_regs, @is_climat);
for (my $i=0; $i < 2; $i++){
my (%pts, %regs);
foreach my $val ($regions[$i]->getChildren){
my $class = ref($val);
my $type = $val->getAttribute('type');
my($lo, $hi) = ($val->getLo, $val->getHi);
($lo, $hi) = fixLongitude($lo, $hi) if $type eq 'x';
if ($class eq "LAS::Point"){
$pts{$type} = $lo;
} elsif ($class eq "LAS::Range"){
$regs{$type} = $lo . ':' . $hi;
} else {
die "Invalid child class of LAS::Region ", $class;
}
push(@is_climat, &isClimatology($lo)) if $type eq 't';
}
push(@var_pts, \%pts);
push(@var_regs, \%regs);
}
$is_climat[1] = $is_climat[0] if ! defined $is_climat[1];
# Construct an expression for the differenced variable using the ever
# awkward Ferret syntax.
#
# Rules are:
# 1) For each range (shared between variables) regrid the second var to the
# the first grid
# Invariant: All ranges overlap
# 2) Each defined point for each variable is associated with said variable
# 3) If one var is on climatological grid, and other is not, use the time
# range and grid of the non-climatological variable
my @var_exprs;
my %diff_regions;
my $use_second_time_grid = $is_climat[0] && ! $is_climat[1];
my @dexpr = qw(1 2);
$dexpr[1] = 1 if $vars[0]->getDataset == $vars[1]->getDataset;
# First variable
my %var_expr;
my $pts = $var_pts[0];
my $regs = $var_regs[0];
$var_expr{d} = $dexpr[0];
foreach my $type (keys %{$pts}){
$var_expr{$type} = $pts->{$type};
}
foreach my $type (keys %{$regs}){
my $tmp;
if ($type eq 't' && $use_second_time_grid){
my $tval = $var_regs[1]->{$type};
$tval = $regs->{$type} if ! $tval;
$var_expr{$type}=$tval;
} else {
$var_expr{$type} = $regs->{$type};
$diff_regions{$type} = $regs->{$type};
}
}
# Construct expression
my @keys = keys %var_expr;
my $key = shift @keys;
my $expr = "[$key=" . $var_expr{$key};
foreach $key (@keys){
$expr .= ",$key=" . $var_expr{$key};
}
$expr .= ']';
debug("Compare var expr: 1:" . $expr, "\n");
push(@var_exprs, $expr);
# Second variable
%var_expr = ();
$pts = $var_pts[1];
$regs = $var_regs[1];
$var_expr{d} = $dexpr[1];
foreach my $type (keys %{$pts}){
$var_expr{$type} = $pts->{$type};
}
foreach my $type (keys %{$regs}){
$var_expr{$type} = $regs->{$type};
}
#
# Set regridding in second variable
#
foreach my $type (keys %{$var_regs[0]}){
if ($type eq 't' && $use_second_time_grid){
$var_expr{"g$type"} = $var2 . "\[d=" . $dexpr[1] . "\]";
} else {
$var_expr{"g$type"} = $var1 . "\[d=". $dexpr[0] . "\]"
}
}
#
# Set regions for second variable
#
foreach (keys %diff_regions){
$var_expr{$_} = $diff_regions{$_};
}
#
# Construct expression
#
my @keys = keys %var_expr;
my $key = shift @keys;
my $expr = "[$key=" . $var_expr{$key};
foreach $key (@keys){
$expr .= ",$key=" . $var_expr{$key};
}
$expr .= ']';
debug("Compare var expr: 1:" . $expr, "\n");
push(@var_exprs, $expr);
$self->command("canc data/all; set data \"$data1\"; set data \"$data2\"");
$self->command("let var1_ = $var1" . $var_exprs[0]);
$self->command("let var2_ = $var2" . $var_exprs[1]);
# Set up plot labels if defined
my $i = 1;
my $props = $self->{props};
# TODO -- Need way of redefining axis labels for non-oceanographic datasets
my %startHash = ( x => 'Longitude', y => 'Latitude',
z => 'Depth', t => 'Time');
my %labelHash;
foreach my $ptHash (@var_pts){
filterLabel($ptHash);
foreach my $key (keys %{$ptHash}){
$labelHash{$key} .= $startHash{$key} . "($i):"
. $ptHash->{$key} . ' ';
}
$i++;
}
my @overlay_labels = ();
foreach my $key (keys %labelHash){
push(@overlay_labels, $labelHash{$key});
}
$props->{overlay_labels} = \@overlay_labels;
$self->setupCompareExpressions;
return (@names);
}
sub setupCompareExpressions {
my $self = shift;
my $props = $self->{props};
# Still more featuritis. Handle expressions
my @exprs = ($props->{expression}, $props->{expression2});
my $i = 1;
foreach my $expr (@exprs){
my $comm;
if ($expr){
$expr =~ s/\$/var${i}_/g;
$comm = qq/let data${i}_ = $expr/;
} else {
$comm = qq/let data${i}_ = var${i}_/;
}
$self->command($comm);
$i++;
}
}
sub compare {
my $self = shift;
my @names = $self->setupCompare;
my $props = $self->{props};
$props->{title} = '@AS' . "$names[2] from $names[3]\(1\) - $names[0] from $names[1]\(2\)";
$self->command('let diff_ = data1_ - data2_');
$self->{props}->{variable_name} = 'diff_';
#
# Force Ferret not to define time regions
#
$self->{props}->{jnl_t} = undef;
# Hacks for palette, fill levels
$self->{props}->{palette} = "light_centered"
if ! $self->{props}->{palette};
$self->{props}->{fill_levels} = "30C"
if ! $self->{props}->{fill_levels};
$self->draw(0,1);
}
sub overlay {
my $self = shift;
my @names = $self->setupCompare;
my $props = $self->{props};
if ($props->{rank} == 1){
$props->{title} =
'@AS' . "$names[0] from $names[1]\(1\)" . chr(27) . '@P2' . ",$names[2] from $names[3]\(2\)";
} else {
$props->{title} =
'@AS' . "$names[0] from $names[1]\(1\),$names[2] from $names[3]\(2\)";
}
#
# Force Ferret not to define time regions
#
$props->{jnl_t} = undef;
$props->{do_contour} = 0;
$props->{do_overlay} = 1;
$props->{overlay_variable_name} = "data2_";
$props->{variable_name} = 'data1_';
$self->draw(1,1);
}
sub compare_data {
my $self = shift;
my @names = $self->setupCompare;
my $props = $self->{props};
$self->command('let diff_ = data1_ - data2_');
$props->{variable_name} = 'diff_';
$self->data;
}
sub vector {
my ($self) = @_;
$self->setup_region;
my $size = $self->{props}->{size} ? $self->{props}->{size} : "0.25";
$self->command("SET WINDOW/SIZE=$size");
$self->needReferenceMap;
my $view = $self->{props}->{view};
die "Invalid view for vector plot: $view" if $view ne 'xy';
$self->{props}->{magnify} = $self->magnification;
my $command;
my @args;
# variable_name property is list with two variables
@args = qw(dataset_name variable_name magnify draw_reference);
my $aspect = $self->aspectRatio;
debug("Aspect: $aspect\n");
$self->command("set win/asp=$aspect");
$self->runJournal("std_gif_vectorref", \@args);
# 'GO std_refmap ...'
if ($self->{draw_reference}) {
my @jnlArgs = qw(refmap_xlo refmap_xhi refmap_ylo refmap_yhi
refmap_view magnify);
$self->runJournal('std_refmap', \@jnlArgs);
}
$self->command(qq:FRAME/FORMAT=gif/FILE="$self->{output_file}":);
}
#
# Generate netCDF, ASCII, etc. data using Ferret
#
sub data {
my ($self) = @_;
my $ferret = $self->{ferret};
my $props = $self->{props};
my $output = $props->{format};
my ($command, @args);
$self->setup_region;
if ($output =~ /.*v5d.*/ ) {
die "Vis5D output not yet supported!";
} elsif ( $output =~ /.*wrl.*/ ) { # VRML region output
$command = "vrml_surface";
@args = qw(dataset_name variable_name variable_name palette output_file);
} elsif ( $output =~ /.*arc.*/ ) { # ArcInfo GIS output
$command= "arc_ascii";
@args = qw(dataset_name variable_name output_file);
} else { # Some sort of ASCII output
$command= "std_list";
@args = qw(dataset_name variable_name output_file format);
}
$self->runJournal($command, \@args);
}
#
# Generate VRML output
#
sub vrml {
my ($self) = @_;
my $format = $self->{props}->{format};
if ($format eq "globe"){
$self->vrmlGlobe;
} elsif ($format =~ /.*wrl.*/ ) {
$self->vrmlWrl;
}
}
sub vrmlGlobe {
my $self = shift;
#
# First create texture map
#
my ($ferret, $props) = ($self->{ferret}, $self->{props});
my $output = $props->{format};
my @xreg = qw(20e 380e);
my @yreg = qw(90s 90n);
$self->{props}->{jnl_x} = \@xreg;
$self->{props}->{jnl_y} = \@yreg;
$self->setup_region;
my $size = $Config->{size} ? $Config->{size} : ".5";
$self->command("SET WINDOW/SIZE=$size");
my $view = $self->{props}->{view};
my $jnl_file_name = "globe_gif_" . $view;
$self->{props}->{magnify} = $self->magnification;
my $command;
my @args;
if ( $view =~ /xy/ ) { # "Normal" xy view
@args = qw(dataset_name variable_name fill_type fill_levels contour_levels magnify palette);
} else { # All non-xy views
@args = qw(dataset_name variable_name undef undef undef undef undef);
}
$self->runJournal('globe_gif', \@args, [], $jnl_file_name, \@args);
my $outputFile = $self->{output_file};
my $textureFile = "$outputFile.texture.gif";
$self->command(qq:FRAME/FORMAT=gif/FILE="$textureFile":);
#
# Now create VRML
#
open OUTFILE, ">$outputFile" || die "Can't open VRML output file";
open INFILE,"<vrmlHeader" || die "Can't open VRML header file";
while(<INFILE>){
print OUTFILE;
}
close INFILE;
my @fields = split(/\//, $textureFile);
my $cache = $fields[$#fields];
my $vrmlurl = $LAS::Server::Config{output_alias} . "/$cache";
print OUTFILE qq|url"$vrmlurl"\n|;
open INFILE,"<vrmlFooter" || die "Can't open VRML footer file";
while(<INFILE>){
print OUTFILE;
}
close INFILE;
close OUTFILE;
}
# unrecognized_parameters($query)
#
# Return a list of query parameters which are not
# recognized by the LAS. These are used to create
# Ferret symbols.
sub unrecognized_parameters {
my $self = shift;
my $props = $self->{props};
my @allNames = keys %{$props};
my @LASNames = ('exec_action','dataset','dataset',
'variable','view','format',
'x_lo','y_lo','z_lo','t_lo',
'x_hi','y_hi','z_hi','t_hi',
'output_file',
'gif_type','size');
# Here is the "Computing the difference of two arrays" example
# from p. 206 of the first edition "Programming perl" book.
my %mark;
grep($mark{$_}++,@LASNames);
my @undefParams=grep(!$mark{$_},@allNames);
return @undefParams;
}
# needReferenceMap
#
# If plot is large and it is an XY plot, you don't
# need a reference map; otherwise, you do.
sub needReferenceMap {
my $self = shift;
$self->{draw_reference} = 0;
return if $self->{is_compare}; # Disabled for variable comparison
my $props = $self->{props};
return if $props->{use_ref_map} eq "false";
my $dx = ( $props->{'x_hi'} - $props->{'x_lo'} )/360.0;
my $dy = ( $props->{'y_hi'} - $props->{'y_lo'} )/180.0;
if (!( $dx * $dy > 0.05 && $props->{'view'} eq "xy" )) {
$self->{draw_reference} = 1;
}
}
# aspectRatio
# return -- 0.25 < aspect ratio < 2.0
#
# Compute reasonable aspect ratio for plots using ratio of y/x axes.
# Jerry Davison 2.8.95
sub aspectRatio {
my $self = shift;
my $props = $self->{props};
my $x_lo = $props->{'x_lo'};
my $x_hi = $props->{'x_hi'};
my $y_lo = $props->{'y_lo'};
my $y_hi = $props->{'y_hi'};
my $ratio = 1.5 * ($y_hi - $y_lo)/($x_hi == $x_lo ? 1.0 : $x_hi - $x_lo);
if ($ratio < 0){
$ratio = - $ratio;
}
my $rval;
if ($ratio < 0.25) {
$rval = 0.25;
} elsif ($ratio > 2.0) {
$rval = 2.0;
} else {
$rval = $ratio;
}
#
# Hack to prevent title from overlaying reference map
#
$rval = 0.6 if $self->{draw_reference} && $rval < 0.6;
return $rval;
}
# magnification($query)
#
# return -- 1 < magnification < 5
#
# Determine what resolution of land mask is used.
#
# To determine "fraction" in a lat/long plot compute the fraction of the
# full-earth axis represented by each of the ranges, longitude and latitude.
# Use the minimum of these two as "fraction".
#
# A value of zero specifies that contours should be drawn
sub magnification {
my($self) = @_;
my $props = $self->{props};
if ( $props->{'view'} =~ /t/i ) { return 5; }
my $land_type = $props->{land_type};
if ( $land_type eq "contour" ) { return 0; }
if ( $land_type eq "none" ) { return -1; }
my $x_lo = $props->{'x_lo'};
my $x_hi = $props->{'x_hi'};
my $y_lo = $props->{'y_lo'};
my $y_hi = $props->{'y_hi'};
my $dx = ($x_hi - $x_lo)/360.0;
my $dy = ($y_hi - $y_lo)/180.0;
if ($dx > 2.0 * $dy) { $dy *= 2.0; }
my $min = $dx < $dy ? $dx : $dy;
if ($min < 0.06) { return 5; }
elsif ($min < 0.12) { return 4; }
elsif ($min < 0.25) { return 3; }
elsif ($min < 0.50) { return 2; }
else { return 1; }
return 1;
}
1;
[Thread Prev][Thread Next][Index]
Dept of Commerce /
NOAA /
OAR /
PMEL /
TMAP
Contact Us | Privacy Policy | Disclaimer | Accessibility Statement