#!/usr/bin/perl
#
# fdsnws-station "bridge" handler:
#
# A test and template handler for the IRIS Web Service Shell (WSS)
# implementing fdsnws-station version 1.0.
#
# This handler validates and processes a request and responds as
# expected by the WSS using a IRIS web service to fulfill the request.
#
# Data requests are submitted as command line arguments.  All returned
# data is written to STDOUT and all diagnostics and errors are written
# to STDERR.
#
## Use as a template
#
# To modify this handler to access local data center repositories the
# HandleRequest() routine should be modified, replacing the call to a
# IRIS web service with data extraction from local repositories or
# whatever else might be appropriate.
#
# Name parameter lists: each of network, station, location and channel
# may contain a list of comma separated values, which may further
# contain wildcards.  For example, the channel value may contain
# "LHE,LHN,LHZ" or "LH?,BH?".
#
# The exit statuses employed and expected by the WSS:
#
# Exit Status = Description
# 0  =  Successfully processed request, data returned via stdout
# 1  =  General error. An error description may be provided on stderr
# 2  =  No data. Request was successful but results in no data
# 3  =  Invalid or unsupported argument/parameter
# 4  =  Too much data requested
#
# All start times and end times are assumed to be in UTC and expected
# in be one of these forms (with optional trailing Z):
#   YYYY-MM-DD[T ]HH:MM:SS.ssssss
#   YYYY-MM-DD[T ]HH:MM:SS
#   YYYY-MM-DD
#
# ChangeLog:
#
# 2013.035:
#  - Initial version
#
# 2013.042:
#  - Call UserAgent::env_proxy so that LWP requests use common
#  environtment variables such as http_proxy.

use strict;
use Getopt::Long;
use File::Basename;
use Config;
use LWP::UserAgent;
use HTTP::Status qw(status_message);
use HTTP::Date;

my $version  = "2013.042";

my $scriptname = basename($0);

my $verbose  = undef;
my $usage    = undef;
my $pretend  = undef;

my $starttime = undef;
my $endtime   = undef;
my $startbefore = undef;
my $startafter = undef;
my $endbefore = undef;
my $endafter  = undef;

my $network   = undef;
my $station   = undef;
my $location  = undef;
my $channel   = undef;

my $minlatitude = undef;
my $maxlatitude = undef;
my $minlongitude = undef;
my $maxlongitude = undef;

my $latitude = undef;
my $longitude = undef;
my $minradius = undef;
my $maxradius = undef;

my $level = "station";
my $includerestricted = undef;
my $includeavailability = undef;

my $updatedafter = undef;

my $output = undef;  # This option is an IRIS extension


# The WSS will always translate URI parameters to command line options
# prefixed with a double-dash (--), e.g. 'station=ANMO' becomes '--station ANMO'
#
# This characteristic is leveraged to allow this handler script to
# support options specified with a single dash (for diagnostics and
# testing) that can never be specified by a remote call via the WSS.
#
# This is enforced by limiting the arguments that can be called
# using double-dashes to a subset needed to match the web service
# request paramters and the special case '--STDIN' and '--username'
# options.  All such options should be in the @doubledash list.

my @doubledash = ('starttime', 'start', 'endtime', 'end',
		  'startbefore', 'startafter', 'endbefore', 'endafter',
		  'network', 'net', 'station', 'sta',
		  'location', 'loc', 'channel', 'cha',
		  'minlatitude', 'minlat', 'maxlatitude', 'maxlat',
		  'minlongitude', 'minlon', 'maxlongitude', 'maxlon',
		  'latitude', 'lat', 'longitude', 'lon',
		  'minradius', 'maxradius',
		  'level', 'includerestricted', 'includeavailability',
		  'updatedafter', 'output');

foreach my $idx ( 0..$#ARGV ) {
  if ( $ARGV[$idx] =~ /^--.+/ )
    {
      my $arg = substr $ARGV[$idx], 2;

      if ( ! grep (/^${arg}$/, @doubledash) ) {
	print STDERR "Unrecognized option: $ARGV[$idx]\n";
	exit (3);
      }
    }
}

