#!/usr/bin/perl
#
# sacpz handler:
#
# Handler for the NCEDC Web Service Shell (WSS)
# implementing sacpz version 1.0.
#
# This handler validates and processes a request and responds as
# expected by the WSS using a NCEDC 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
# NCEDC 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
#
# ChangeLog:
#
# 2013.098:
#  - Initial version

use Env qw( ORACLE_HOME NLS_LANG NLS_DATE_FORMAT );

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

my $version  = "2013.098";

my $scriptname = basename($0);

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

my $starttime = undef;
my $endtime   = undef;
my $pttime    = undef;

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

my $oracle_home = "/usr/local/lib/Oracle/current";
$ENV{ORACLE_HOME} = $oracle_home if ($ENV{ORACLE_HOME} eq "");
$ENV{NLS_LANG} = "american_america.US7ASCII";
$ENV{NLS_DATE_FORMAT} = "yyyy/mm/dd hh24:mi:ss";

require "/usr/local/lib/dbsetup.pl";

# 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', 'time',
		  'network', 'net', 'station', 'sta',
		  'location', 'loc', 'channel', 'cha',
		  );

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,
			      'time=s'           => \$pttime,

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

exit (3) if ( ! $getoptsret );

if ( defined $usage )
  {
    my $name = basename ($0);
    print STDERR "WSS Handler to fetch RESP metadata from the NCEDC ($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 " --time       Specify point in time (YYYY-MM-DDTHH:MM:SS[.ssssss])\n";
    print STDERR "\n";
    print STDERR " --network    Network code\n";
    print STDERR " --station    Station code\n";
    print STDERR " --location   Location code, wildcards (* and ?) accepted\n";
    print STDERR " --channel    Channel code, wildcards (* and ?) accepted\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 ()
{
 my $flag = 0;
 my $cursor;
 my ($dbchannel,$dblocation);

 # Convert time format
 # 000000000011111111112
 # 012345678901234567890
 # YYYY-MM-DDTHH:MM:SS.ssssss

 if ( defined $starttime ) {
	my $time = trim(substr($starttime,5,2))."/".trim(substr($starttime,8,2))."/".trim(substr($starttime,0,4))." ".trim(substr($starttime,11,8));
	$starttime = $time;
 }

 if ( defined $endtime ) {
        my $time = trim(substr($endtime,5,2))."/".trim(substr($endtime,8,2))."/".trim(substr($endtime,0,4))." ".trim(substr($endtime,11,8));
        $endtime = $time;
 }

 if ( defined $pttime ) {
        my $time = trim(substr($pttime,5,2))."/".trim(substr($pttime,8,2))."/".trim(substr($pttime,0,4))." ".trim(substr($pttime,11,8));
        $starttime = $time;
	$endtime = $time;
 }

 # Database connection
 # Parse DB_CONNECT environment variable for database access.
 my ( $dbuser, $dbpass, $dbname );
 if ($ENV{DB_CONNECT} ne "") {
	($dbuser,$dbpass,$dbname) = $ENV{DB_CONNECT} =~ m|^(.+)/(.+)\@(.+)$|;
	die ("Error: invalid DB_CONNECT environment variable: $ENV{DB_CONNECT}\n")
		if ($dbuser eq "" || $dbpass eq "" || $dbname eq "");
 }

 my $dbh = DBI->connect(
	"dbi:Oracle:" . $dbname, $dbuser, $dbpass,
	{ RaiseError => 1, AutoCommit => 0 }
 ) || die "Database connection not made: $DBI::errstr";

 # Expand channel/location list
 $channel =~ s/\*/\%/g;
 $channel =~ s/\?/_/g;
 $location =~ s/\*/\%/g;
 $location =~ s/\?/_/g;
 $location =~ s/\-/\ /g;

 my $sql_statement = "SELECT DISTINCT seedchan, location FROM Channel_Data WHERE net='$network' AND sta='$station' AND seedchan LIKE '$channel' AND location LIKE '$location'";

 if ( $pretend ) {
	print "$sql_statement\n";
        return 0;
 }

 unless ($cursor = $dbh->prepare("$sql_statement")) {
	print STDERR "Error: unable to prepare cursor\n";
	$dbh->rollback;
	return 1;
 }

 unless ($cursor->execute) {
	print STDERR "Error: unable to execute cursor\n";
	$dbh->rollback;
        return 1;
 }

 $dbh->func( 1000000, 'dbms_output_enable' );

 # Retrieve response for each channel
 while (($dbchannel,$dblocation) = $cursor->fetchrow_array) {
	# exec showsacpz ('BK','CMB','00','BHN','01/01/2013 00:00:00','01/02/2013 00:00:00');
	eval {
	    my $func = $dbh->prepare(q{
	        BEGIN
	            showsacpz(
	                net_in => :network,
			stat_in => :station,
			loc_in => :location,
			chan_in => :channel,
			sdate_in => :startdate,
			edate_in => :enddate
	      	      );
	        END;
	    });
  
	    $func->bind_param(":network", $network);
	    $func->bind_param(":station", $station);
	    $func->bind_param(":location", $dblocation);
	    $func->bind_param(":channel", $dbchannel);
	    $func->bind_param(":startdate", $starttime);
	    $func->bind_param(":enddate", $endtime);
	    $func->execute;
  
	    $dbh->commit;
	};

	if( $@ ) {
	    print STDERR "Execution of stored procedure failed: $DBI::errstr\n";
	    $dbh->rollback;
	    return 1;
	}

	my @result = $dbh->func( 'dbms_output_get' );

	foreach (@result) {
	  $flag = 1;
	  print "$_\n";
	}
 }

 unless ($cursor->finish) {
	print STDERR "Error: unable to finish cursor\n";
	$dbh->rollback;
	return 1;
 }

 if ( $flag == 0) {
	print STDERR "No Data Found\n";
	$dbh->rollback;
	return 2;
 }

 $dbh->disconnect;

 return 0;
}  # End of HandleRequest()


######################################################################
# 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
#
# 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 ( defined $starttime && ! ValidDateTime ($starttime) ) {
    print STDERR "Unrecognized start time [YYYY-MM-DDTHH:MM:SS.ssssss]: '$starttime'\n";
    $retval = 3;
  }

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

  if ( defined $starttime && defined $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 (( defined $pttime && defined $starttime ) || ( defined $pttime && defined $endtime )) {
    print STDERR "Point in time and start/end times arguments are mutually exclusive\n";
    $retval = 3;
  }

  if ( !defined $pttime && defined $starttime && !defined $endtime ) {
    $endtime = "2020-01-01T00:00:00";
  }

  if ( !defined $pttime && !defined $starttime && defined $endtime ) {
    $starttime = "1960-01-01T00:00:00";
  }

  if ( !defined $pttime && !defined $starttime && !defined $endtime ) {
    $pttime = strftime("%Y-%m-%dT%H:%M:%S", localtime(time));
  }

  if ( defined $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;
      }
    }
  } else {
	print STDERR "network code is required\n";
	$retval = 3;
  }

  if ( defined $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;
      }
    }
  } else {
	print STDERR "station code is required\n";
	$retval = 3;
  }

  if ( defined $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;
      }
    }
  } else {
	print STDERR "location code is required\n";
	$retval = 3;
  }

  if ( defined $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;
      }
    }
  } else {
	print STDERR "channel code is required\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
#
# 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)?$/ );

  return 0;
}  # End of ValidDateTime

sub trim
{
    my @out = @_;
    for (@out)
    {
        s/^\s+//;
        s/\s+$//;
    }
    return wantarray ? @out : $out[0];
}