#!/usr/local/bin/perl

=head1 NAME

order_MWS.pl -- place MODAPS Web Service orders for post-processed files

=head1 SYNOPSIS

order_MWS.pl -h

  --OR--

perl order_MWS.pl -h

=head1 DESCRIPTION

This application supports three MODAPS Web Service features: search for
and list URLS of files, search for and download files, and search for and
order post-processed files.

=head1 DESIGN NOTES

Normally, I would put most of the subroutines currently in this file in
separate perl modules (files) to keep things uncluttered and easy to find.
In this case, everything is in this file in order to make installation and
use easier for the user (no need to setup paths or environment variables
or system configurations). Almost all of the code is processing command
line options and arguments -- the SOAP web service queries are small and
straightforward.

YOU MIGHT NEED TO CHANGE THE TOP LINE IN THIS FILE TO POINT TO WHERE YOU
HAVE INSTALLED PERL ON YOUR SYSTEM!

=head1 AUTHORS AND MAINTAINERS

Greg Ederer

=head1 ACKNOWLEDGEMENTS

This software is developed by the MODAPS Team for the National
Aeronautics and Space Administrationn, Goddard Space Flight
Center, under contract NAS5-32373.

=head1 LICENSE

Permission is hereby granted, free of charge, to any person or organization
obtaining a copy of the software and accompanying documentation covered by
this license (the "Software") to use, reproduce, display, distribute,
execute, and transmit the Software, and to prepare derivative works of the
Software, and to permit third-parties to whom the Software is furnished to
do so, all subject to the following:

Any copyright notices in the Software and this entire statement, including
the above license grant, this restriction, and the following disclaimer,
must be included in all copies of the Software, in whole or in part, and
all derivative works of the Software, unless such copies or derivative
works are solely in the form of machine-executable object code generated by
a source language processor.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE, TITLE AND NON-INFRINGEMENT. IN NO EVENT
SHALL THE COPYRIGHT HOLDERS OR ANYONE DISTRIBUTING THE SOFTWARE BE LIABLE
FOR ANY DAMAGES OR OTHER LIABILITY, WHETHER IN CONTRACT, TORT OR OTHERWISE,
ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
DEALINGS IN THE SOFTWARE.

=cut

###########################################################################

use strict;
use warnings;

use SOAP::Lite;
use Getopt::Long;
use FileHandle;
use File::Spec;

# vars visible to all routines in this package.
# do not change...
my $OK = 'OK';
my $ESDT_SDS_DELIMIT = '___';

my %HELP = ();
my $ARG_DESCRIPTION = '';

my $DATE_FORMAT = '%04d-%02d-%02d %02d:%02d:%02d';
my @MONTHS = qw(
  jan feb mar apr may jun jul aug sep oct nov dec
);

# the command line used...
my $VERSION = '0.1';
print command_line_to_string($VERSION, @ARGV), "\n\n";

#############################################################
# Connect to web service. Do this first, because the service
# is needed to check some command line arguments.
#############################################################
# change the following to access different services...
#############################################################
my $NAMESPACE = 'http://laads.modapsws.gsfc.nasa.gov';
my $SERVICE_URL = 'https://modwebsrv.modaps.eosdis.nasa.gov/axis2/services/MODAPSservices';
print "contacting $SERVICE_URL...\n";

# connect to Web Service...
my $ws = SOAP::Lite-> uri($NAMESPACE)->proxy($SERVICE_URL);
die "no SOAP, radio" unless $ws;
print "connected\n";


