###
###     PStamp/Job.pm
###     subroutines and constants related to Postage Stamp Jobs
###

package PS::IPP::PStamp::Job;

use strict;
use warnings;

our $VERSION = '1.0';

use base qw( Exporter );

our @EXPORT_OK = qw( 
                    locate_images
                    resolve_project
                    getCamRunByCamID
                    );
our %EXPORT_TAGS = (standard => [@EXPORT_OK]);


use PS::IPP::PStamp::RequestFile qw( :standard );

use IPC::Cmd 0.36 qw( can_run run );
use PS::IPP::Metadata::List qw( parse_md_list );
use PS::IPP::Config qw( :standard );
use Carp;
use DateTime;
use File::Temp qw(tempfile);
use File::Basename;
use POSIX;

my $dvo_verbose = 0;
my $save_temps = 0;

# caches of camProcessedExp objects. 
# Key is $exp_id
my %camRunByExpIDCache;
# Key is $cam_id
my %camRunByCamIDCache;

# cache of last project looked up
my $last_project = "";

my ($regtool, $chiptool, $camtool, $warptool, $stacktool, $difftool);
my ($pstamptool, $dvoImagesAtCoords, $whichimage, $ppConfigDump);

sub locate_images {
    my $ipprc    = shift;   # required
    my $imagedb = shift;   # required
    my $rowList  = shift;   # required
    my $req_type = shift;   # required
    my $img_type = shift;   # required
    my $id       = shift;   # required unless req_type eq bycoord or byskycell
    my $tess_id  = shift;
    my $component= shift;   # class_id or skycell_id
    my $option_mask  = shift;
    my $need_magic = shift;
    my $mjd_min  = shift;
    my $mjd_max  = shift;
    my $filter   = shift;
    my $data_group = shift;
    my $verbose  = shift;

    # we die in response to bad data in request files
    # The caller is responsible for updating the database
    # pstampparse.pl error checks now so this shouldn't happen
    &my_die("Unknown req_type: $req_type", $PS_EXIT_PROG_ERROR) 
        if ($req_type ne "byid") and
           ($req_type ne "byexp") and 
           ($req_type ne "bycoord") and 
           ($req_type ne "bydiff") and 
           ($req_type ne "byskycell");


    my $dateobs_begin;
    my $dateobs_end;
    if (!iszero($mjd_min)) {
        $dateobs_begin = mjd_to_dateobs($mjd_min);
    }
    if (!iszero($mjd_max)) {
        $dateobs_end = mjd_to_dateobs($mjd_max);
    }
    if (isnull($tess_id)) {
        $tess_id = undef;
    }
    if (isnull($data_group)) {
        $data_group = undef;
    }
    if (isnull($filter)) {
        $filter = undef;
    }

    if ($req_type eq "bycoord") {
        my $num_rows = scalar @$rowList;
        die "Unexpected number of rows found in rowList: $num_rows" if $num_rows != 1;
        my $row = $rowList->[0];
        my $x = $row->{CENTER_X};
        my $y = $row->{CENTER_Y};
        my $results = lookup_bycoord($ipprc, $rowList, $imagedb, $img_type, $tess_id, $component, $need_magic, $x, $y, $dateobs_begin, $dateobs_end, $filter, $data_group, $option_mask, $verbose);
        return $results;
    }

    if (($req_type eq "byid") and ($img_type eq "diff")) {
        # lookups of all of the information for diff images requires a two level lookup to
        # get the exposure information. Switching the req_type allows us to keep that code
        # in one place
        $req_type = "bydiff";
        my $results = lookup_diff($ipprc, $rowList, $imagedb, $id, $component, 1, $option_mask, $img_type, $verbose);
        return $results;
    }

    if ($req_type eq "bydiff") {
        # for bydiff reuqests we go look up the diffRun to obtain exp_id, chip_id, warp_id, stack_id, or 
        # the image from the diffRun
        my $results = lookup_diff($ipprc, $rowList, $imagedb, $id, $component, 0, $option_mask, $img_type, $verbose);
        if (!$results) {
            return undef;
        }
        if ($img_type eq "diff") {
            # lookup_diff has done all of the work
            return $results;
        } 

        my $image = $results->[0];
        if ($img_type eq "raw") {
            $req_type = "byid";
            $id = $image->{exp_id};
            return undef if !$id;
            # fall through and lookup byid
        } elsif ($img_type eq "chip") {
            $req_type = "byid";
            $id = $image->{chip_id};
            return undef if !$id;
            # fall through and lookup byid
        } elsif ($img_type eq "warp") {
            $req_type = "byid";
            $id = $image->{warp_id};
            $component = $image->{skycell_id};
            return undef if !$id;
            # fall through and lookup by warp_id
        } elsif ($img_type eq "stack") {
            $req_type = "byid";
            $id = $image->{stack_id};
            return undef if !$id;
            # fall though and lookup by stack_id
        } else {
            # This is checked this elsewhere?
            print STDERR "Error: $img_type is an unknown image type\n";
            return undef;
        }
    } elsif ($req_type eq "byskycell") {
        if (($img_type eq "raw") or ($img_type eq "chip")) {
            print STDERR "REQ_TYPE byskycell not supported for IMG_TYPE raw or chip\n";
            return undef;
        }
        if (!$tess_id or !$component) {
            print STDERR "component and tess_id are required for REQ_TYPE byskycell\n";
            return undef;
        }
    }

    my $results = lookup($ipprc, $rowList, $imagedb, $req_type, $img_type, $id, $tess_id, $component,
        $need_magic, $dateobs_begin, $dateobs_end, $filter, $data_group, $option_mask, $verbose);

    return $results;
}

# The subroutine lookup handles byexp, byid, and byskycell lookups including lookups that are
# triggered by a bydiff request