# Parse command line arguments
Getopt::Long::Configure (qw{ bundling_override no_auto_abbrev no_ignore_case_always });
my $getoptsret = GetOptions ( 'v+'           => \$verbose,
                              'h'            => \$usage,
                              'p'            => \$pretend,

                              'starttime|start|ts=s' => \$starttime,
                              'endtime|end|te=s' => \$endtime,
			      'startbefore=s'    => \$startbefore,
			      'startafter=s'     => \$startafter,
			      'endbefore=s'      => \$endbefore,
			      'endafter=s'       => \$endafter,

                              'network|net|N=s'  => \$network,
                              'station|sta|S=s'  => \$station,
                              'location|loc|L=s' => \$location,
                              'channel|cha|C=s'  => \$channel,

			      'minlatitude|minlat=s' => \$minlatitude,
			      'maxlatitude|maxlat=s' => \$maxlatitude,
			      'minlongitude|minlon=s' => \$minlongitude,
			      'maxlongitude|maxlon=s' => \$maxlongitude,

			      'latitude|lat=s'   => \$latitude,
			      'longitude|lon=s'  => \$longitude,
			      'minradius=s'      => \$minradius,
			      'maxradius=s'      => \$maxradius,

			      'level=s'          => \$level,
			      'includerestricted=s' => \$includerestricted,
			      'includeavailability=s' => \$includeavailability,
			      'updatedafter=s'   => \$updatedafter,
			      'output=s'         => \$output,
                              );

exit (3) if ( ! $getoptsret );

if ( defined $usage )
  {
    my $name = basename ($0);
    print STDERR "WSS Handler to fetch metadata from the IRIS DMC ($version)\n\n";
    print STDERR "Usage: $name [-v] \n\n";
    print STDERR " -h           Print this help message\n";
    print STDERR " -v           Be more verbose, multiple flags can be used\n";
    print STDERR " -p           Pretend, do everything except request data from backend\n";
    print STDERR "\n";
    print STDERR " --starttime  Specify start time (YYYY-MM-DDTHH:MM:SS.ssssss)\n";
    print STDERR " --endtime    Specify end time (YYYY-MM-DDTHH:MM:SS.ssssss)\n";
    print STDERR " --startbefore Specify start before time (YYYY-MM-DDTHH:MM:SS.ssssss)\n";
    print STDERR " --startafter  Specify start after time (YYYY-MM-DDTHH:MM:SS.ssssss)\n";
    print STDERR " --endbefore   Specify end before time (YYYY-MM-DDTHH:MM:SS.ssssss)\n";
    print STDERR " --endafter    Specify end after time (YYYY-MM-DDTHH:MM:SS.ssssss)\n";
    print STDERR "\n";
    print STDERR " --network    Network code, list and wildcards (* and ?) accepted\n";
    print STDERR " --station    Station code, list and wildcards (* and ?) accepted\n";
    print STDERR " --location   Location ID, list and wildcards (* and ?) accepted\n";
    print STDERR " --channel    Channel codes, list and wildcards (* and ?) accepted\n";
    print STDERR "\n";
    print STDERR " --minlatitude  Specify minimum latitude in degrees\n";
    print STDERR " --maxlatitude  Specify maximum latitude in degrees\n";
    print STDERR " --minlongitude Specify minimum longitude in degrees\n";
    print STDERR " --maxlongitude Specify maximum longitude in degrees\n";
    print STDERR "\n";
    print STDERR " --latitude    Specify latitude for radius search\n";
    print STDERR " --longitude   Specify longitude for radius search\n";
    print STDERR " --minradius   Specify minimum radius from latitude:longitude\n";
    print STDERR " --maxradius   Specify maximum radius from latitude:longitude\n";
    print STDERR "\n";
    print STDERR " --level       Specify level of StationXML results [net,sta,chan,resp]\n";
    print STDERR " --includerestricted  Toggle including restricted data in results [TRUE|FALSE]\n";
    print STDERR " --includeavailability  Toggle including availability in results [TRUE|FALSE]\n";
    print STDERR " --updatedafter Limit results to metadata updated after time\n";
    print STDERR "\n";
    print STDERR " --output     Specify output format [xml, text, texttree]\n";
    print STDERR "\n";

    exit (1);
}