#############################################################
# Define command line options...
#############################################################
my $OPTION_SPEC = [
    {
      KEY         => 'HELP',
      OPTION_NAME => "h",
      DESCRIPTION => "HELP",
    },
  
    {
      KEY         => 'PARAM_FILE',
      OPTION_NAME => "f=s",
      ARG_NAME    => 'param_file',
      DESCRIPTION => "read input args from param file",
    },
    
    {
      KEY         => 'ARCHIVE_SET',
      OPTION_NAME => "collection|c=i",
      ARG_NAME    => "number",
      DESCRIPTION => "MODAPS Collection",
      DEFAULT     => 5,
      VALIDATE    => sub {
        my ($ws,$opts,$val) = @_;
        die "no ws" unless $ws;
        die "no opts" unless $opts;
        die "no val" unless $val;
        die "invalid collection : $val"
          unless grep($_ == $val, @{listCollections($ws)});
      },
    },

    {
      KEY         => 'TO_DO',
      OPTION_NAME => "to_do=s",
      ARG_NAME    => "what",
      DESCRIPTION => "one of {list,download,post-process}",
      DEFAULT     => 'list',
      VALIDATE    => sub {
        my ($ws,$opts,$val) = @_;
        die "no ws" unless $ws;
        die "no opts" unless $opts;
        die "no val" unless $val;
        die "invalid to_do : $val" unless $val =~ /li|do|lo|po|pr/i;
        $opts->{TO_DO} = 'list';
        $opts->{TO_DO} = 'download' if $val =~ /do|lo/;
        $opts->{TO_DO} = 'post-proc' if $val =~ /po|pr/;
      },
    },

    {
      KEY         => 'USER',
      OPTION_NAME => "user_email|a=s",
      ARG_NAME    => "email_address",
      DESCRIPTION => "User's email address. A notification email will be sent to this address when the order is complete.",
      VALIDATE    => sub {
        my ($ws,$opts,$val) = @_;
        die "no ws" unless $ws;
        die "no opts" unless $opts;
        die "no val" unless $val;
        die "invalid user_email : $val" unless $val =~ /[^@]+@[^@]+/i;
      },
    },

    {
      KEY         => 'EAST',
      OPTION_NAME => "east_bound|e=f",
      ARG_NAME    => "lon",
      DESCRIPTION => "eastern boundary of area of interest",
      DEFAULT     => 180.0,
      VALIDATE    => sub {
        my ($ws,$opts,$val) = @_;
        die "no ws" unless $ws;
        die "no opts" unless $opts;
        die "no val" unless $val;
        die "invalid east_bound : $val"
          unless $val >= -180 && $val <= 180;
	$opts->{EAST} = sprintf("%0f",$val);
      },
    },

    {
      KEY         => 'NORTH',
      OPTION_NAME => "north_bound|n=f",
      ARG_NAME    => "lat",
      DESCRIPTION => "northern boundary of area of interest",
      DEFAULT     => 90.0,
      VALIDATE    => sub {
        my ($ws,$opts,$val) = @_;
        die "no ws" unless $ws;
        die "no opts" unless $opts;
        die "no val" unless $val;
        die "invalid north_bound : $val"
          unless $val >= -90 && $val <= 90;
	$opts->{NORTH} = sprintf("%0f",$val);
      },
    },

    {
      KEY         => 'SOUTH',
      OPTION_NAME => "south_bound|s=f",
      ARG_NAME    => "lat",
      DESCRIPTION => "southern boundary of area of interest",
      DEFAULT     => -90.0,
      VALIDATE    => sub {
        my ($ws,$opts,$val) = @_;
        die "no ws" unless $ws;
        die "no opts" unless $opts;
        die "no val" unless $val;
        die "invalid south_bound : $val"
          unless $val >= -90 && $val <= 90;
	$opts->{SOUTH} = sprintf("%0f",$val);
      },
    },

    {
      KEY         => 'WEST',
      OPTION_NAME => "west_bound|w=f",
      ARG_NAME    => "lon",
      DESCRIPTION => "western boundary of area of interestt",
      DEFAULT     => -180.0,
      VALIDATE    => sub {
        my ($ws,$opts,$val) = @_;
        die "no ws" unless $ws;
        die "no opts" unless $opts;
        die "no val" unless $val;
        die "invalid west_bound : $val"
          unless $val >= -180 && $val <= 180;
	$opts->{WEST} = sprintf("%0f",$val);
      },
    },

    {
      KEY         => 'START_TIME',
      OPTION_NAME => "start_time|t=s",
      ARG_NAME    => "date_time",
      DESCRIPTION => "search for files collected after this date/time",
      DEFAULT     => 'today 00:00:00',
      VALIDATE    => sub {
        my ($ws,$opts,$val) = @_;
        die "no ws" unless $ws;
        die "no opts" unless $opts;
        die "no val" unless $val;
        $opts->{START_TIME} = date_format($val);
      },
    },

    {
      KEY         => 'END_TIME',
      OPTION_NAME => "end_time|u=s",
      ARG_NAME    => "date_time",
      DESCRIPTION => "search for files collected before this date/time",
      DEFAULT     => 'today 23:59:59',
      VALIDATE    => sub {
        my ($ws,$opts,$val) = @_;
        die "no ws" unless $ws;
        die "no opts" unless $opts;
        die "no val" unless $val;
        $opts->{END_TIME} = date_format($val);
      },
    },

    {
      KEY         => 'PROJECTION',
      OPTION_NAME => "proj=s",
      ARG_NAME    => "name",
      DESCRIPTION => "resample the input to specified projection, one of {ALBERS, GEO, LAMAZ, LAMCC, MERCAT, PS (Polar Stereographic), ROBIN, SNSOID, TM, UTM}",
      DEFAULT     => 'GEO',
      VALIDATE    => sub {
        my ($ws,$opts,$val) = @_;
        die "no ws" unless $ws;
        die "no opts" unless $opts;
        die "no val" unless $val;
        die "invalid proj : $val"
          unless grep("$_" eq "$val", @{listMapProjections($ws)});
      },
    },

    {
      KEY         => 'PIXEL_SIZE',
      OPTION_NAME => "pixel_size=f",
      ARG_NAME    => "size",
      DESCRIPTION => "output pixel size. Units must match projection (degrees for lon/lat, meters for all others)",
      VALIDATE    => sub {
        my ($ws,$opts,$val) = @_;
        die "no ws" unless $ws;
        die "no opts" unless $opts;
        die "no val" unless $val;
        die "invalid pixel_size : $val" if $val <= 0;
      },
    },

    {
      KEY         => 'FALSE_EASTING',
      OPTION_NAME => "false_eastingf",
      ARG_NAME    => "offset",
      DESCRIPTION => "false easting value in meters. See listReprojectionParameters to determine if this parameter may be used with the specified reprojectionName",
    },

    {
      KEY         => 'FALSE_NORTHING',
      OPTION_NAME => "false_northing=f",
      ARG_NAME    => "offset",
      DESCRIPTION => "false northing value in meters. See listReprojectionParameters to determine if this parameter may be used with the specified reprojectionName.",
    },

    {
      KEY         => 'STANDARD_PARALLEL',
      OPTION_NAME => "std_parallel=f",
      ARG_NAME    => "lat",
      DESCRIPTION => "latitude value, in degrees, of first standard parallel parameter for the reprojection, see listReprojectionParameters to determine if this parameter may be used with the specified reprojectionName.",
      VALIDATE    => sub {
        my ($ws,$opts,$val) = @_;
        die "no ws" unless $ws;
        die "no opts" unless $opts;
        die "no val" unless $val;
        die "invalid std_parallel : $val"
          unless $val >= -90 && $val <= 90;
	$opts->{STANDARD_PARALLEL} = sprintf("%0f",$val);
      },
    },

    {
      KEY         => 'STANDARD_PARALLEL2',
      OPTION_NAME => "std2_parallel=f",
      ARG_NAME    => "lat",
      DESCRIPTION => "latitude value, in degrees, of second standard parallel parameter for the reprojection, see listReprojectionParameters to determine if this parameter may be used with the specified reprojectionName.",
      VALIDATE    => sub {
        my ($ws,$opts,$val) = @_;
        die "no ws" unless $ws;
        die "no opts" unless $opts;
        die "no val" unless $val;
        die "invalid std2_parallel : $val"
          unless $val >= -90 && $val <= 90;
	$opts->{STANDARD_PARALLEL2} = sprintf("%0f",$val);
      },
    },

    {
      KEY         => 'CENTRAL_MERIDIAN',
      OPTION_NAME => "cen_meridian=f",
      ARG_NAME    => "lon",
      DESCRIPTION => "longitude value, in degrees, of central meridian parameter for the reprojection, see listReprojectionParameters to determine if this parameter may be used with the specified reprojectionName.",
      VALIDATE    => sub {
        my ($ws,$opts,$val) = @_;
        die "no ws" unless $ws;
        die "no opts" unless $opts;
        die "no val" unless $val;
        die "invalid cen_meridian : $val"
          unless $val >= -180 && $val <= 180;
	$opts->{CENTRAL_MERIDIAN} = sprintf("%0f",$val);
      },
    },

    {
      KEY         => 'PROJ_ORIGIN',
      OPTION_NAME => "p_origin=f",
      ARG_NAME    => "lat",
      DESCRIPTION => "latitude value, in degrees, of projection origin parameter for the reprojection, see listReprojectionParameters to determine if this parameter may be used with the specified reprojectionName.",
      VALIDATE    => sub {
        my ($ws,$opts,$val) = @_;
        die "no ws" unless $ws;
        die "no opts" unless $opts;
        die "no val" unless $val;
        die "invalid p_origin : $val"
          unless $val >= -90 && $val <= 90;
	$opts->{PROJ_ORIGIN} = sprintf("%0f",$val);
      },
    },

    {
      KEY         => 'CENTER_LON',
      OPTION_NAME => "cenlon=f",
      ARG_NAME    => "lon",
      DESCRIPTION => "longitude value, in degrees, of center of projection for the reprojection, see listReprojectionParameters to determine if this parameter may be used with the specified reprojectionName.",
      VALIDATE    => sub {
        my ($ws,$opts,$val) = @_;
        die "no ws" unless $ws;
        die "no opts" unless $opts;
        die "no val" unless $val;
        die "invalid cenlon : $val"
          unless $val >= -180 && $val <= 180;
	$opts->{CENTER_LON} = sprintf("%0f",$val);
      },
    },

    {
      KEY         => 'CENTER_LAT',
      OPTION_NAME => "cenlat=f",
      ARG_NAME    => "lat",
      DESCRIPTION => "latitude value, in degrees, of center of projection for the reprojection, see listReprojectionParameters to determine if this parameter may be used with the specified reprojectionName.",
      VALIDATE    => sub {
        my ($ws,$opts,$val) = @_;
        die "no ws" unless $ws;
        die "no opts" unless $opts;
        die "no val" unless $val;
        die "invalid cenlat : $val"
          unless $val >= -90 && $val <= 90;
	$opts->{CENTER_LAT} = sprintf("%0f",$val);
      },
    },

    {
      KEY         => 'LAT_TRUE_SCALE',
      OPTION_NAME => "lat_ts=f",
      ARG_NAME    => "lat",
      DESCRIPTION => "latitude value, in degrees, of true scale for the reprojection, see listReprojectionParameters to determine if this parameter may be used with the specified reprojectionName.",
      VALIDATE    => sub {
        my ($ws,$opts,$val) = @_;
        die "no ws" unless $ws;
        die "no opts" unless $opts;
        die "no val" unless $val;
        die "invalid lat_ts : $val"
          unless $val >= -90 && $val <= 90;
	$opts->{LAT_TRUE_SCALE} = sprintf("%0f",$val);
      },
    },

    {
      KEY         => 'SCALE_FACTOR',
      OPTION_NAME => "scale_factor=f",
      ARG_NAME    => "scale",
      DESCRIPTION => "scale factor at central meridian for a reprojection, see listReprojectionParameters to determine if this parameter may be used with the specified reprojectionName.",
      VALIDATE    => sub {
        my ($ws,$opts,$val) = @_;
        die "no ws" unless $ws;
        die "no opts" unless $opts;
        die "no val" unless $val;
        die "invalid scale_factor : $val" unless $val >= 0;
	$opts->{SCALE_FACTOR} = sprintf("%0f",$val);
      },
    },

    {
      KEY         => 'RESAMPLE_TYPE',
      OPTION_NAME => "resample=s@",
      ARG_NAME    => "type",
      DESCRIPTION => "resample type, one of {Nearest, Bilinear} for the reprojection, and also supports {Mosaic}, eg. -resample Nearest,Mosaic",
      VALIDATE    => sub {
        my ($ws,$opts,$val) = @_;
        die "no ws" unless $ws;
        die "no opts" unless $opts;
        die "no val" unless $val;
	foreach my $item (@$val){
          die "invalid resample : $item"
            unless "$item" =~ /^[mnb]/i;
          $opts->{RESAMPLE_TYPE} = 'Nearest' if "$item" =~ /^n/i;
          $opts->{RESAMPLE_TYPE} = 'Bilinear' if "$item" =~ /^b/i;
          $opts->{MOSAIC} = 1 if "$item" =~ /^m/i;
        }
      },
    },

    {
      KEY         => 'FORMAT',
      OPTION_NAME => "format=s",
      ARG_NAME    => "type",
      DESCRIPTION => "output file format type, one of {HDF4,GeoTIFF,JPEG}",
      DEFAULT     => "hdf4",
      VALIDATE    => sub {
        my ($ws,$opts,$val) = @_;
        die "no ws" unless $ws;
        die "no opts" unless $opts;
        die "no val" unless $val;
        die "invalid format : $val"
          unless "$val" =~ /hdf|tif|jp/i;
	$opts->{FORMAT} = undef if "$val" =~ /hdf/i;
	$opts->{FORMAT} = 'geotiff' if "$val" =~ /tif/i;
	$opts->{FORMAT} = 'jpeg' if "$val" =~ /jp/i;
      },
    },

    {
      KEY         => 'COORDS_TILES',
      OPTION_NAME => "t_coords=s",
      ARG_NAME    => "type",
      DESCRIPTION => "area of interest is one of {coords, tiles}",
      DEFAULT     => "coords",
      VALIDATE    => sub {
        my ($ws,$opts,$val) = @_;
        die "no ws" unless $ws;
        die "no opts" unless $opts;
        die "no val" unless $val;
        die "invalid t_coords : $val" unless "$val" =~ /co|ti/i;
	$opts->{COORDS_TILES} = 'coords' if "$val" =~ /co/i;
	$opts->{COORDS_TILES} = 'tiles' if "$val" =~ /ti/i;
      },
    },

    {
      KEY         => 'DAY_NIGHT_BOTH',
      OPTION_NAME => "day_night=s",
      ARG_NAME    => "dnb",
      DESCRIPTION => "any combination of {d,n,b}",
      DEFAULT     => "db",
      VALIDATE    => sub {
        my ($ws,$opts,$val) = @_;
        die "no ws" unless $ws;
        die "no opts" unless $opts;
        die "no val" unless $val;
        die "invalid day_night : $val"
          unless "$val" =~ /[dnb]+/i;
      },
    },
];
my $opts = read_command_line_options(
  $ws, $OPTION_SPEC, "product <... productN>"
);