sub lookup
{
    my $ipprc    = shift;
    my $rowList    = shift;
    my $imagedb = shift;
    my $req_type = shift;
    my $stage = shift;
    my $id       = shift;
    my $tess_id  = shift;
    my $component= shift;
    my $need_magic = shift;
    my $dateobs_begin = shift;
    my $dateobs_end   = shift;
    my $filter = shift;
    my $data_group = shift;
    my $option_mask = shift;
    my $verbose  = shift;

    my $inverse = $option_mask & $PSTAMP_SELECT_INVERSE;
    my $unconvolved = $option_mask & $PSTAMP_SELECT_UNCONV;
    my $use_imfile_id = ($req_type eq "byid") && ($option_mask & $PSTAMP_USE_IMFILE_ID);

    my $command;
    my $id_opt;     # option for the lookup
    my $image_name;
    my $mask_name;
    my $weight_name;
    my $cmf_name;
    my $psf_name;
    my $backmdl_name;
    my $base_name;
    my $want_astrom;
    my $set_class_id;
    my $class_id;
    my $skycell_id;

    if (isnull($component)) {
        $component = undef;
    }

    # note $magic_arg may be cleared below depending on $req_type
    my $magic_arg = $need_magic ? " -destreaked" : "";

    # all rows have the same center type
    my $skycenter = ! ($rowList->[0]->{COORD_MASK} & $PSTAMP_CENTER_IN_PIXELS);

    my $component_args;
    my $choose_components = 0;
    if ($stage eq "raw") {
        $class_id = $component;
        $command = "$regtool -processedimfile -dbname $imagedb";
        # XXX: for now restrict lookups to type object 
        # are stamps of detrend exposures interesting?
        $command .= " -exp_type object";
        $id_opt = $use_imfile_id ? "-raw_imfile_id" : "-exp_id";
        $component_args = " -class_id $class_id" if $component;
        $want_astrom = 1;
        $set_class_id = 1;
    } elsif ($stage eq "chip") {
        $class_id = $component;
        # if the request is such that it will yield a single image per "run" or the
        # center is specified in pixel coordinates 
        # use chiptool -processsedimfile. Otherwise use chiptool -listrun and then
        # choose the chips containing the center pixel by calling selectComponets() below
        if ($class_id or $use_imfile_id or !$skycenter) {
            $command = "$chiptool -processedimfile -dbname $imagedb";
            $component_args = " -class_id $class_id" if $class_id;
        } else {
            $command = "$chiptool -listrun -pstamp_order -dbname $imagedb";
            $choose_components = 1;
        }
        $id_opt = $use_imfile_id ? "-chip_imfile_id" : "-chip_id";
        # XXX: perhaps we should stop resolving images to this level here and do it at job run time.
        # With the mdc file it has all of the information that it needs.
        $image_name   = "PPIMAGE.CHIP";
        $mask_name    = "PPIMAGE.CHIP.MASK";
        $weight_name  = "PPIMAGE.CHIP.VARIANCE";
        $cmf_name     = "PSPHOT.OUTPUT";
        $psf_name     = "PSPHOT.PSF.SAVE";
        $backmdl_name = "PSPHOT.BACKMDL";
        $base_name    = "path_base"; # name of the field for the chiptool output
        $want_astrom  = 1;
        $set_class_id = 1;
    } elsif ($stage eq "warp") {
        $skycell_id = $component;
        if ($skycell_id or $use_imfile_id or !$skycenter) {
            $command = "$warptool -warped -dbname $imagedb";
            $component_args = " -skycell_id $skycell_id" if $skycell_id;
        } else {
            $command = "$warptool -listrun -pstamp_order -dbname $imagedb";
            $choose_components = 1;
        }
        $id_opt = $use_imfile_id ? "-warp_skyfile_id" : "-warp_id";
        $image_name   = "PSWARP.OUTPUT";
        $mask_name    = "PSWARP.OUTPUT.MASK";
        $weight_name  = "PSWARP.OUTPUT.VARIANCE";
        $cmf_name     = "PSWARP.OUTPUT.SOURCES";
        $psf_name     = "PSPHOT.PSF.SKY.SAVE";
        $base_name    = "path_base"; # name of the field for the warptool output
    } elsif ($stage eq "diff") {
        $skycell_id = $component;
        if ($skycell_id or $use_imfile_id or !$skycenter) {
            $command = "$difftool -diffskyfile -dbname $imagedb";
            $component_args = " -skycell_id $skycell_id" if $skycell_id;
        } else {
            $command = "$difftool -listrun -pstamp_order -dbname $imagedb";
            $choose_components = 1;
        }
        $id_opt = $use_imfile_id ? "-diff_skyfile_id" : "-diff_id";
        $image_name  = "PPSUB.OUTPUT";
        $mask_name   = "PPSUB.OUTPUT.MASK";
        $weight_name = "PPSUB.OUTPUT.VARIANCE";
        $cmf_name    = "PPSUB.OUTPUT.SOURCES";
        $psf_name     = "PSPHOT.PSF.SKY.SAVE";
        $base_name   = "path_base";
    } elsif ($stage eq "stack") {
        $skycell_id = $component;
        $command = "$stacktool -sumskyfile -dbname $imagedb";
        $id_opt = "-stack_id";
        $component_args = " -skycell_id $skycell_id" if $skycell_id;

        if (!$unconvolved) {
            $image_name  = "PPSTACK.OUTPUT";
            $mask_name   = "PPSTACK.OUTPUT.MASK";
            $weight_name = "PPSTACK.OUTPUT.VARIANCE";
        } else {
            $image_name  = "PPSTACK.UNCONV";
            $mask_name   = "PPSTACK.UNCONV.MASK";
            $weight_name = "PPSTACK.UNCONV.VARIANCE";
        }
        # this is wrong but gets the right answer. Need to figure out how to find the
        # rule properly
        #$cmf_name    = "PSPHOT.OUTPUT";    # this puts .fpa. in the name
        $cmf_name     = "PSWARP.OUTPUT.SOURCES";
        $psf_name    = "PPSTACK.TARGET.PSF";
        $base_name   = "path_base";
    } else {
        die "Unknown IMG_TYPe supplied: $stage";
    }

    my $filter_runs = 0;
    if ($req_type eq "byid") {
        $command .= " $id_opt $id";
        $command .= $component_args if $component_args;
        # don't include -destreaked if lookup is byid. Let pstampparse check so that the
        # error code returned to the client for a given component is 'not destreaked'
        # instead of 'not found'
        $magic_arg = "";
    } elsif ($req_type eq "byexp") {
        $command .= " -exp_name $id";
        $command .= $component_args if $component_args;
        # don't include -destreaked if lookup is byexp. Let pstampparse check so that the error code gives
        # the reason as 'not destreaked'
        $magic_arg = "";
        # remove duplicate runs for the same exposure.
        $filter_runs = 1;
    } elsif ($req_type eq "byskycell") {
        die "tess_id and component are required for byskycell" if !$tess_id or ! $skycell_id;
        $command .= " -tess_id $tess_id -skycell_id $skycell_id";
    } else {
        # this should be caught by caller
        &my_die("Unexpected req_type supplied: $req_type", $PS_EXIT_PROG_ERROR);
    }

    if ($stage ne "stack") {
        $command .= $magic_arg;
        $command .= " -dateobs_begin $dateobs_begin" if $dateobs_begin;
        $command .= " -dateobs_end $dateobs_end" if $dateobs_end;
    }

    $command .= " -filter $filter" if !isnull($filter);
    $command .= " -data_group $data_group" if !isnull($data_group);

    my $images = runToolAndParse($command, $verbose);

    if (!$images or scalar @$images == 0) {
        return undef;
    }

    if ($filter_runs) {
        # The image selectors are such that multiple runs my have be returned for the same exposure.
        # Return only the latest one.
        $images = filterRuns($stage, $need_magic, $images, $verbose);
    }
    if ($choose_components) {
        # the list of "images" is actually a list of "Runs"
        # match the coords in the rows to the components in the runs
        # returns an actual list of images
        $images = selectComponents($ipprc, $imagedb, $req_type, $stage, $rowList, $images, $verbose);
    } else {
        # put each of the rows into all of the the images
        setRowRefs($rowList, $images);
    }

    my $camera;
    my $output = [];
    foreach my $image (@$images) {
        my $base;

        next if $image->{fault};
        next if ($stage ne "raw") and $image->{quality};

        if ($base_name) {
            $base = $image->{$base_name};
            # if base is undef then the output pruducts for this image are incomplete
            # This may only happen for warps. (Actually the test for ignored that I added
            # just above probably solved the problem I was trying to solve with this test)
            next if !$base;
        } else {
            # raw images don't have path_base yet. Manufacture one
            my $uri = $image->{uri};
            my $path_base = $uri =~ s/\.fits//g;
            $image->{$path_base} = $path_base;
        }
        if (!$camera) {
            # This assumes that all images have the same camera
            $camera = $image->{camera};
            $ipprc->define_camera($camera);
        }
        my $out = $image;

        # if uri is nil this will get overridded below
        # (we do this here for raw stage)
        $out->{image}  = $image->{uri};

        if ($set_class_id) {
            $class_id = $image->{class_id};
            $out->{component} = $class_id;
        } else {
            $out->{component} = $image->{skycell_id};
        }
        my $stage_id;
        if ($stage eq "raw") {
            $stage_id = $image->{exp_id};
        } elsif ($stage eq "chip") {
            $stage_id = $image->{chip_id};
        } elsif ($stage eq "warp") {
            $stage_id = $image->{warp_id};
        } elsif ($stage eq "diff") {
            $stage_id = $image->{diff_id};
            if ($inverse && $image->{bothways}) {
                $image_name  = "PPSUB.INVERSE";
                $mask_name   = "PPSUB.INVERSE.MASK";
                $weight_name = "PPSUB.INVERSE.VARIANCE";
                $cmf_name    = "PPSUB.INVERSE.SOURCES";
            }
        } elsif ($stage eq "stack") {
            $stage_id = $image->{stack_id};
        }
        $out->{stage_id} = $stage_id;
        $out->{stage}    = $stage;
        $out->{imagedb} = $imagedb;

        if ($base) {
            $out->{image}  = $ipprc->filename($image_name,  $base, $class_id) if $image_name;
            $out->{mask}   = $ipprc->filename($mask_name,   $base, $class_id) if $mask_name;
            $out->{weight} = $ipprc->filename($weight_name, $base, $class_id) if $weight_name;
            $out->{cmf}    = $ipprc->filename($cmf_name, $base, $class_id) if $cmf_name;
            $out->{psf}    = $ipprc->filename($psf_name, $base, $class_id) if $psf_name;
            $out->{backmdl}= $ipprc->filename($backmdl_name, $base, $class_id) if $backmdl_name;
        }
        if ($want_astrom and ! defined $out->{astrom}) {
            $out->{astrom} = find_astrometry($ipprc, $imagedb, $image, $verbose);
        }

        push @$output, $out;
    }

    return $output;
}