# Track run duration for diagnostics
my $startrequest = time;

# Validate global request parameters, exit if needed
my $retval = &ValidateRequest();

if ( $retval ) {
  exit ($retval);
}

# Handle/fullfill data request
my $retval = &HandleRequest();

if ( $retval ) {
  exit ($retval);
}

if ( $verbose ) {
  my $runtime = time - $startrequest;
  print STDERR "Finished ($runtime seconds)\n";
}

# Return with success code
exit (0);

## End of main


######################################################################
# HandleRequest:
#
# Process validated request and return selected data on STDOUT.  On
# errors this routine should return either an appropriate error code
# or exit within the routine with the appropriate message and error
# code.  The request parameters are available from global variables.
#
# Name parameter lists: each of $network, $station, $location and
# $channel may contain a list of comma separated values, which may
# futher contain wildcards.  For example, the channel value may
# contain "LHE,LHN,LHZ" or "LH?,BH?".
#
# When a fatal error is reached in this routine be sure to use the
# appropriate exit code:
#
#   Exit Status = Description
#   1  =  General error. An error description may be provided on stderr
#   2  =  No data. Request was successful but results in no data
#   3  =  Invalid or unsupported argument/parameter
#   4  =  Too much data requested
#
# Returns 0 on success, otherwise an appropriate exit code.
######################################################################
sub HandleRequest ()
{
  # Web service to process data request, this the other end of the bridge
  my $backendservice = 'http://service.iris.edu/fdsnwsbeta/station/1';

  # HTTP UserAgent reported to web services
  my $useragent = "$scriptname/$version Perl/$] " . new LWP::UserAgent->_agent;

  # Create the request URI
  my $uri = "$backendservice/query?level=$level";

  $uri .= "&starttime=$starttime" if ( $starttime );
  $uri .= "&endtime=$endtime" if ( $endtime );
  $uri .= "&startbefore=$startbefore" if ( $startbefore );
  $uri .= "&startafter=$startafter" if ( $startafter );
  $uri .= "&endbefore=$endbefore" if ( $endbefore );
  $uri .= "&endafter=$endafter" if ( $endafter );

  $uri .= "&network=$network" if ( $network );
  $uri .= "&station=$station" if ( $station );
  $uri .= "&location=$location" if ( $location );
  $uri .= "&channel=$channel" if ( $channel );

  $uri .= "&minlatitude=$minlatitude" if ( $minlatitude );
  $uri .= "&maxlatitude=$maxlatitude" if ( $maxlatitude );
  $uri .= "&minlongitude=$minlongitude" if ( $minlongitude );
  $uri .= "&maxlongitude=$maxlongitude" if ( $maxlongitude );

  $uri .= "&latitude=$latitude" if ( $latitude );
  $uri .= "&longitude=$longitude" if ( $longitude );
  $uri .= "&minradius=$minradius" if ( $minradius );
  $uri .= "&maxradius=$maxradius" if ( $maxradius );

  $uri .= "&includerestricted=$includerestricted" if ( $includerestricted );
  $uri .= "&includeavailability=$includeavailability" if ( $includeavailability );
  $uri .= "&updatedafter=$updatedafter" if ( $updatedafter );

  $uri .= "&output=$output" if ( $output );

  if ( $verbose >= 1 ) {
    print STDERR "Backend GET:\n$uri\n";
  }

  # Stop here if pretending
  return 0 if $pretend;

  # Create HTTP client, submit POST request to backend service and
  # write returned content to STDOUT using a callback function.
  my $ua = LWP::UserAgent->new();
  $ua->agent($useragent);
  $ua->env_proxy;
  my $response = $ua->get ($uri, ':content_cb' => \&DLCallBack);

  # Translate backend service response codes to expected exit status with messages
  my $respcode = $response->code;
  if ( $respcode == 204 ) {
    return 2;
  }
  elsif ( $respcode == 413 ) {
    print STDERR "Too much data requested\n";
    return 4;
  }
  elsif ( $respcode >= 400 && $respcode < 500 ) {
    print STDERR "Error with arguments: %s\n", $response->decoded_content();
    return 3;
  }
  elsif ( $respcode >= 500 ) {
    print STDERR "General error: %s\n", $response->decoded_content();
    return 1;
  }
  elsif ( ! $response->is_success() ) {
    print STDERR "Error calling backend service, code %d\n", $response->code;
    return 1;
  }

  return 0;
}  # End of HandleRequest()