usage() if $opts->{HELP};

# and the rest of the command line...
validate_products($ws,$opts,@ARGV);

# confirm search criteria
print "Searching for:\n";
print "  start_time  = ", $opts->{START_TIME}, "\n";
print "  end_time    = ", $opts->{END_TIME}, "\n";
print "  collection  = ", $opts->{ARCHIVE_SET}, "\n";
print "  north_bound = ", $opts->{NORTH}, "\n";
print "  south_bound = ", $opts->{SOUTH}, "\n";
print "  west_bound  = ", $opts->{WEST}, "\n";
print "  east_bound  = ", $opts->{EAST}, "\n";
print "  products    = ", $opts->{PRODUCTS}, "\n";

# search for files matching search criteria
my $file_ids = search($ws, $opts);
if (scalar @$file_ids < 1)
{
  print "no search results\n";
  exit(0);
}
$opts->{FILE_IDS} = join(',', @$file_ids);

# download or postprocess files...
if ($opts->{TO_DO} eq 'post-proc')
{
  my $order_ids = order($ws, $opts);
  if ($order_ids && scalar @$order_ids)
  {
    print "placed order", (scalar(@$order_ids) == 1) ? "s " : " ", join(", ", @$order_ids), "\n";
    print "the service will email you with download instructions when your order is complete\n";
  }
  else
  {
    print "no orders placed.\n";
  }
}
else
{
  download($ws, $opts);
}