sub lookup_diff {
    my $ipprc    = shift;
    my $rowList  = shift;
    my $imagedb = shift;
    my $id       = shift;
    my $skycell_id = shift;
    my $byid     = shift;
    my $option_mask  = shift;
    my $img_type = shift;
    my $verbose = shift;

    my $inverse = $option_mask & $PSTAMP_SELECT_INVERSE;

    my $command = "$difftool -dbname $imagedb";
    
    if ($byid) {
        $command .= " -listrun -diff_id $id";
    } else {
        $command .= " -diffskyfile -diff_skyfile_id $id";
    }
    $command .= " -skycell_id $skycell_id" if $skycell_id;

    my $output = runToolAndParse($command, $verbose);

    my $n = @$output;
    if (!$byid && ($n > 1)) {
        die ("difftool returned an unexpected number of diffskyfiles: $n");
    } elsif ($n == 0) {
        return undef;
    }

    my $images;
    if ($byid) {
        $images = selectComponents($ipprc, $imagedb, 'byid', 'diff', $rowList, $output, $verbose);
    } else {
        $images = $output;
    }

    my @results;
    foreach my $image (@$images) {
        my $skycell_id = $image->{skycell_id};

        if ($image->{fault}) {
            print STDERR "selected difference image $id $image->{diff_id} $skycell_id has fault: $image->{fault}\n";
            next;
        }

        # The standard way to do a diff is warp - stack 
        # so we interpret the requested image in that way

        # XXX difftool currently returns max long long for null
        # these checks are ready if we switch the code to return zero for null
        my $stack1 = $image->{stack1};
        if (($stack1 == 0) or ($stack1 == 9223372036854775807)) {
            $stack1 = undef
        }
        my $stack2 = $image->{stack2};
        if (($stack2 == 0) or ($stack2 == 9223372036854775807)) {
            $stack2 = undef
        }
        my $stack_id;
        if ($stack1 and $stack2) {
            # we have a stack - stack diff (well it might be stack - warp....)
            # but at any rate we only handle image type diff and stack
            if (($img_type ne "diff") and ($img_type ne "stack")) {
                print STDERR "lookup_diff: cannot lookup IMG_TYPE $img_type bydiff from a stack stack diff run\n";
                next;
            }
            # stack-stack diff
            # XXX: define another flag for this
            if (! $inverse) {
                $stack_id = $stack1;
            } else {
                $stack_id = $stack2;
            }
            $image->{stack_id} = $stack_id;
        } else {
            my ($warp_id, $exp_id, $exp_name, $chip_id, $cam_id);
            if ($inverse and !$image->{bothways}) {
                print STDERR "Inverse images requested for diffRun that is not bothways. Ignoring inverse.\n";
                $inverse = 0;
            }
            if ($inverse) {
                $warp_id =  $image->{warp2};
                $exp_id = $image->{exp_id_2};
                $exp_name = $image->{exp_name_2};
                $chip_id = $image->{chip_id_2};
                $cam_id = $image->{cam_id_2};
            } else {
                $warp_id =  $image->{warp1};
                $exp_id = $image->{exp_id_1};
                $exp_name = $image->{exp_name_1};
                $chip_id = $image->{chip_id_1};
                $cam_id = $image->{cam_id_1};
            }
            # XXX difftool currently returns max long long for null
            # this line is ready if we switch the code to return zero for null
            if ($warp_id and ($warp_id != 9223372036854775807)) {
                $image->{warp_id} = $warp_id;
                $image->{exp_id} = $exp_id;
                $image->{exp_name} = $exp_name;
                $image->{chip_id} = $chip_id;
                $image->{cam_id} = $cam_id;
            }
        }

        # XXX: If difftool doesn't return a camera insert it here
        if (!$image->{camera}) {
            $image->{camera} = "GPC1";
            # lie about the magicked status since stack stack diffs don't require destreaking
            # we can remove this once diff_mode gets included
            $image->{magicked} = 42;
        }

        if ($img_type eq "diff") {
            my @imageList = ($image);

            setRowRefs($rowList, \@imageList);
            # the $image is going to be returned directly in this case so we need to duplicate
            # some of processing that lookup does for other img_types
            if ($image->{camera}) {
                $ipprc->define_camera($image->{camera});
                my $filerule_base = $inverse ? "PPSUB.INVERSE" : "PPSUB.OUTPUT";
                $image->{image}  = $ipprc->filename($filerule_base, $image->{path_base});
                $image->{mask}   = $ipprc->filename($filerule_base . ".MASK", $image->{path_base});
                $image->{weight} = $ipprc->filename($filerule_base . ".VARIANCE", $image->{path_base});
                $image->{cmf}    = $ipprc->filename($filerule_base . ".SOURCES", $image->{path_base});
                $image->{psf}    = $ipprc->filename("PSPHOT.PSF.SKY.SAVE", $image->{path_base});
                $image->{stage_id} = $image->{diff_id};
                $image->{stage}    = "diff";
                $image->{imagedb} = $imagedb;
                $image->{component} = $image->{skycell_id};
            } else {
                # XXX this will only happen if the minuend is not a warp. See hack above
                print STDERR "WARNING: cannot resolve camera so cannot get resolve file rules\n";
                next;
            }
        }
        push @results, $image;
    }
    return \@results;
}