######################################################################
# DLCallBack:
#
# A call back for LWP downloading in HandleRequest().
#
# Write received data to standard output.
######################################################################
sub DLCallBack {
  my ($data, $response, $protocol) = @_;

  # If HTTP request was a success write returned content directly to STDOUT.
  if ( $response->is_success() ) {
    print STDOUT $data;
  }
}


######################################################################
# ValidateRequest:
#
# Validate the data selection parameter values and print specific
# errors to STDERR.
#
# Expected date-time formats are one of:
#
# YYYY-MM-DD[T ]HH:MM:SS.ssssss
# YYYY-MM-DD[T ]HH:MM:SS
# YYYY-MM-DD
#
# Month, day, hour, min and second values may be single digits.
#
# If specified, network, station, location and channel are
# validated for length and characters allowed in the SEED 2.4
# specification or wildcards.
#
# Name parameter lists: each of network, station, location and channel
# may contain a list of comma separated values, which may futher
# contain wildcards.  For example, the channel value may contain
# "LHE,LHN,LHZ" or "LH?,BH?".
#
# Returns 0 on success, otherwise an appropriate exit code.
######################################################################
sub ValidateRequest () {
  my $retval = 0;

  if ( $starttime && ! ValidDateTime ($starttime) ) {
    print STDERR "Unrecognized start time [YYYY-MM-DDTHH:MM:SS.ssssss]: '$starttime'\n";
    $retval = 3;
  }

  if ( $endtime && ! ValidDateTime ($endtime) ) {
    print STDERR "Unrecognized end time [YYYY-MM-DDTHH:MM:SS.ssssss]: '$endtime'\n";
    $retval = 3;
  }

  if ( $starttime && $endtime ) {
    # Check for impossible time windows
    my $startepoch = str2time ($starttime, "UTC");
    my $endepoch = str2time ($endtime, "UTC");

    if ( $startepoch > $endepoch ) {
      print STDERR "Start time must be before end time, start: '$starttime', end: '$endtime'\n";
      $retval = 3;
    }
  }

  if ( $startbefore && ! ValidDateTime ($startbefore) ) {
    print STDERR "Unrecognized start before time [YYYY-MM-DDTHH:MM:SS.ssssss]: '$startbefore'\n";
    $retval = 3;
  }

  if ( $startafter && ! ValidDateTime ($startafter) ) {
    print STDERR "Unrecognized start after time [YYYY-MM-DDTHH:MM:SS.ssssss]: '$startafter'\n";
    $retval = 3;
  }

  if ( $endbefore && ! ValidDateTime ($endbefore) ) {
    print STDERR "Unrecognized end before time [YYYY-MM-DDTHH:MM:SS.ssssss]: '$endbefore'\n";
    $retval = 3;
  }

  if ( $endafter && ! ValidDateTime ($endafter) ) {
    print STDERR "Unrecognized end after time [YYYY-MM-DDTHH:MM:SS.ssssss]: '$endafter'\n";
    $retval = 3;
  }

  if ( $updatedafter && ! ValidDateTime ($updatedafter) ) {
    print STDERR "Unrecognized updated after time [YYYY-MM-DDTHH:MM:SS.ssssss]: '$updatedafter'\n";
    $retval = 3;
  }

  if ( $network ) {
    foreach my $net ( split (/,/, $network) ) {
      if ( $net !~ /^[A-Za-z0-9\*\?]{1,2}$/ ) {
	print STDERR "Unrecognized network code [1-2 characters]: '$net'\n";
	$retval = 3;
      }
    }
  }

  if ( $station ) {
    foreach my $sta ( split (/,/, $station) ) {
      if ( $sta !~ /^[A-Za-z0-9\*\?]{1,5}$/ ) {
	print STDERR "Unrecognized station code [1-5 characters]: '$sta'\n";
	$retval = 3;
      }
    }
  }

  if ( $location ) {
    foreach my $loc ( split (/,/, $location) ) {
      if ( $loc !~ /^[A-Za-z0-9\-\*\?]{1,2}$/ ) {
	print STDERR "Unrecognized location ID [1-2 characters]: '$loc'\n";
	$retval = 3;
      }
    }
  }

  if ( $channel ) {
    foreach my $chan ( split (/,/, $channel) ) {
      if ( $chan !~ /^[A-Za-z0-9\*\?]{1,3}$/ ) {
	print STDERR "Unrecognized channel codes [1-3 characters]: '$chan'\n";
	$retval = 3;
      }
    }
  }

  # Validate minlatitude option, must be a decimal value between -90 and 90
  if ( $minlatitude ) {
    if ( $minlatitude !~ /^[+-]?\d+(\.\d+)?$/ ) {
      print STDERR "Unrecognized value for minlatitude [decimal degrees]: '$minlatitude'\n";
      $retval = 3;
    }
    elsif ( $minlatitude < -90.0 || $minlatitude > 90.0 ) {
      print STDERR "Value for minlatitude out of range [-90 to 90]: '$minlatitude'\n";
      $retval = 3;
    }
  }

  # Validate maxlatitude option, must be a decimal value between -90 and 90
  if ( $maxlatitude ) {
    if ( $maxlatitude !~ /^[+-]?\d+(\.\d+)?$/ ) {
      print STDERR "Unrecognized value for maxlatitude [decimal degrees]: '$maxlatitude'\n";
      $retval = 3;
    }
    elsif ( $maxlatitude < -90.0 || $maxlatitude > 90.0 ) {
      print STDERR "Value for maxlatitude out of range [-90 to 90]: '$maxlatitude'\n";
      $retval = 3;
    }
  }

  # Validate minlongitude option, must be a decimal value between -180 and 180
  if ( $minlongitude ) {
    if ( $minlongitude !~ /^[+-]?\d+(\.\d+)?$/ ) {
      print STDERR "Unrecognized value for minlongitude [decimal degrees]: '$minlongitude'\n";
      $retval = 3;
    }
    elsif ( $minlongitude < -180.0 || $minlongitude > 180.0 ) {
      print STDERR "Value for minlongitude out of range [-180 to 180]: '$minlongitude'\n";
      $retval = 3;
    }
  }

  # Validate maxlongitude option, must be a decimal value between -180 and 180
  if ( $maxlongitude ) {
    if ( $maxlongitude !~ /^[+-]?\d+(\.\d+)?$/ ) {
      print STDERR "Unrecognized value for maxlongitude [decimal degrees]: '$maxlongitude'\n";
      $retval = 3;
    }
    elsif ( $maxlongitude < -180.0 || $maxlongitude > 180.0 ) {
      print STDERR "Value for maxlongitude out of range [-180 to 180]: '$maxlongitude'\n";
      $retval = 3;
    }
  }

  # Validate latitude option, must be a decimal value between -90 and 90
  if ( $latitude ) {
    if ( $latitude !~ /^[+-]?\d+(\.\d+)?$/ ) {
      print STDERR "Unrecognized value for latitude [decimal degrees]: '$latitude'\n";
      $retval = 3;
    }
    elsif ( $latitude < -90.0 || $latitude > 90.0 ) {
      print STDERR "Value for latitude out of range [-90 to 90]: '$latitude'\n";
      $retval = 3;
    }
  }

  # Validate longitude option, must be a decimal value between -180 and 180
  if ( $longitude ) {
    if ( $longitude !~ /^[+-]?\d+(\.\d+)?$/ ) {
      print STDERR "Unrecognized value for longitude [decimal degrees]: '$longitude'\n";
      $retval = 3;
    }
    elsif ( $longitude < -180.0 || $longitude > 180.0 ) {
      print STDERR "Value for longitude out of range [-180 to 180]: '$longitude'\n";
      $retval = 3;
    }
  }

  # Validate minradius option, must be a decimal value between 0 and 180
  if ( $minradius ) {
    if ( $minradius !~ /^[+-]?\d+(\.\d+)?$/ ) {
      print STDERR "Unrecognized value for minradius [decimal degrees]: '$minradius'\n";
      $retval = 3;
    }
    elsif ( $minradius < 0.0 || $minradius > 180.0 ) {
      print STDERR "Value for minradius out of range [0 to 180]: '$minradius'\n";
      $retval = 3;
    }
  }

  # Validate maxradius option, must be a decimal value between 0 and 180
  if ( $maxradius ) {
    if ( $maxradius !~ /^[+-]?\d+(\.\d+)?$/ ) {
      print STDERR "Unrecognized value for maxradius [decimal degrees]: '$maxradius'\n";
      $retval = 3;
    }
    elsif ( $maxradius < 0.0 || $maxradius > 180.0 ) {
      print STDERR "Value for maxradius out of range [0 to 180]: '$maxradius'\n";
      $retval = 3;
    }
  }

  # Check that latitude & longitude are specified if minradius or maxradius is specified
  if ( ($minradius || $maxradius) &&
       ! ($latitude && $longitude) ) {
    print STDERR "latitude and longitude must be specified if minradius and/or maxradius is used\n";
    $retval = 3;
  }

  # Check that min/max lat/lon is not combined with lat/lon/radius
  if ( ($minlatitude || $maxlatitude || $minlongitude || $maxlongitude) &&
       ($minradius || $maxradius) ) {
    print STDERR "[min|max]latitude and [min|max]longitude cannot be combined with latitude, longitude [min|max]radius\n";
    $retval = 3;
  }

  # Validate level option, must be "network", "station", "channel" or "response"
  if ( $level && $level !~ /^(network|station|channel|response)$/i ) {
    print STDERR "Unrecognized level selection [network, station, channel, response]: '$level'\n";
    $retval = 3;
  }

  # Validate includerestricted option, must be TRUE or FALSE case insensitive
  if ( $includerestricted && ($includerestricted !~ /^TRUE$/i && $includerestricted !~ /^FALSE$/i) ) {
    print STDERR "Unrecognized value for includerestricted [TRUE or FALSE]: '$includerestricted'\n";
    $retval = 3;
  }

  # Validate includeavailability option, must be TRUE or FALSE case insensitive
  if ( $includeavailability && ($includeavailability !~ /^TRUE$/i && $includeavailability !~ /^FALSE$/i) ) {
    print STDERR "Unrecognized value for includeavailability [TRUE or FALSE]: '$includeavailability'\n";
    $retval = 3;
  }

  # Validate output option, must be one of [xml, text, texttree]
  if ( $output && $output !~ /^(xml|text|texttree)$/i ) {
    print STDERR "Unrecognized value for output [xml, text, textree]: '$output'\n";
    $retval = 3;
  }

  return $retval;
}  # End of ValidateRequest()


######################################################################
# ValidateDateTime:
#
# Validate a string to match one of these date-time formats:
#
# YYYY-MM-DD[T ]HH:MM:SS.ssssss
# YYYY-MM-DD[T ]HH:MM:SS
# YYYY-MM-DD
#
# Returns 1 on match and 0 on non-match.
######################################################################
sub ValidDateTime () {
  my $string = shift;

  return 0 if ( ! $string );

  return 1 if ( $string =~ /^\d{4}-[01]\d-[0-3]\d[T ][0-2]\d:[0-5]\d:[0-5]\d\.\d+(Z)?$/ ||
		$string =~ /^\d{4}-[01]\d-[0-3]\d[T ][0-2]\d:[0-5]\d:[0-5]\d(Z)?$/ ||
		$string =~ /^\d{4}-[01]\d-[0-3]\d(Z)?$/ );

  return 0;
}  # End of ValidDateTime