# all done
exit(0);

#############################################################
# subroutines...
#############################################################
sub validate_products
{
  my ($ws,$opts,@products) = @_;
  die "no ws" unless $ws;
  die "no opts" unless $opts;
  usage("ERROR: no products specified") unless scalar @products;

  my $valid_products = listProducts($ws,$opts);
  foreach my $prod_item (@products)
  {
    my ($product, $rest) = split(/$ESDT_SDS_DELIMIT/, $prod_item);
    die "invalid product : $product"
      unless grep("$_" eq "$product", @$valid_products);
    if ($opts->{PRODUCTS})
    {
      $opts->{PRODUCTS} = join(',', $opts->{PRODUCTS}, $product);
    }
    else
    {
      $opts->{PRODUCTS} = $product;
    }

    # now check sds names, bands for product
    my @list = $rest ? split(/,/, $rest) : ();
    next unless scalar @list;    # nothing to check?

    my $valid_sds_names = getDataLayers($ws,$product);
    my $valid_bands = getBands($ws,$product);
    foreach my $sds_item (@list)
    {
      my $esdt_sds_def = "$product$ESDT_SDS_DELIMIT$sds_item";
      if (grep("$_" eq "$sds_item", @$valid_sds_names))
      {
        if ($opts->{SDS_NAMES})
        {
          $opts->{SDS_NAMES} = join(',', $opts->{SDS_NAMES}, $esdt_sds_def);
        }
	else
        {
          $opts->{SDS_NAMES} = $esdt_sds_def;
	}
      }
      elsif (grep("$_" eq "$sds_item", @$valid_bands))
      {
        if ($opts->{SDS_BANDS})
        {
          $opts->{SDS_BANDS} = join(',', $opts->{SDS_BANDS}, $esdt_sds_def);
        }
	else
        {
          $opts->{SDS_BANDS} = $esdt_sds_def;
	}
      }
      else
      {
        die "invalid sds/band for product $product : $sds_item";
      }
    }
  }
}

#------------------------------------------------------------
# construct_soap_args : marshal parameters for SOAP call
#------------------------------------------------------------
sub construct_soap_args
{
  my ($opts, $param_list) = @_;
  die "no opts" unless $opts;
  die "no param_list" unless $param_list;

  my @soap_args = ();
  foreach my $row (@$param_list)
  {
    my ($soap_key,$soap_type,$opts_key,$format) = @$row;
    my $opts_val = $opts->{$opts_key};
    next unless $opts_val;
    $opts_val = eval $format if ($format);
    next unless $opts_val;

    push @soap_args,
      SOAP::Data->name("$soap_key")->type($soap_type => $opts_val);
  }

  return SOAP::Data->value(@soap_args);
}