sub lookup_bycoord {
    my $ipprc      = shift;
    my $rowList    = shift;
    my $imagedb    = shift;
    my $img_type   = shift;
    my $tess_id    = shift;
    my $component  = shift;
    my $need_magic = shift;
    my $ra         = shift;
    my $dec        = shift;
    my $dateobs_begin  = shift;
    my $dateobs_end    = shift;
    my $filter     = shift;
    my $data_group = shift;
    my $option_mask = shift;
    my $verbose    = shift;

    my $results = ();
    if (($img_type eq "raw") or ($img_type eq "chip")) {

        my $runs = lookup_runs_by_cam_id_and_coords($ipprc, $imagedb, $img_type,
            $ra, $dec, $need_magic, $dateobs_begin, $dateobs_end, $filter, $data_group, $verbose);

        # lookup is going to filter these we don't need to do it here
#        $runs = filterRuns($img_type, $need_magic, $runs, $verbose);
        foreach my $run (@$runs) {
            next if $component and ($run->{component} ne $component);
            my $these_results = lookup($ipprc, $rowList, $imagedb, "byid", $img_type, $run->{id},
                $tess_id, $run->{component}, $need_magic, 
                $dateobs_begin, $dateobs_end, $filter, $data_group, $option_mask, $verbose);

            next if !$these_results;
            push @$results, @$these_results;
        }
        
    } else {
        # this should be checked elsewhere
        die "unexpected image type $img_type" if ($img_type ne "warp") 
                                              and ($img_type ne "stack") and ($img_type ne "diff");

        my $skycells = lookup_skycell_by_coords($ipprc, $tess_id, $component, $ra, $dec, $verbose);

        foreach my $skycell (@$skycells) {
            my $these_results = lookup($ipprc, $rowList, $imagedb, "byskycell", $img_type, undef,
                $skycell->{tess_id}, $skycell->{component}, $need_magic, 
                $dateobs_begin, $dateobs_end, $filter, $data_group, $option_mask, $verbose);

            next if !$these_results;
            push @$results, @$these_results;
        }
    }

    return $results;
}

