#!/usr/bin/env perl

use warnings;
use strict;

## report the program and machine
use Sys::Hostname;
my $host = hostname();
print "\n\n";
print "Starting script $0 on $host\n\n";

use Cache::File;
use Storable qw( freeze thaw );
use File::Basename qw( basename );
use IPC::Cmd qw( can_run run );
use PS::IPP::Metadata::Config;
use PS::IPP::Metadata::List qw( parse_md_list );
use Statistics::Descriptive;

use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt );
use Pod::Usage qw( pod2usage );

use PS::IPP::Config qw(
    $PS_EXIT_SUCCESS
    $PS_EXIT_UNKNOWN_ERROR
    $PS_EXIT_SYS_ERROR
    $PS_EXIT_CONFIG_ERROR
    $PS_EXIT_PROG_ERROR
    $PS_EXIT_DATA_ERROR
    $PS_EXIT_TIMEOUT_ERROR
    );

my ($cache, $exptag, $workdir, $dbname, $no_update);

GetOptions(
    'caches'        => \$cache,
    'exp_tag|e=s'   => \$exptag,
    'workdir|w=s'   => \$workdir, # Working directory for output files
    'dbname|d=s'    => \$dbname, # Database name    
    'no-update'     => \$no_update
) or pod2usage( 2 );

pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV;
pod2usage(
    -msg => "Required options: --exp_tag",
    -exitval => 3,
) unless defined $exptag;

# Define setup
use constant TYPE => "exp_type"; # Observation type keyword
use constant DETRENDS => [ "bias", "zero", "dark", "shutter", "flat", "fringe", "domeflat", "skyflat" ]; # Observation types to mark as detrend
use constant DETREND_FLAG => "-detrend"; # Flag to use to mark detrend exposure

use constant REGISTER_URI => 'uri'; # Key for the URI
use constant REGISTER_CLASSID => 'class_id'; # Key for the class id
use constant REGISTER_BG => 'bg';        # Key for the background
use constant REGISTER_BG_STDEV => 'bg_stdev'; # Key for the background standard deviation
use constant REGISTER_BG_MEAN_STDEV => 'bg_mean_stdev'; # Key for the mean of the background standard deviation

# These values should be constant for all components
use constant CONSTANTS => [
                           "object", # Object
                           "exp_type", # Exposure type
                           "filter", # Filter used
                           "airmass", # Airmass
                           "ra", # Right ascension
                           "decl", # Declination
                           "posang", # Position angle
                           "alt", # Altitude
                           "az", # Azimuth
                           "ccd_temp", # CCD temperature
                           "dateobs", # Time of exposure
                       ];

# These values may vary across components; we will take the average
use constant VARIABLES => [
                           "exp_time", # Exposure time
                           ];


# Look for commands we need
my $missing_tools;
my $regtool = can_run('regtool')
    or (warn "can't find regtool" and $missing_tools = 1);
my $ppStats = can_run('ppStats')
    or (warn "can't find ppStats" and $missing_tools = 1);

if ($missing_tools) { 
    warn ("Can't find required tools");
    exit($PS_EXIT_CONFIG_ERROR); 
}

# setup cache interface

my $c = Cache::File->new(
    cache_root => File::Spec->catdir($ENV{'HOME'}, '.pxtools', basename($0)),
    default_expires => '7200 sec',
);

my $mdcParser = PS::IPP::Metadata::Config->new;        # Parser for metadata config files

# Get the list of imfiles
my $imfiles;
{
    my $command = "$regtool -processedimfile -exp_tag $exptag";
    $command .= " -dbname $dbname" if defined $dbname;
    my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
        cache_run(command => $command, verbose => 1);
    unless ($success) {
	$error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
        warn ("Unable to perform regtool -processedimfile on exposure id $exptag: $error_code");
        exit ($error_code);
    }

    my $metadata = $mdcParser->parse(join "", @$stdout_buf);
    unless ($metadata) {
        warn ("Unable to parse metadata config doc");
        &my_die ($exptag, $PS_EXIT_PROG_ERROR);
    }
    $imfiles = parse_md_list($metadata); # Data for imfiles
}

# Process the values
my %values;                        # Values to update
foreach my $variable (@{VARIABLES()}) {
    $values{$variable} = [];
}
my @backgrounds;                # Array of backgrounds
my @variances;                        # Array of background standard deviations\
my $obsType;                        # Observation type
  