#------------------------------------------------------------
# search : search for files
#------------------------------------------------------------
sub search
{
  my ($ws,$opts) = @_;
  die "no ws" unless $ws;
  die "no opts" unless $opts;

  # NOTE: order of parameters must match WSDL...
  my $param_list = [
    ['products',      'string', 'PRODUCTS'],
    ['collection',    'int',    'ARCHIVE_SET'],
    ['startTime',     'string', 'START_TIME'],
    ['endTime',       'string', 'END_TIME'],
    ['north',         'float',  'NORTH'],
    ['south',         'float',  'SOUTH'],
    ['east',          'float',  'EAST'],
    ['west',          'float',  'WEST'],
    ['coordsOrTiles', 'string', 'COORDS_TILES'],
    ['dayNightBoth',  'string', 'DAY_NIGHT_BOTH'],
  ];

  return get_result_set(
    $ws->searchForFiles(construct_soap_args($opts, $param_list))
  );
}

#------------------------------------------------------------
# Web Service queries to get information
#------------------------------------------------------------
sub listCollections
{
  my ($ws) = @_;
  die "no ws" unless $ws;

  # call the service...
  my $result_set = get_result_set(
    $ws->listCollections()
  );
  my $collections = [];
  foreach my $row (@$result_set)
  {
    push @$collections, $row->{id};
  }
  return $collections;
}

sub listProducts
{
  my ($ws,$opts) = @_;
  die "no ws" unless $ws;
  die "no $opts" unless $opts;

  # call the service...
  my $param_list = [
    ['collections', 'string', 'ARCHIVE_SET'],
  ];
  my $result_set = get_result_set(
    $ws->listProducts(construct_soap_args($opts, $param_list))
  );

  my $valid_products = [];
  foreach my $row (@$result_set)
  {
    push @$valid_products, $row->{Name};
  }
  return $valid_products;
}

sub listMapProjections
{
  my ($ws) = @_;
  die "no ws" unless $ws;

  # call the service...
  my $result_set = get_result_set(
    $ws->listMapProjections()
  );
  my $projs = [];
  foreach my $row (@$result_set)
  {
    push @$projs, $row->{name};
  }
  return $projs;
}

sub listReprojectionParameters
{
  my ($ws,$opts) = @_;
  die "no ws" unless $ws;
  die "no $opts" unless $opts;

  # call the service...
  my $param_list = [
    ['reprojectionName', 'string', 'PROJECTION'],
  ];
  return get_result_set(
    $ws->listReprojectionParameters(construct_soap_args($opts, $param_list))
  );
}

sub getDataLayers
{
  my ($ws,$product) = @_;
  die "no ws" unless $ws;
  die "no product" unless $product;

  # call the service...
  my $hash->{THIS_PRODUCT} = $product;
  my $param_list = [
    ['product', 'string', 'THIS_PRODUCT'],
  ];
  my $result_set = get_result_set(
    $ws->getDataLayers(construct_soap_args($hash, $param_list))
  );

  my $sds_list = [];
  foreach my $row (@$result_set)
  {
    my ($product,$sds_name) = split(/$ESDT_SDS_DELIMIT/, $row->{name});
    push @$sds_list, $sds_name;
  }
  return $sds_list;
}

sub getBands
{
  my ($ws,$product) = @_;
  die "no ws" unless $ws;
  die "no $product" unless $product;

  # call the service...
  my $hash->{THIS_PRODUCT} = $product;
  my $param_list = [
    ['product', 'string', 'THIS_PRODUCT'],
  ];
  my $result_set = get_result_set(
    $ws->getBands(construct_soap_args($hash, $param_list))
  );

  my $band_list = [];
  foreach my $row (@$result_set)
  {
    my ($product,$band) = split(/$ESDT_SDS_DELIMIT/, $row->{name});
    push @$band_list, $band;
  }
  return $band_list;
}

#------------------------------------------------------------
# order : place a post-processing order
#------------------------------------------------------------

sub order
{
  my ($ws,$opts) = @_;
  die "no ws" unless $ws;
  die "no $opts" unless $opts;

  # NOTE: order and types of parameters must match WSDL...
  my $param_list = [
    ['email',                         'string',  'USER'],
    ['fileIds',                       'string',  'FILE_IDS'],
    ['reformatType',                  'string',  'FORMAT'],
    ['doMosaic',                      'boolean', 'MOSAIC'],
    ['geoSubsetNorth',                'float',   'NORTH'],
    ['geoSubsetSouth',                'float',   'SOUTH'],
    ['geoSubsetWest',                 'float',   'WEST'],
    ['geoSubsetEast',                 'float',   'EAST'],
    ['reprojectionName',              'string',  'PROJECTION'],
    ['reprojectionOuputPixelSize',    'string',  'PIXEL_SIZE'],
    ['reprojectionFalseEasting',      'string',  'FALSE_EASTING'],
    ['reprojectionFalseNorthing',     'string',  'FALSE_NORTHING'],
    ['reprojectionStandardParallel1', 'string',  'STANDARD_PARALLEL'],
    ['reprojectionStandardParallel2', 'string',  'STANDARD_PARALLEL2'],
    ['reprojectionCentralMeridian',   'string',  'CENTRAL_MERIDIAN'],
    ['reprojectionOriginLat',         'string',  'PROJ_ORIGIN'],
    ['reprojectionCenterLon',         'string',  'CENTER_LON'],
    ['reprojectionCenterLat',         'string',  'CENTER_LAT'],
    ['reprojectionTrueScaleLat',      'string',  'LAT_TRUE_SCALE'],
    ['reprojectionLongitudePole',     'string',  'LON_POL'],
    ['reprojectionScaleFactor',       'string',  'SCALE_FACTOR'],
    ['reprojectionResampleType',      'string',  'RESAMPLE_TYPE'],
    ['subsetDataLayer',               'string',  'SDS_NAMES'],
    ['subsetBand',                    'string',  'SDS_BANDS'],
  ];

  # place the order...
  return get_result_set(
    $ws->orderFiles(construct_soap_args($opts, $param_list))
  );
}