# lookup_runs_by_cam_id_and_coords
# given an ra, dec, and optionally other paramters, find camera runs for exposures
# that are within some distance of the coordinates
sub lookup_runs_by_cam_id_and_coords {
    my $ipprc      = shift;
    my $imagedb   = shift;
    my $img_type   = shift;
    my $ra         = shift;
    my $dec        = shift;
    my $need_magic = shift;
    my $dateobs_begin  = shift;
    my $dateobs_end = shift;
    my $filter     = shift;
    my $data_group = shift;
    my $verbose    = shift;

    my $camruns;

    {
        my $command = "$camtool -dbname $imagedb -processedexp -pstamp_order";
           $command .= " -ra $ra -decl $dec -radius 1.6";
           $command .= " -dateobs_begin $dateobs_begin" if $dateobs_begin;
           $command .= " -dateobs_end   $dateobs_end"   if $dateobs_end  ;
           $command .= " -filter $filter" if $filter;
           # NOTE: we are applying the data_group to the camera run.
           # If we're looking for chip stage images there is no guarentee that 
           # chipRun.data_group = camRun.data_group. In practice this is almost
           # always the case. If this turns out to be a problem we can defer
           # the data_group test to when we look up the chipProcessedImfiles
           $command .= " -data_group $data_group" if $data_group;
           $command .= " -destreaked" if $need_magic;

        # run the tool and parse the output
        $camruns = runToolAndParse($command, $verbose);
    }
    if (!$camruns) {
        return undef;
    }
    my $runs;
    my $last_exp_id = 0;
    foreach my $camRun (@$camruns) {
        my $cam_id = $camRun->{cam_id};
        my $exp_id = $camRun->{exp_id};

        next if $exp_id eq $last_exp_id;

        next if $camRun->{quality};
        next if $camRun->{fault};

        updateCamRunCache($camRun);

        $last_exp_id = $exp_id;

        # XXX Use file rule
        my $astrom = $camRun->{path_base} . ".smf";
        my $astrom_resolved = $ipprc->file_resolve($astrom);
        next if !$astrom_resolved;

        my $start_dvo = DateTime->now->mjd;
        my $command = "$dvoImagesAtCoords -astrom $astrom_resolved $ra $dec";
        # run the tool and parse the output
        my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
                    run(command => $command, verbose => $dvo_verbose);
        my $dtime_dvo = (DateTime->now->mjd - $start_dvo)* 86400.;
#        print "Time to run dvoImagesAtCoords: $dtime_dvo\n";
        unless ($success) {
            my $result_code = $error_code >> 8;
            if ($result_code == $PSTAMP_NO_OVERLAP) {
                print "no overlap for $astrom\n" if $verbose;
                next;
            }
            # unexpected result code
            die "unexpected result code: $result_code from $command\n";
        }

        my $output = join "", @$stdout_buf;
        if (!$output) {
            # this shouldn't happen when dvoImagesAtCoord exits with zero status
            die "no output returned from $command\n";
        }

        # dvoImagesAtCoords should return a single line
        # rownum ra dec class_id
        my @lines = split "\n", $output;
        my $n = scalar @lines;
        if ($n != 1) {
            print STDERR "unexpected number of lines returned by dvoImagesAtCoords: $n\n";

            # XXX: There is a bug in dvo where each component is listed twice
            # When that gets fixed remove the conditional and just die
            die "unexpected number lines returned by dvoImagesAtCoords: $n"
                if ($n != 2) or ($lines[0] ne $lines[1]);
        }

        my (undef, $ra_out, $dec_out, $class_id) = split " ", $lines[0];
        if (!$class_id) {
            die "unexpected output from dvoImagesAtCoords: $lines[0]";
        }

        print "cam_id $cam_id exp_id $camRun->{exp_id} chip_id $camRun->{chip_id} $class_id\n";

        # build the hash to return
        my $run = {
            exp_id    => $camRun->{exp_id},
            exp_name  => $camRun->{exp_name},
            chip_id   => $camRun->{chip_id},
            cam_id    => $camRun->{cam_id},
            astrom    => $astrom_resolved,
            class_id  => $class_id,
            component => $class_id
        };
        if ($img_type eq "chip") {
            $run->{id} = $camRun->{chip_id};
            $run->{state} = $camRun->{chip_state};
            $run->{magicked} = $camRun->{chip_magicked};
        } else {
            $run->{id} = $camRun->{exp_id};
            $run->{state} = 'full';
            $run->{magicked} = $camRun->{raw_magicked};
        }
        push @$runs, $run;
    }

    return $runs;
}

