#!/bin/env perl
###
### pstamprequest
###
###     Program to make a postage stamp request table for a set of coordinates
###

use warnings;
use strict;

use Getopt::Long qw( GetOptions ) ; # :config auto_help auto_version gnu_getopt );
use Pod::Usage qw( pod2usage );
use PS::IPP::Config qw( :standard );
use PS::IPP::PStamp::RequestFile qw( :standard );
use PS::IPP::PStamp::Job qw( :standard );
use File::Temp qw(tempfile);
use File::Basename qw(basename);
use IPC::Cmd 0.36 qw( can_run run );
use Carp;
use POSIX;

my $verbose;
my $save_temps;

# list file columns
# RA DEC FILTER MJD_MIN MJD_MAX

my ($ra, $dec, $x, $y, $list, $output, $req_name, $req_name_base);

my ($image, $mask, $variance, $cmf, $psf, $backmdl, $inverse);
my ($unconvolved, $use_imfile_id, $no_wait);

my $default_size = 100;
my $job_type     = 'stamp';
my $req_type     = 'bycoord';
my $stage        = 'chip';
my $option_mask;
my $width        = $default_size;
my $height       = $default_size;
my $project      = 'gpc1';
my $coord_mask;
my $pixcenter;
my $arcseconds;

my $id;
my $tess_id = 'null';
my $component = 'null';
my $data_group = 'null';
my $filter;
my $mjd_min = 0;
my $mjd_max = 0;
my $comment;

my $missing_tools;
my $pstamp_request_file  = can_run('pstamp_request_file')  or (warn "Can't find required program pstamp_request_file"  and $missing_tools = 1);

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

GetOptions(
    'list=s'            => \$list,          # list of coordinates if undef ra and dec or x and y are required
    'ra=s'              => \$ra,             # 
    'dec=s'             => \$dec,
    'x=s'               => \$x,
    'y=s'               => \$y,
    'width=i'           => \$width,
    'height=i'          => \$height,
    'pixcenter'         => \$pixcenter,
    'arcseconds'        => \$arcseconds,
    'coord_mask=i'      => \$coord_mask,
    'job_type=s'        => \$job_type,
    'output=s'          => \$output,
    'req_name=s'        => \$req_name,
    'req_name_base=s'   => \$req_name_base,
    'stage=s'           => \$stage,
    'project=s'         => \$project,
    'req_type=s'        => \$req_type,
    'id=s'              => \$id,
    'tess_id=s'         => \$tess_id,
    'component=s'       => \$component,
    'data_group=s'      => \$data_group,
    'filter=s'          => \$filter,
    'mjd_min=s'         => \$mjd_min,
    'mjd_max=s'         => \$mjd_max,
    'comment=s'         => \$comment,

    'option_mask=i'     => \$option_mask,
    'image'             => \$image,
    'mask'              => \$mask,
    'variance'          => \$variance,
    'cmf'               => \$cmf,
    'psf'               => \$psf,
    'backmdl'           => \$backmdl,
    'inverse'           => \$inverse,
    'unconvolved'       => \$unconvolved,
    'use_imfile_id'     => \$use_imfile_id,
    'do_not_wait'       => \$no_wait,

    'verbose'           => \$verbose,
    'save-temps'        => \$save_temps,
) or pod2usage(2);

pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV;

pod2usage( -msg => "Required options: --req_name | --req_name_base --stage ") 
    unless (defined $req_name or defined $req_name_base)
       and defined $stage;

pod2usage( -msg => "Invalid job_type: $job_type", -exitval =>1 )
        unless ($job_type eq 'stamp' or $job_type eq 'get_image');