#------------------------------------------------------------
# download : list or download files, as specified
# NOTE : THIS DOES NOT DOWNLOAD POST-PROCESS ORDERS, ONLY
#        DIRECT FTP FILE_IDS FROM THE SEARCH FUNCTION!
#------------------------------------------------------------
sub download
{
  my ($ws,$opts) = @_;
  die "no ws" unless $ws;
  die "no $opts" unless $opts;

  # get urls to fileIds returned in search results...
  my $param_list = [
    ['fileIds',  'string', 'FILE_IDS'],
  ];
  my $result_set = get_result_set(
    $ws->getFileUrls(construct_soap_args($opts, $param_list))
  );

  if ($opts->{TO_DO} eq 'download')      # download the files from ftp
  {
    my $user = "anonymous";
    my $passwd = $opts->{USER};
    usage("ERROR:  No email address\nAn email address is required for FTP downloading") unless $passwd;
    foreach my $url (@$result_set)
    {
      next unless $url;             # skip files not on disk
      my $cmd = "wget --user=$user --password=$passwd $url";
      my $result = system($cmd);
      if ($result == 0)
      {
        print "downloaded '$url'\n";
      }
      else
      {
        print "failed download : '$url'\n";
      }
    }
  }
  else      # list the URLs
  {
    my @on_disk = grep($_, @$result_set);
    print "\nfound:\n";
    print join("\n", @on_disk), "\n";
  }
}

#------------------------------------------------------------
# find_month : given a text month, return its numeric equivalen
#------------------------------------------------------------
sub find_month
{
  my ($str) = @_;
  die "no str" unless $str;

  for (my $ii = 0; $ii < scalar @MONTHS; ++$ii)
  {
    my $trial = $MONTHS[$ii];
    return $ii+1 if $str =~ /$trial/i;
  }
  die "unknown month $str";
}

#------------------------------------------------------------
# is_leap_year : return non-zero if leap year, undef otherwise
#------------------------------------------------------------
sub is_leap_year
{
  my ($yr) = @_;
  die "no yr" unless $yr;
  return undef unless $yr % 4 == 0;
  return 'leap' if $yr % 400 == 0;
  return undef if $yr % 100 == 0;
  return 'leap';
}

#------------------------------------------------------------
# days_in_month : return number of days in month for given year
#------------------------------------------------------------
sub days_in_month
{
  my ($yr,$mn) = @_;
  die "no yr" unless $yr;
  die "no mn" unless $mn;
  die "bad mn" if $mn < 1 or $mn > 12;

  my @DAYS_IN_MONTH = (
  # zero  jan feb mar apr may jun jul aug sep oct nov dec
    0,    31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31,
  );

  ++ $DAYS_IN_MONTH[2] if is_leap_year($yr);
  return $DAYS_IN_MONTH[$mn];

}

#------------------------------------------------------------
# doy_to_mndy : given a day-of-the-year, return its equivalent month
# and day-of-month
#------------------------------------------------------------
sub doy_to_mndy
{
  my ($yr,$doy) = @_;
  die "no yr" unless $yr;
  die "no doy" unless $doy;

  my $mn = 1;
  my $diff = 0;
  for (; $mn <= 12; ++$mn)
  {
    my $trial_dm = days_in_month($yr,$mn);
    last if ($trial_dm+$diff >= $doy);
    $diff += $trial_dm;
  }

  return ($mn,$doy-$diff);
}

#------------------------------------------------------------
# parse_date : try and recognize as many American date formats
# as commonly used by people
#------------------------------------------------------------
sub parse_date
{
  my ($str) = @_;
  die "no str" unless $str;
  my ($yr,$mn,$dy,$hh,$mm,$ss) = (0,0,0,0,0,0);
  my (@entries) = split(/[\s\/-]+/, $str);
  for (my $ii = 0; $ii < scalar @entries; ++$ii)
  {
    my $item = $entries[$ii];
    if ($item =~ /:/)                  # found time
    {
      ($hh,$mm,$ss) = split(/:/,$item);
    }
    elsif ($item =~ /today/i)          # today's date
    {
      my @tlist = localtime(time());
      ($dy,$mn,$yr) = splice(@tlist,3,3);
      $yr += 1900;  # localtime gives years since 1900
      ++$mn;        # localtime months start at zero
    }
    elsif ($item =~ /(\d{4})/)         # found year
    {
      $yr = $1;
    }
    elsif ($item =~ /(\d{3})/)         # found day-of-year
    {
      my $doy = $1;
      ($mn,$dy) = doy_to_mndy($yr,$doy);
    }
    elsif ($item =~ /(\d+),(\d{4})/)   # found day,year
    {
      ($dy,$yr) = ($1,$2);
    }
    elsif ($item =~ /(\d+),/)          # found day
    {
      $dy = $1;
    }
    elsif ($item =~ /(\D+)/)           # found text month
    {
      $mn = find_month($1);
    }
    elsif ($item =~ /(\d{1,2})/)       # day or month, depending on context
    {
      $mn = $1 if $ii == 0;                # month first
      $mn = $1 if ($ii == 1) and $yr;      # year first, then month
      $dy = $1 if ($ii == 1) and not $yr;  # month,day,year
      $dy = $1 if $ii == 2;                # year, month, day
    }
  }
  # quick check
  die "bad month $mn\n" unless $mn >= 1 and $mn <= 12;
  die "bad day $dy\n" unless $dy >= 1 and $dy <= days_in_month($yr,$mn);

  return ($yr,$mn,$dy,$hh,$mm,$ss);

}