sub lookup_skycell_by_coords {
    my $ipprc      = shift;
    my $requested_tess_id    = shift;
    my $requested_skycell  = shift;
    my $ra         = shift;
    my $dec        = shift;
    my $verbose    = shift;

    $requested_tess_id = "" if isnull($requested_tess_id);
    $requested_skycell = "" if isnull($requested_skycell);

    my @lines;
    {
        my $command = "$whichimage $ra $dec";
        my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
                    run(command => $command, verbose => $verbose);
        unless ($success) {
            print STDERR @$stderr_buf;
            return undef;
        }

        my $output = join "", @$stdout_buf;
        if (!$output) {
            print STDERR "no output returned from $command\n" if $verbose;
            return undef;
        }
        @lines = split "\n", $output;
        if (!scalar @lines) {
            # can this happen? if $output is not null?
            print STDERR "no output returned from $command\n" if $verbose;
            return undef;
        }
    }
    my $runs;
    foreach my $line (@lines) {
        my ($ra_out, $dec_out, $tess_id, $skycell_id) = split " ", $line;
        die "unexpected output from whichimage" if !$tess_id or !$skycell_id;

        if ($requested_tess_id) {
            next if ($requested_tess_id ne $tess_id);
        } else {
            # skip these obsolete tesselations unless they were explicitly asked for
            # should I do this?
            next if $tess_id eq "FIXNS";
            next if $tess_id eq "ALLSKY";
        }
        next if $requested_skycell and ($skycell_id ne $requested_skycell);

        # build the hash to return
        my $run = {
            tess_id   => $tess_id,
            component => $skycell_id,
        };
        push @$runs, $run;
    }

    return $runs;
}

# cache of results of ppConfigDump
my %astromSources;
my $last_exp_id = 0;
my $lastAstromFile;

# find the astrometry file for a given exposure
# return undef if no completed camRun exists
sub find_astrometry {
    my $ipprc = shift;
    my $imagedb = shift;
    my $image = shift;      # hashref to output of the lookup tool
    my $verbose = shift;

    my $mdcParser;

    my $exp_id = $image->{exp_id};
    if (($exp_id eq $last_exp_id) and $lastAstromFile) {
        # running camtool 60 times is really expensive when the answer is the same every time
        return $lastAstromFile;
    }
    $last_exp_id = 0;
    $lastAstromFile = undef;

    my $camRun = getCamRunByExpID($exp_id);
    if (!$camRun) {
        my $command = "$camtool -dbname $imagedb -processedexp -exp_id $exp_id -pstamp_order";
        # run the tool and parse the output
        my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
                    run(command => $command, verbose => $verbose);
        unless ($success) {
            print STDERR @$stderr_buf;
            return undef;
        }

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

        my $output = join "", @$stdout_buf;
        if (!$output) {
            print STDERR "no output returned from $command\n" if $verbose;
            return undef;
        }
        my $camruns = parse_md_fast($mdcParser, $output);
        if (!$camruns) {
            return undef;
        }

        # If there are multiple cam runs for this exposure, take the last completed one with good quality
        # on the assumption that it has the best astrometry.
        foreach $camRun (@$camruns) {
            last if (($camRun->{state} eq 'full') and ($camRun->{quality} eq 0) and ($camRun->{fault} eq 0));
        }
        # XXX: this looks like a bug at least if ASTROM.SOURCE eq PSASTRO.OUTPUT
        if (!$camRun) {
            # no cam runs for this exposure id therefore best astrometry is whatever is in the header
            return undef;
        }
        updateCamRunCache($camRun);
    }
    my $camRoot = $camRun->{path_base};
    my $camera = $image->{camera};
    my $astromSource = $astromSources{$camera};
    if (!$astromSource) {
        if ($camera eq "GPC1") {
            # CHEATER !
            $astromSource = "PSASTRO.OUTPUT";
        } else {
            my $command = "$ppConfigDump -camera $camera -dump-recipe PSWARP -";
            my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
                run(command => $command, verbose => $verbose);
            unless ($success) {
                $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
                die("Unable to perform ppConfigDump: $error_code");
            }
            $mdcParser = PS::IPP::Metadata::Config->new if !$mdcParser; # Parser for metadata config files
            my $metadata = $mdcParser->parse(join "", @$stdout_buf) or
                die("Unable to parse metadata config doc");
            $astromSource = metadataLookupStr($metadata, 'ASTROM.SOURCE');
        }
        $astromSources{$camera} = $astromSource;
    }

    # XXX: Is this code correct if ASTROM.SOURCE ne "PSASTRO.OUTPUT"
    my $astromFile = $ipprc->filename($astromSource, $camRoot);
    if ($astromFile) {
        $lastAstromFile = $astromFile;
        $last_exp_id = $exp_id;
    }

    return $astromFile;
}

# splits meta data config input stream into single units to work around the pathalogically
# slow parser. This is similar to and adapted from code in various ippScripts.
sub parse_md_fast {
    my $mdcParser = shift;
    my $input = shift;
    my $output = ();

    my @whole = split /\n/, $input;
    my @single = ();

    my $n;
    while ( ($n = @whole) > 0) {
        my $value = shift @whole;
        push @single, $value;
        if ($value =~ /^\s*END\s*$/) {
	    push @single, "\n";

            my $list = parse_md_list( $mdcParser->parse( join("\n", @single ) ) ) or
                print STDERR "Unable to parse metdata config doc" and return undef;
#            my $num = @$list;
#            print STDERR "list has $num elments\n";
            push @$output, $list->[0];

            @single = ();
        }
    }
    return $output;
}

sub mjd_to_dateobs {
    my $mjd = shift;

    my $ticks = ($mjd - 40587.0) * 86400;

    my ($sec, $min, $hr, $day, $mon, $year) = gmtime($ticks);

    return sprintf "'%4d-%02d-%02dT%02d:%02d:%02dZ'", $year+1900, $mon+1, $day, $hr, $min, $sec;
}

sub isnull {
    my $val = shift;

    return (!defined($val) or ($val eq "") or (lc($val) eq "null"));
}

sub iszero {
    my $val = shift;
    return (!defined($val) or ($val == 0));
}