foreach my $imfile (@$imfiles) {
    foreach my $constant (@{CONSTANTS()}) {
        my $value = get_value($imfile, $constant); # Value for imfile
        if (not defined $values{$constant}) {
            $values{$constant} = $value;
        }
        if ($values{$constant} ne $value) {
            warn ("Value of $constant for $imfile->{REGISTER_CLASSID} doesn't match previous value");
            &my_die ($exptag, $PS_EXIT_PROG_ERROR);
        }
    }
    
    foreach my $variable (@{VARIABLES()}) {
        my $value = get_value($imfile, $variable); # Value for imfile
        my $array = $values{$variable};        # Array of data
        push @$array, $value;
    }
    
    my $bg = get_value($imfile, REGISTER_BG());
    push @backgrounds, $bg;
    
    my $stdev = get_value($imfile, REGISTER_BG_MEAN_STDEV());
    push @variances, $stdev**2;
}

if (0) {
# XXX for a test, randomly declare a failure and return to pantasks
my $rnd = rand(1);
if ($rnd > 0.5) {
    warn ("random failure");
    &my_die ($exptag, $PS_EXIT_DATA_ERROR);
}
}

# Output results to the database
unless ($no_update) {
    my @command;
    push @command, $regtool, '-addprocessedexp', '-exp_tag', $exptag; # Command to execute to update exposure parameters
    
    # Add the values of interest
    foreach my $constant (@{CONSTANTS()}) {
        push @command, ( '-' . $constant ), $values{$constant};
    }
    foreach my $variable (@{VARIABLES()}) {
        my $array = $values{$variable};        # Array of values
        my $stats = Statistics::Descriptive::Sparse->new; # Statistics calculator
        $stats->add_data(@$array);
        push @command, ( '-' . $variable ), $stats->mean();
    }

    # Add the statistics
    {
        my $stats = Statistics::Descriptive::Sparse->new; # Statistics calculator
        $stats->add_data(@backgrounds);
        push @command, ( '-' . REGISTER_BG() ), $stats->mean();
        push @command, ( '-' . REGISTER_BG_MEAN_STDEV() ), ( $stats->standard_deviation() || 0 )
    }
    {
        my $stats = Statistics::Descriptive::Sparse->new; # Statistics calculator
        $stats->add_data(@variances);
        push @command, ( '-' . REGISTER_BG_STDEV() ), sqrt( $stats->mean() );
    }
    
    # Add the detrend flag
    foreach my $detrendType (@{DETRENDS()}) {
        if (lc($values{TYPE()}) =~ /$detrendType/) {
            push @command, DETREND_FLAG;
            last;
        }
    }
 
    # Quote arguments with whitespace
    for (my $i = 0; $i < scalar @command; $i++) {
        if ($command[$i] =~ /\s/) {
            $command[$i] = "\'$command[$i]\'";
        }
    }

    push @command, "-dbname", $dbname if defined $dbname;

    my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
        cache_run(command => \@command, verbose => 1);
    unless ($success) {
	$error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
        warn ("Unable to run regtool -addprocessedexp for $exptag: $error_code");
        exit($error_code);
    }
}

### Pau.

# Get the value for a particular imfile, along with a strong check for its existence
sub get_value {
    my $imfile = shift;                # The hash of values
    my $name = shift;                # The name of the value to check

    my $source = $imfile->{REGISTER_CLASSID()}; # Where it comes from

    unless (defined $imfile->{$name}) {
        warn ("Couldn't find value of $name for class_id=$source");
        &my_die ($exptag, $PS_EXIT_PROG_ERROR);
    }
    return $imfile->{$name};
}

sub cache_run
{
    my %p = @_;

    my $cmd_output = $c->get($p{command}) if $cache;
    if (defined $cmd_output) {
        return @{thaw $cmd_output};
    } else {
        my @output = run(%p);
        $c->set($p{command}, freeze \@output) if $cache;
        return @output;
    }
}

sub my_die
{
    my $exp_tag = $_[0];
    my $exit_code = $_[1];
    if ($exp_tag and not $no_update) {
	my $command = "$regtool -addprocessedexp -exp_tag $exp_tag -code $exit_code";
	$command .= " -dbname $dbname" if defined $dbname;
        system($command);
    }
    exit $exit_code;
}

END {
    my $exit = $?;
    system("sync") == 0 or die "failed to execute sync: $!";
    $? = $exit;
}