#------------------------------------------------------------
# date_format -- return time string in date/time format
#      that the web service understands if the input time
#      string is valid, else today's date.
#------------------------------------------------------------
sub date_format
{
  my ($in_time_str) = @_;
  return undef unless $in_time_str;

  my ($yr,$mo,$dy,$hr,$mn,$ss) = parse_date($in_time_str);
  $hr = 0 unless defined $hr;
  $mn = 0 unless defined $mn;
  $ss = 0 unless defined $ss;
  return sprintf($DATE_FORMAT, $yr,$mo,$dy,$hr,$mn,$ss)
    if $yr && $mo && $dy;
  
  ($yr,$mo,$dy) = parse_date('today');
  return sprintf($DATE_FORMAT, $yr,$mo,$dy,$hr,$mn,$ss);
}

#------------------------------------------------------------
# get_result_set -- return the results of the query as
#     a reference to an array.
#------------------------------------------------------------
sub get_result_set
{
  my ($result) = @_;
  
  my $out_list = [];
  
  unless ($result->fault) {
    if (defined $result->result())
    {
      push @$out_list, $result->result();
      my @list = $result->paramsout;
      push(@$out_list, @list) if scalar @list;
    }
  } else {
    print join ' ',
      'FAILED:',
      $result->faultcode, 
      $result->faultstring;
    print "\n";
  }
    
  return $out_list;  
}

#------------------------------------------------------------
# command_line_to_string -- this si what the user typed to start us
#------------------------------------------------------------
sub command_line_to_string
{
  my ($version, @args) = @_;
  
  my $path = File::Spec->rel2abs($0);
  my $str = "$path : VERSION $version";
  my $str2 = join(' ', "cmd =", $0, @args);
  return join("\n", $str, $str2);
}

#------------------------------------------------------------
# read_command_line_options
#------------------------------------------------------------
# this routine understands a special PARAM_FILE key. If this
# key exists, then the specified file will be opened and its
# contents processed as an additional set of command options and
# arguments. This can cause multiple levels of A-B-A recursion.
#------------------------------------------------------------
sub read_command_line_options
{
  my ($ws,$param_spec, $arg_description) = @_;
  die "no ws" unless $ws;
  die "invalid param_spec" unless $param_spec && ref($param_spec) eq 'ARRAY';
  
  # setup the list of options to pass to GetOptions...
  $ARG_DESCRIPTION = $arg_description if $arg_description;
  my $options = {};
  my @params_for_getopt = ();
  my $read_param_file;
  foreach my $spec (@$param_spec)
  {
    my $key = $spec->{KEY};
    
    # getopt params...
    my $option = $spec->{OPTION_NAME};
    die "no option name specified" unless $option;
    push @params_for_getopt, $option;
    my ($name,$type) = split(/[=:]/, $option);
    
    my $arg_description = $spec->{ARG_NAME};
    $arg_description = '' unless $arg_description;
    $read_param_file = $name if uc($key) eq "PARAM_FILE";
        
    my $description = $spec->{DESCRIPTION};
    die "no description" unless $description;
    
    # help params
    my $required = '';
    $required = " (REQUIRED)" if $spec->{REQUIRED};
    $HELP{"$name $arg_description"} = "$description$required";
  }
  
  # get the options
  GetOptions ($options, @params_for_getopt);
  
  # if a parameter file was specified as an option, then process it
  # CAREFUL OF INFINITE LOOPS!
  if ($read_param_file)
  {
    # reset the thing pointed to by $read_param_file so we
    # don't get stuck in an infinite loop...
    my $f = $options->{$read_param_file};
    $read_param_file = undef;
    my $add_opts = _process_command_file($ws,$f,$param_spec,$arg_description);
    
    # and merge new options with existing...
    foreach my $key (keys %$add_opts)
    {
      $options->{$key} = $add_opts->{$key} if defined $add_opts->{$key};
    }
  }
  
  # Split any strings into arrays for options expecing a list of values.
  # Set defaults, if specified, and associate option values with
  # their keys as well as with their names.
  foreach my $spec (@$param_spec)
  {
    my $key = $spec->{KEY};
    my ($name,$type) = split(/[=:]/, $spec->{OPTION_NAME});
    my ($primary_name,$short) = split(/\|/, $name);
    
    # set defaults, if needed
    my $default = $spec->{DEFAULT};
    $options->{$primary_name} = $default
      if defined $default && ! defined $options->{$primary_name};
      
    # if expecting an array of values and got a string, split
    # into an array...
    if ($type && $type =~ /@/ &&  $options->{$primary_name})
    {
      my $array_ref = $options->{$primary_name};
      $options->{$primary_name} = [];
      foreach my $val (@$array_ref)
      {
        push @{$options->{$primary_name}}, split(/\s*[,+]+\s*/, $val);
      }
    }
    $options->{$key} = $options->{$primary_name};
  }
  
  # check required options...
  my $missing = '';
  foreach my $spec (@$param_spec)
  {
    next unless $spec->{REQUIRED};
    
    my $key = $spec->{KEY};
    my ($name,$type) = split(/[=:]/, $spec->{OPTION_NAME});
    my $arg_description = $spec->{ARG_NAME};
    $arg_description = '' unless $arg_description;
    
    unless (defined $options->{$key})
    {
      $missing = join("\n", $missing, "ERROR: -$name $arg_description option not specified");
      $missing = join("\n", $missing, "       option is required.");
    }
  }
  usage($missing) if $missing;
  
  # validate options
  foreach my $spec (@$param_spec)
  {
    if (exists $spec->{VALIDATE})
    {
      my $key = $spec->{KEY};
      my $val = $options->{$key};
      &{$spec->{VALIDATE}}($ws,$options,$val) if defined $val;
    }
  }
  return $options;
}