# resolve_project()
# get project specific information
sub resolve_project {
    my $ipprc = shift;
    my $project_name = shift;

    findTools();

    if (!$project_name) {
        carp ("project is not defined");
        return undef;
    }

    if ($last_project and ($project_name eq ($last_project->{name}))) {
        return $last_project;
    }

    my $dbname = shift;
    my $dbserver = shift;

    my $verbose = 0;

    my $command = "$pstamptool -project -name $project_name";
    $command .= " -dbname $dbname" if defined $dbname;
    $command .= " -dbserver $dbserver" if defined $dbserver;

    my $proj_hash = runToolAndParse($command, $verbose);
    if (!$proj_hash or scalar @$proj_hash == 0) {
        print STDERR "Project $project_name not found\n";
        return undef;
    }

    $last_project = $proj_hash->[0];

    return $last_project;
}

sub updateCamRunCache {
    my $camRun = shift;
    die "updateCamRunCache: camRun is nil" if !$camRun;

    my $exp_id = $camRun->{exp_id};
    die "updateCamRunCache: exp_id is nil" if !$exp_id;

    my $cam_id = $camRun->{cam_id};
    die "updateCamRunCache: cam_id is nil" if !$cam_id;

    $camRunByCamIDCache{$cam_id} = $camRun;

    # if this camRun is newer than previous update the cache.
    # This assumes that the newest has the "best" astrometry
    my $previous = $camRunByExpIDCache{$exp_id};
    if ($previous) {
        my $previous_cam_id = $previous->{cam_id};
        return if $cam_id < $previous_cam_id;
    }

    $camRunByExpIDCache{$exp_id} = $camRun;
}

sub getCamRunByExpID {
    my $exp_id = shift;
    &my_die ("getCamRun: exp_id is nil", $PS_EXIT_PROG_ERROR) if !$exp_id;

    return $camRunByExpIDCache{$exp_id};
}

sub getCamRunByCamID {
    my $cam_id = shift;
    &my_die ("getCamRun: cam_id is nil", $PS_EXIT_PROG_ERROR) if !$cam_id;

    return $camRunByCamIDCache{$cam_id};
}

sub selectComponents {
    my $ipprc = shift;
    my $imagedb = shift;
    my $req_type = shift;
    my $stage  = shift;
    my $rowList = shift;
    my $runList = shift;
    my $verbose = shift;
    my $results = [];
    
    my ($pointsList, $pointsListName) = tempfile ("/tmp/pointsList.XXXX", UNLINK => !$save_temps);
    my $npoints = 0;
    foreach my $row (@$rowList) {
        print $pointsList "$npoints $row->{CENTER_X} $row->{CENTER_Y}\n";
        $npoints++;
    }
    close $pointsList;

    # XXX: need to loop over these
    # my $run = $runList->[0];
    if (($req_type eq "byid") or ($req_type eq "byexp")) {
        my ($last_tess_id, $tess_dir_abs, $astrom_file) = ("", "", "");
        foreach my $run (@$runList) {
            my $command = "$dvoImagesAtCoords -coords $pointsListName";
            if (($stage eq "chip") or ($stage eq "raw")) {
                # XXX: use file rule and handle cameras where the astrometry is solved at
                # the chip stage.
                $astrom_file = $run->{cam_path_base} . ".smf";
                my $astrom_file_resolved = $ipprc->file_resolve($astrom_file);
                $command .= " -astrom $astrom_file_resolved";
            } else {
                my $tess_id = $run->{tess_id};
                if ($tess_id ne $last_tess_id) {
                    $tess_dir_abs = $ipprc->tessellation_catdir( $tess_id );
                    $tess_dir_abs = $ipprc->convert_filename_absolute( $tess_dir_abs );
                    $last_tess_id = $tess_id;
                }
                $command .= " -D CATDIR $tess_dir_abs"
            }
            my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
                 run(command => $command, verbose => $dvo_verbose);
            unless ($success) {
                # don't fail if the program exited normally and exit status was PSTAMP_NO_OVERLAP
                #                     # That just means that the coordinate didn't match any image/skycell
                if (!WIFEXITED($error_code) || (WEXITSTATUS($error_code) ne $PSTAMP_NO_OVERLAP)) {
                    print STDERR @$stderr_buf;
                    my $rc = WIFEXITED($error_code) ? WEXITSTATUS($error_code) : $PS_EXIT_SYS_ERROR;
                    &my_die( "dvoImagesAtCoords failed: $rc", $rc);
                }
            }
            my %components;
            my @lines = split "\n", join "", @$stdout_buf;
            foreach my $line (@lines) {
                my ($ptnum, undef, undef, $component) = split " ", $line;
                my $ref = $components{$component};
                if (!$ref) {
                    $ref = $components{$component} = [];
                }
                push @$ref, $ptnum;
            }
            if ($verbose) {
                foreach my $c (keys %components) {
                    my $ref = $components{$c};
                    print "component $c contains: ";
                    foreach my $i (@$ref) {
                        print "$i ";
                    }
                    print "\n";
                }
            }
            # now find the images for this run
            foreach my $c (keys %components) {
                my $command;
                my $stage_id;
                if ($stage eq 'raw') {
                    $stage_id = $run->{exp_id};
                    $command = "$regtool -processedimfile -exp_id $stage_id -class_id $c";
                } elsif ($stage eq 'chip') {
                    $stage_id = $run->{chip_id};
                    $command = "$chiptool -processedimfile -chip_id $stage_id -class_id $c";
                } elsif ($stage eq 'warp') {
                    $stage_id = $run->{warp_id};
                    $command = "$warptool -warped -warp_id $stage_id -skycell_id $c";
                } elsif ($stage eq 'diff') {
                    $stage_id = $run->{diff_id};
                    $command = "$difftool -diffskyfile -diff_id $stage_id -skycell_id $c";
                }
                $command .= " -dbname $imagedb";
                my $images = runToolAndParse($command, $verbose);
                if (!defined $images) {
                    # XXX: need to get the set error_code to $PSTAMP_NO_OVERLAP
                    print "No components containing coordinates found for ${stage}_id $stage_id\n";
                    foreach my $row (@$rowList) {
                        $row->{error_code} = $PSTAMP_NO_OVERLAP;
                    }
                    next;
                }
                if (scalar @$images != 1) {
                    my $num_images = scalar @$images;
                    &my_die ("unexpected number of images returned: $num_images\n", $PS_EXIT_PROG_ERROR);
                }
                my $image = $images->[0];
                    
                my $ref = $components{$c};
                $image->{row_index} = $ref;
                if (($stage eq "raw") or ($stage eq 'chip')) {
                    $image->{astrom} = $astrom_file;
                    $image->{cam_id} = $run->{cam_id};
                    $image->{cam_path_base} = $run->{cam_path_base};
                }
                push @$results, $image;
            }
        }
    } else {
        &my_die ("sorry not done with $req_type\n", $PS_EXIT_PROG_ERROR);
    }
    return $results;
}