if ($job_type eq 'stamp') {
    if (defined $list) {
        pod2usage( -msg => "--ra --dec --x --y are not used with --list", -exitval =>1 )
            if defined $x or defined $y;
    } elsif (!$pixcenter) {
        pod2usage( -msg => "Required options for stamp requests: --ra and --dec or --list", -exitval =>1 )
            unless (defined $ra and defined $dec);
        # to simplify code we just use $x and $y from here
        $x = $ra;
        $y = $dec;
    } else {
        pod2usage( -msg => "Required options for stamp requests: --x and --y or --list", -exitval =>1 )
                unless (defined $x and defined $y);
    }
} else {
    pod2usage( -msg => "req_type must be byid or byexp for get_image requests",
        -exitval =>1 ) unless $req_type eq 'byid' or $req_type eq 'byexp';
    $x  = 0;
    $y = 0;
}

if ($req_type eq 'byid') {
    pod2usage( -msg => "ID required for get_image requests", -exitval =>1 )
            if !defined $id;
    die("ID must be number for byid requests") if !validID($id);
} elsif ($req_type eq 'byexp') {
    pod2usage( -msg => "ID (exp_name) required for byexp requests", -exitval =>1 )
            if !defined $id;
} elsif ($req_type eq 'bydiff') {
    pod2usage( -msg => "ID (exp_name) required for bydiff requests", -exitval =>1 )
            if !defined $id;
} elsif ($req_type eq 'byskycell') {
    pod2usage( -msg => "tess_id and skycell_id required for byskycell requests", -exitval =>1 )
            if !(defined $tess_id and defined $component);
} elsif ($req_type ne 'bycoord') {
    pod2usage( -msg => "$req_type is not a valid req_type", -exitval =>1 );
}

$id = 0 if !$id;

unless ($stage eq 'raw' or $stage eq 'chip' or $stage eq 'warp' or $stage eq 'diff' or $stage eq 'stack') {
    die "$stage is not a valid value for stage\n";
}

checkFilter($filter, 'null', $filter)  if $filter;
checkMJD($mjd_min, 0, "") if $mjd_min;
checkMJD($mjd_max, 0, "" ) if $mjd_min;

# user supplied option mask takes precedence
if (!defined $option_mask) {
    $option_mask = 0;
    if ($job_type eq 'stamp') {
        $option_mask |= $PSTAMP_SELECT_IMAGE    if $image;
        $option_mask |= $PSTAMP_SELECT_MASK     if $mask;
        $option_mask |= $PSTAMP_SELECT_VARIANCE if $variance;
        $option_mask = $PSTAMP_SELECT_IMAGE    if $option_mask == 0;

        # if no image was requested make a stamp of the image

        $option_mask |= $PSTAMP_SELECT_CMF      if $cmf;
        $option_mask |= $PSTAMP_SELECT_PSF      if $psf;
        $option_mask |= $PSTAMP_SELECT_BACKMDL  if $backmdl;
        $option_mask |= $PSTAMP_SELECT_UNCONV   if $unconvolved;
        $option_mask |= $PSTAMP_USE_IMFILE_ID   if $use_imfile_id;
        $option_mask |= $PSTAMP_SELECT_INVERSE  if $inverse;
    }
    $option_mask |= $PSTAMP_NO_WAIT_FOR_UPDATE if $no_wait;
}


# user supplied coord_mask takes precedence
if (!defined $coord_mask) {
    $coord_mask = 0;
    if ($pixcenter) {
        $coord_mask |= $PSTAMP_CENTER_IN_PIXELS;
    }
    if (!$arcseconds) {
        $coord_mask |= $PSTAMP_RANGE_IN_PIXELS;
    }
}


# if req_name is not supplied use the current date and time to build one off of the base
if (!$req_name) {
    my $datestr = strftime "%Y%m%dT%H%M%S", gmtime;
    $req_name .= $req_name_base . $datestr;
}

# ok ready to go

my $rows;
if ($list) {
    $rows = readList($list);
} else {
    $rows = [];
    push @$rows, buildRow("", $comment, $x, $y, $filter, $mjd_min, $mjd_max);
}