#------------------------------------------------------------
# _process_command_file -- command line args can be put in a
# file instead. Treat them exactly as if they had been typed
# on the command line.
#------------------------------------------------------------
sub _process_command_file
{
  my ($ws,$cmd_file, $param_list, $arg_description) = @_;
  die "no ws" unless $ws;
  return unless $cmd_file;
  die "file : $cmd_file does not exist" unless -f $cmd_file;
  print STDERR "reading param file : $cmd_file\n";
  
  # parse the contents of the file, ignoring comments, and handling
  # quoted strings properly.
  my $stack = [];
  my $fh = new FileHandle();
  $fh->open("<$cmd_file") or die "could not open $cmd_file";
  while ((my $line = $fh->getline()))
  {
    # pre-process the line
    $line =~ s/#.*//;     # allow (and ignore) comments in file...
    $line =~ s/^\s+//;    # no leading...
    $line =~ s/\s+$//;    # ... or trailing whitespace
    _tokenize_line($line,$stack);
  }
  $fh->close();

  # now convert the stack into a list of args.
  my $args = _parse_stack($stack);

  my $options = {};
  if (scalar @$args)
  {
    my @saved = @ARGV;    # save a copy of original args
    @ARGV = @$args;       # process the file args
    $options = read_command_line_options($ws,$param_list, $arg_description);
  
    # create a merged ARGV that reflects both, maintaining original order...
    my @args = @ARGV;     # as processed by GetOpts
    @ARGV = @saved;       # original, as processed by GetOpts
    push @ARGV, @args;    # combined -- SHOULD REMOVE DUPLICATE ENTRIES!
  }
  return $options;
}

sub _tokenize_line
{
  my ($line,$stack) = @_;
  return unless $line;

  my @parts = split(/\s+/, $line);
  foreach my $item (@parts)
  {
    if ($item =~ /^'[^']*'$/
    or     $item =~ /^"[^"]*"$/)
    {
      $item =~ s/^['"]//;
      $item =~ s/['"]$//;
      push @$stack,$item;
    }
    elsif ($item =~ /^(['"])/)
    {
      my $quote = $1;
      push @$stack, $quote;
      $item =~ s/^['"]//;
      push @$stack,$item;
    }
    elsif ($item =~ /(['"])$/)
    {
      my $quote = $1;
      $item =~ s/['"]$//;
      push @$stack,$item;
      push @$stack, $quote;
    }
    else
    {
      push @$stack,$item;
    }
  }
}

sub _parse_stack
{
  my ($stack) = @_;
  return $stack unless $stack;
  my $state = '';
  my $quotation = '';
  my $args = [];
  foreach my $token (@$stack)
  {
    if ($state)
    {
      if ("$token" eq $state)  # end of quote
      {
        push @$args, $quotation;
        $quotation = '';
        $state = '';
      }
      elsif ($quotation && ("$token" eq '"' or $token eq "'")) # part of quote
      {
        $quotation = join('', $quotation, $token);
      }
      elsif ($quotation)
      {
        $quotation = join(' ', $quotation, $token);
      }
      else
      {
        $quotation = $token;
      }
    }
    elsif ("$token" eq "'" or $token eq '"')  # start of quote
    {
      $quotation = '';
      $state = $token;
    }
    else
    {
      push @$args, $token;
    }
  }
  die "unmatched quotation mark $state in param file\n" if $state;
  return $args;
}

#------------------------------------------------------------
# usage -- print a usage message with all command line options
#------------------------------------------------------------
sub _print_description
{
  my ($description) = @_;

  my @words = split(/\s+/, $description);
  while (scalar @words)
  {
    my $line_len = 6;
    print STDERR " "x5;
    my $words_used = 0;
    my $n_words = scalar @words;
    for (my $ii = 0; $ii < $n_words; ++$ii)
    {
      $line_len += length($words[$ii]) + 1;
      my $last_word = ($ii == $n_words-1);
      if ($line_len < 80)
      {
        print STDERR " $words[$ii]";
	++ $words_used;
        # the last word?
        if ($last_word)
        {
          print STDERR "\n";
          # remove words already used
          splice(@words, 0, $words_used);
          last;
        }
      }
      else   # no more space on this line
      {
        print STDERR "\n";
        # remove words already used
        splice(@words, 0, $words_used);
        last;
      }
    }
  }
}

sub usage
{
  my @str_list = @_;
  
  foreach my $str (@str_list)
  {
    print STDERR "$str\n";
  }
  
  my ($vol,$dirs,$name) = File::Spec->splitpath($0);

  print STDERR "USAGE : ", $name, " <OPTIONS> $ARG_DESCRIPTION\n";
  print STDERR "SUPPORTED OPTIONS :\n";
  
  foreach my $key (sort keys %HELP)
  {
    my ($long,$short,$arg) = ($1,$2,$3) if $key =~ /([^|]+)\|([^\s]+)\s+(.*)/;
    if ($long && $short && $arg)
    {
      printf STDERR ("  -%s %s\n", $short, $arg);
      printf STDERR ("  -%s %s\n", $long, $arg);
      _print_description($HELP{$key});
    }
    else
    {
      my ($opt,$arg) = ($1,$2) if $key =~ /([\s|]+)\s+([^\s]+)/;
      if ($opt && $arg)
      {
        printf STDERR ("  -%s %s\n", $opt, $arg);
        _print_description($HELP{$key});
      }
      else
      {
        printf STDERR ("  -%s\n", $key);
        _print_description($HELP{$key});
      }
    }
    print STDERR "\n";
  }
  
  exit(1);
}

__END__
# some search test cases
# today's near real time 1km L1B files over Indonesia
order_MWS.pl -c 5 -w 100 -n 5 -s -10 -e 125 MOD021KM

# Cloud mask and Aerosol files over lake Winnipeg on Aug 1, 2009
order_MWS.pl -c 5 -w -100 -n 55 -s 50 -e -95 -t "Aug 1, 2009 00:00:00" -u "Aug 1, 2009 23:59:59" MOD35_L2 MOD04_L2