National Oceanic and
Atmospheric Administration
United States Department of Commerce

Perl script to build the Ferret environment XML

The U.S. government is closed. This site will not be updated; however, NOAA websites and social media channels necessary to protect lives and property will be maintained. To learn more, visit commerce.gov.

For the latest forecasts and critical weather information, visit weather.gov.

Last modified: Tue, 03/14/2017 - 17:23
The Java code for LAS and F-TDS uses an XML file to build the Ferret execution environment. This Perl code will help you create that file.

#!/usr/bin/perl
# Build Ferret environment XML stub
#
my @EnvVars = qw(FER_DIR FER_DESCR FER_DATA FER_GRIDS FER_PALETTE
                 FER_GO PLOTFONTS FER_EXTERNAL_FUNCTIONS DODS_CONF);

        print '    ',"\n";
        foreach my $var (@EnvVars){
            $ENV{$var} = ". " . $ENV{$var} if $var !~ /PLOTFONT/;
            if ($var =~ /FER_GO|FER_PALETTE/){
                $ENV{$var} = "scripts jnls jnls/insitu jnls/section " . $ENV{$var};
                $ENV{$var} = $LasConfig{custom_name} . " " . $ENV{$var}
                    if $LasConfig{custom_name};
            } elsif ($var =~ /FER_DATA/){
                $ENV{$var} = "./data " . $ENV{$var};
            } elsif ($var =~ /FER_DESCR/){
                $ENV{$var} = "des " . $ENV{$var};
            } elsif ($var =~ /DODS_CONF/){
                $ENV{$var} = "dods/.dodsrc";
            }

            my @values = split(' ',$ENV{$var});

            # Trim so ". " and "." match
            foreach my $value (@values) {
               $value = trim($value);
            }

            #Extract unique entries, see perl FAQ
            undef %saw;
            @saw{@values} = ();
            @out = sort keys %saw;  # remove sort if undesired

            print '        ',"\n";
            print '            ',$var,'',"\n";
            foreach my $value (@out) {
               $value = trim($value);
               print '             ',$value,'',"\n";
            }
            print '        ',"\n";
        }
        print '    ',"\n";
        print '',"\n";

sub trim($)
{
        my $string = shift;
        $string =~ s/^\s+//;
        $string =~ s/\s+$//;
        return $string;
}