my ($tdf, $table_def_name) = tempfile ("/tmp/tabledef.XXXX", UNLINK => !$save_temps);
print $tdf "$req_name 1\n";
my $rownum = 0;
foreach my $row (@$rows) {
    $rownum++;
    my $line = "$rownum $row->{ra}\t$row->{dec}\t$width $height"
        . " $coord_mask $job_type $option_mask $project $req_type"
        . " $stage $id $tess_id $component $data_group"
        . " $row->{filter} $row->{mjd_min} $row->{mjd_max}";

    if ($row->{comment} and $row->{comment} ne '') {
        $line .= " |$row->{comment}" ;
    } else {
        $line .= " |$comment" if $comment;
    }

    print "$line\n" if $verbose;
    print $tdf "$line\n";
}
close $tdf;

{
    my $command = "$pstamp_request_file --input $table_def_name --req_name $req_name";
    $command .= " --output $output" if $output;
    my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
        run(command => $command, verbose => 0);
    unless ($success) {
        print STDERR @$stderr_buf;
        exit $error_code >> 8;
    }
}

exit 0;

sub readList {
    my $file = shift;
    open IN, "<$file" or die "failed to open $file for input\n";

    my @rows;

    my $linenumber = 0;
    foreach my $line (<IN>) {
        $linenumber++;
        chomp $line;
        next if !$line;
        next if ($line =~ /^#/);

        my ($spec, $comment) = split /\|/, $line;
        $comment = '' if !defined $comment;

        my @vals = split " ", $spec;
        push @rows, buildRow("at line number $linenumber", $comment, @vals);
    }
    close IN;

    return \@rows;
}

sub buildRow {
    my $linenumber = shift;
    my $comment = shift;
    my @vals = @_;

    my $row = {};
    $row->{ra}      = checkRA($vals[0], $linenumber);
    $row->{dec}     = checkDEC($vals[1], $linenumber);
    $row->{filter}  = checkFilter($vals[2], $filter, $linenumber);
    $row->{mjd_min} = checkMJD($vals[3], $mjd_min, $linenumber);;
    $row->{mjd_max} = checkMJD($vals[4], $mjd_max, $linenumber);;
    $row->{comment} = $comment;

    return $row;
}

sub validNumber {
    my $val = shift;

    return 0 if !defined $val;

    return ($val =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/);
}

sub validID
{
    my $val = shift;

    return 0 if !$val;

    return  ! ($val =~ /\D/);
}

sub checkCoord {
    my $c          = shift;
    my $linenumber = shift;

    my $result;
    if ($c =~ /\:/) {
        # sexagesmial format not valid for pixel coordinates
        die "invalid coordinate value $c found $linenumber\n" if $pixcenter;

        my ($d, $m, $s) = split '\:', $c;
        die "invalid coordinate value $c found $linenumber\n" 
            unless validNumber($d) and validNumber($m) and validNumber($s);
        my $sign;
        if ($c =~ /^-/) {   # checking $d < 0 doesn't work for $d = -0
            $sign = -1;
            $d = -$d;
        } else {
            $sign = 1;
        }
        $result = $sign * ($d + ($m + $s/60.) /60.);
    } else {
        die "$c is not  valid coordinate value $linenumber\n" 
            unless validNumber($c);
        $result = $c;
    }
    return $result;
}

sub checkRA {
    my $ra = shift;
    my $linenumber = shift;
    my $checked = checkCoord($ra, $linenumber);

    if ($ra =~ /\:/) {
        return $checked * 360. / 24.;
    } else {
        return $checked;
    }
}

sub checkDEC {
    return checkCoord(@_);
}

sub checkFilter {
    my $f = shift;
    my $default = shift;
    my $linenumber = shift;

    $default = 'null' if !defined $default;

    $f = $default if (!defined$f or $f eq 'null');

    return $f;
}

sub checkMJD {
    my $mjd = shift;
    my $default = shift;
    my $linenumber = shift;;

    return $default if (!$mjd) ;

    die "invalid mjd value '$mjd' found $linenumber\n" if !validNumber($mjd);

    return $mjd;
}

sub checkStage {
    my $stage = shift;

}