sub filterRuns {
    my $stage      = shift;
    my $need_magic = shift;
    my $inputs     = shift;
    my $verbose    = shift;

    if ($inputs and (scalar @$inputs) == 1)  {
        # one run nothing to do
        return $inputs;
    }

    my $output = [];

    return $output if (!$inputs or scalar @$inputs == 0);

    my $id_name = $stage . "_id";

    # input list is "order by exp_id, run_id DESC"   run_id is one of (chip_id, warp_id, diff_id)
    print "Starting filterRuns\n";
    my $last_exp_id = 0;
    my $last_run_id = 0;
    my $printed = 0;
    foreach my $input (@$inputs) {
        my $exp_id = $input->{exp_id};
        my $run_id = $input->{$id_name};
        my $magicked = $input->{magicked};  # this will be either stageRun.magicked or stage%file.magicked
        my $state = $input->{state};

        # can't process run in these states
        if (($state eq 'new') or ($state eq 'purged') or ($state eq 'scrubbed')) {
            print "skipping ${stage}Run $run_id for exp_id $exp_id in state $state\n";
            next;
        }

        $printed = 1 if (($exp_id == $last_exp_id) and ($run_id == $last_run_id));

        # skip if we need magicked run and this one has never been magicked
        if ($need_magic and !$magicked) {
            print "skipping ${stage}Run $run_id for exp_id $exp_id not magicked\n" if !$printed;
            next;
        }

        if (($exp_id == $last_exp_id) and ($run_id != $last_run_id)) {
            print "Skipping duplicate ${stage}Run $run_id for $exp_id\n" if !$printed;
            next;
        }
        print "Keeping ${stage}Run $run_id for $exp_id\n";
        push @$output, $input;
        $last_exp_id = $exp_id;
        $last_run_id = $run_id;
        $printed = 0;
    }

    my $num_runs = scalar @$output;
    print "filterRuns returning $num_runs ${stage}Run\n";

    return $output;
}

# run a command that produces metadata output and parse the results into an array of objects
sub runToolAndParse {
    my $command = shift;
    my $verbose = shift;

    my ($program) = split " ", $command;
    $program = basename($program);

    print "Running $command\n" if !$verbose;
    my $start_tool = DateTime->now->mjd;
    # run the command and parse the output

    my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
                run(command => $command, verbose => $verbose);
    unless ($success) {
        # not sure if we should die here
        print STDERR @$stderr_buf;
        return undef;
    }

    my $now = DateTime->now->mjd;
    my $dtime_tool = (DateTime->now->mjd - $start_tool) * 86400.;
    print "Time to run $program: $dtime_tool\n";

    my $buf = join "", @$stdout_buf;
    if (!$buf) {
        return undef;
    }

    my $start_parse = DateTime->now->mjd;

    my $mdcParser = PS::IPP::Metadata::Config->new;
    my $results = parse_md_fast($mdcParser, $buf)
        or die ("Unable to parse metadata config doc");

    my $dtime_parse = (DateTime->now->mjd - $start_parse) * 86400.;
    print "Time to parse results from $program: $dtime_parse\n";

    return $results;
}

sub findTools {
    return if ($regtool);

    my $missing_tools;
    $regtool = can_run('regtool') or (warn "Can't find regtool" and $missing_tools = 1);
    $chiptool = can_run('chiptool') or (warn "Can't find chiptool" and $missing_tools = 1);
    $camtool = can_run('camtool') or (warn "Can't find camtool" and $missing_tools = 1);
    $warptool = can_run('warptool') or (warn "Can't find warptool" and $missing_tools = 1);
    $difftool = can_run('difftool') or (warn "Can't find difftool" and $missing_tools = 1);
    $stacktool = can_run('stacktool') or (warn "Can't find stacktool" and $missing_tools = 1);
    $pstamptool = can_run('pstamptool') or (warn "Can't find pstamptool" and $missing_tools = 1);
    $dvoImagesAtCoords = can_run('dvoImagesAtCoords') or (warn "Can't find dvoImagesAtCoords" 
                                                                and $missing_tools = 1);
    $whichimage = can_run('whichimage') or (warn "Can't find whichimage" and $missing_tools = 1);
    $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1);
    if ($missing_tools) {
        warn("Can't find required tools.");
        exit ($PS_EXIT_CONFIG_ERROR);
    }
}

# add a row_index array to a set of images with entries for each of the rows in a list
sub setRowRefs {
    my $rowList = shift;
    my $images  = shift;

    my $row_index = [];
    for (my $i = 0; $i < scalar @$rowList; $i++) {
        push @$row_index, $i;
    }
    foreach my $image (@$images) {
        $image->{row_index} = $row_index;
    }
}

sub my_die
{
    my $msg = shift;
    my $fault = shift;

    carp $msg;

    # we don't fault the request here pstamp_parser_run.pl handles that if necessary

    return $fault;
}
1;
