IPP Software Navigation Tools IPP Links Communication Pan-STARRS Links

Ignore:
Timestamp:
May 18, 2010, 12:49:05 PM (16 years ago)
Author:
eugene
Message:

merging changes from trunk into branches/pap

Location:
branches/pap
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • branches/pap

  • branches/pap/PS-IPP-PStamp/lib/PS/IPP/PStamp/Job.pm

    r27589 r28003  
    1717                    resolve_project
    1818                    getCamRunByCamID
     19                    parse_md_fast
    1920                    );
    2021our %EXPORT_TAGS = (standard => [@EXPORT_OK]);
    … …  
    2728use PS::IPP::Config qw( :standard );
    2829use Carp;
     30use File::Temp qw(tempfile);
     31use File::Basename;
     32use POSIX;
     33use Time::HiRes qw(gettimeofday);
     34
     35my $dvo_verbose = 0;
     36my $save_temps = 0;
    2937
    3038# caches of camProcessedExp objects.
    … …  
    3442my %camRunByCamIDCache;
    3543
    36 ### my @images = locate_images($image_db, $req_type, $img_type, $id, $component,
    37 ###            $mjd_min, $mjd_max, $filter);
     44# cache of last project looked up
     45my $last_project = "";
     46
     47my ($regtool, $chiptool, $camtool, $warptool, $stacktool, $difftool);
     48my ($pstamptool, $dvoImagesAtCoords, $whichimage, $ppConfigDump);
    3849
    3950sub locate_images {
    4051    my $ipprc    = shift;   # required
    41     my $image_db = shift;   # required
     52    my $imagedb = shift;   # required
     53    my $rowList  = shift;   # required
    4254    my $req_type = shift;   # required
    4355    my $img_type = shift;   # required
    … …  
    4759    my $option_mask  = shift;
    4860    my $need_magic = shift;
    49     my $x        = shift;
    50     my $y        = shift;
    5161    my $mjd_min  = shift;
    5262    my $mjd_max  = shift;
    … …  
    5666
    5767    # we die in response to bad data in request files
    58     # The wrapper script is responsible for updating the database
    59     die "Unknown req_type: $req_type"
     68    # The caller is responsible for updating the database
     69    # pstampparse.pl error checks now so this shouldn't happen
     70    &my_die("Unknown req_type: $req_type", $PS_EXIT_PROG_ERROR)
    6071        if ($req_type ne "byid") and
    6172           ($req_type ne "byexp") and
    … …  
    8495
    8596    if ($req_type eq "bycoord") {
    86         my $results = lookup_bycoord($ipprc, $image_db, $img_type, $tess_id, $component, $need_magic, $x, $y, $dateobs_begin, $dateobs_end, $filter, $data_group, $option_mask, $verbose);
     97        my $num_rows = scalar @$rowList;
     98        die "Unexpected number of rows found in rowList: $num_rows" if $num_rows != 1;
     99        my $row = $rowList->[0];
     100        my $x = $row->{CENTER_X};
     101        my $y = $row->{CENTER_Y};
     102        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);
    87103        return $results;
    88104    }
    … …  
    93109        # in one place
    94110        $req_type = "bydiff";
    95         my $results = lookup_diff($ipprc, $image_db, $id, $component, 1, $option_mask, $img_type, $verbose);
     111        my $results = lookup_diff($ipprc, $rowList, $imagedb, $id, $component, 1, $option_mask, $img_type, $verbose);
    96112        return $results;
    97113    }
    98114
    99115    if ($req_type eq "bydiff") {
    100         my $results = lookup_diff($ipprc, $image_db, $id, $component, 0, $option_mask, $img_type, $verbose);
     116        # for bydiff reuqests we go look up the diffRun to obtain exp_id, chip_id, warp_id, stack_id, or
     117        # the image from the diffRun
     118        my $results = lookup_diff($ipprc, $rowList, $imagedb, $id, $component, 0, $option_mask, $img_type, $verbose);
    101119        if (!$results) {
    102120            return undef;
    … …  
    130148            # fall though and lookup by stack_id
    131149        } else {
    132             # shouldn't I check this elsewhere?
     150            # This is checked this elsewhere?
    133151            print STDERR "Error: $img_type is an unknown image type\n";
    134152            return undef;
    … …  
    145163    }
    146164
    147     my $results = lookup($ipprc, $image_db, $req_type, $img_type, $id, $tess_id, $component, $need_magic,
    148         $dateobs_begin, $dateobs_end, $filter, $data_group, $option_mask, $verbose);
     165    my $results = lookup($ipprc, $rowList, $imagedb, $req_type, $img_type, $id, $tess_id, $component,
     166        $need_magic, $dateobs_begin, $dateobs_end, $filter, $data_group, $option_mask, $verbose);
    149167
    150168    return $results;
    151169}
    152170
    153 sub lookup
    154 {
     171# The subroutine lookup handles byexp, byid, and byskycell lookups including lookups that are
     172# triggered by a bydiff or bycoord request
     173
     174sub lookup {
    155175    my $ipprc    = shift;
    156     my $image_db = shift;
     176    my $rowList    = shift;
     177    my $imagedb = shift;
    157178    my $req_type = shift;
    158     my $img_type = shift;
     179    my $stage = shift;
    159180    my $id       = shift;
    160181    my $tess_id  = shift;
    … …  
    172193    my $use_imfile_id = ($req_type eq "byid") && ($option_mask & $PSTAMP_USE_IMFILE_ID);
    173194
    174     my $missing_tools;
    175     my $regtool = can_run('regtool') or (warn "Can't find regtool" and $missing_tools = 1);
    176     my $chiptool = can_run('chiptool') or (warn "Can't find chiptool" and $missing_tools = 1);
    177     my $warptool = can_run('warptool') or (warn "Can't find warptool" and $missing_tools = 1);
    178     my $difftool = can_run('difftool') or (warn "Can't find difftool" and $missing_tools = 1);
    179     my $stacktool = can_run('stacktool') or (warn "Can't find stacktool" and $missing_tools = 1);
    180     if ($missing_tools) {
    181         warn("Can't find required tools.");
    182         exit ($PS_EXIT_CONFIG_ERROR);
    183     }
    184195    my $command;
    185196    my $id_opt;     # option for the lookup
    … …  
    195206    my $class_id;
    196207    my $skycell_id;
    197 
    198     if (isnull($component)) {
    199         $component = undef;
    200     }
     208    my $default_error = $PSTAMP_NO_IMAGE_MATCH;
    201209
    202210    # note $magic_arg may be cleared below depending on $req_type
    203211    my $magic_arg = $need_magic ? " -destreaked" : "";
    204212
     213    # all rows have the same center type
     214    my $skycenter = ! ($rowList->[0]->{COORD_MASK} & $PSTAMP_CENTER_IN_PIXELS);
     215
    205216    my $component_args;
    206     if ($img_type eq "raw") {
    207         $class_id = $component;
    208         $command = "$regtool -processedimfile -dbname $image_db";
     217    my $choose_components = 0;
     218    if ($stage eq "raw") {
     219        $command = "$regtool -processedimfile -dbname $imagedb";
    209220        # XXX: for now restrict lookups to type object
    210221        # are stamps of detrend exposures interesting?
    211222        $command .= " -exp_type object";
    212223        $id_opt = $use_imfile_id ? "-raw_imfile_id" : "-exp_id";
    213         $component_args = " -class_id $class_id" if $component;
     224
     225        if ($component and $component ne 'all') {
     226            $class_id = $component;
     227            $component_args = " -class_id $class_id";
     228        }
    214229        $want_astrom = 1;
    215230        $set_class_id = 1;
    216     } elsif ($img_type eq "chip") {
    217         $class_id = $component;
    218         $command = "$chiptool -processedimfile -dbname $image_db";
    219         $component_args = " -class_id $class_id" if $class_id;
     231    } elsif ($stage eq "chip") {
     232        # if the request is such that it will yield a single image per "run" or the
     233        # center is specified in pixel coordinates
     234        # use chiptool -processsedimfile. Otherwise use chiptool -listrun and then
     235        # choose the chips containing the center pixel by calling selectComponets() below
     236        if ($component or $use_imfile_id or !$skycenter) {
     237            $command = "$chiptool -processedimfile -dbname $imagedb";
     238            if ($component and $component ne 'all') {
     239                $class_id = $component;
     240                $component_args = " -class_id $class_id";
     241            }
     242        } else {
     243            $command = "$chiptool -listrun -pstamp_order -dbname $imagedb";
     244            $choose_components = 1;
     245        }
    220246        $id_opt = $use_imfile_id ? "-chip_imfile_id" : "-chip_id";
     247        # XXX: perhaps we should stop resolving images to this level here and do it at job run time.
     248        # With the mdc file it has all of the information that it needs.
    221249        $image_name   = "PPIMAGE.CHIP";
    222         $mask_name    = "PPIMAGE.CHIP.MASK";
     250        # $mask_name    = "PPIMAGE.CHIP.MASK";
     251        # XXX: really need to handle this properly!
     252        $mask_name    = "PSASTRO.OUTPUT.MASK";
    223253        $weight_name  = "PPIMAGE.CHIP.VARIANCE";
    224254        $cmf_name     = "PSPHOT.OUTPUT";
    … …  
    228258        $want_astrom  = 1;
    229259        $set_class_id = 1;
    230     } elsif ($img_type eq "warp") {
    231         $skycell_id = $component;
    232         $command = "$warptool -warped -dbname $image_db";
    233         $component_args = " -skycell_id $skycell_id" if $skycell_id;
     260    } elsif ($stage eq "warp") {
     261        if ($component or $use_imfile_id or !$skycenter) {
     262            $command = "$warptool -warped -dbname $imagedb";
     263            if ($component and $component ne 'all') {
     264                $skycell_id = $component;
     265                $component_args = " -skycell_id $skycell_id";
     266            }
     267        } else {
     268            $command = "$warptool -listrun -pstamp_order -dbname $imagedb";
     269            $choose_components = 1;
     270        }
    234271        $id_opt = $use_imfile_id ? "-warp_skyfile_id" : "-warp_id";
    235272        $image_name   = "PSWARP.OUTPUT";
    … …  
    239276        $psf_name     = "PSPHOT.PSF.SKY.SAVE";
    240277        $base_name    = "path_base"; # name of the field for the warptool output
    241     } elsif ($img_type eq "diff") {
    242         $skycell_id = $component;
    243         $command = "$difftool -diffskyfile -dbname $image_db";
    244         $component_args = " -skycell_id $skycell_id" if $skycell_id;
     278    } elsif ($stage eq "diff") {
     279        if ($component or $use_imfile_id or !$skycenter) {
     280            $command = "$difftool -diffskyfile -dbname $imagedb";
     281            if ($component and $component ne 'all') {
     282                $skycell_id = $component;
     283                $component_args = " -skycell_id $skycell_id";
     284            }
     285        } else {
     286            $command = "$difftool -listrun -pstamp_order -dbname $imagedb";
     287            $choose_components = 1;
     288        }
    245289        $id_opt = $use_imfile_id ? "-diff_skyfile_id" : "-diff_id";
    246290        $image_name  = "PPSUB.OUTPUT";
    … …  
    248292        $weight_name = "PPSUB.OUTPUT.VARIANCE";
    249293        $cmf_name    = "PPSUB.OUTPUT.SOURCES";
    250         $psf_name     = "PSPHOT.PSF.SKY.SAVE";
     294        $psf_name    = "PSPHOT.PSF.SKY.SAVE";
    251295        $base_name   = "path_base";
    252     } elsif ($img_type eq "stack") {
     296    } elsif ($stage eq "stack") {
    253297        $skycell_id = $component;
    254         $command = "$stacktool -sumskyfile -dbname $image_db";
     298        $command = "$stacktool -sumskyfile -dbname $imagedb";
    255299        $id_opt = "-stack_id";
    256300        $component_args = " -skycell_id $skycell_id" if $skycell_id;
    … …  
    272316        $base_name   = "path_base";
    273317    } else {
    274         die "Unknown img_type supplied: $img_type";
    275     }
    276 
     318        die "Unknown IMG_TYPe supplied: $stage";
     319    }
     320
     321    my $filter_runs = 0;
    277322    if ($req_type eq "byid") {
    278323        $command .= " $id_opt $id";
    … …  
    288333        # the reason as 'not destreaked'
    289334        $magic_arg = "";
     335        # remove duplicate runs for the same exposure.
     336        $filter_runs = 1;
    290337    } elsif ($req_type eq "byskycell") {
    291338        die "tess_id and component are required for byskycell" if !$tess_id or ! $skycell_id;
    292339        $command .= " -tess_id $tess_id -skycell_id $skycell_id";
    293340    } else {
    294         die "Unknown req_type supplied: $req_type";
    295     }
    296 
    297     if ($img_type ne "stack") {
     341        # this should be caught by caller
     342        &my_die("Unexpected req_type supplied: $req_type", $PS_EXIT_PROG_ERROR);
     343    }
     344
     345    if ($stage ne "stack") {
    298346        $command .= $magic_arg;
    299347        $command .= " -dateobs_begin $dateobs_begin" if $dateobs_begin;
    … …  
    304352    $command .= " -data_group $data_group" if !isnull($data_group);
    305353
    306     # run the tool and parse the output
    307     my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
    308                 run(command => $command, verbose => $verbose);
    309     unless ($success) {
    310         # not sure if we should die here
    311         print STDERR @$stderr_buf;
     354    my $images = runToolAndParse($command, $verbose);
     355
     356    if (!$images or scalar @$images == 0) {
    312357        return undef;
    313358    }
    314359
    315     my $buf = join "", @$stdout_buf;
    316     if (!$buf) {
    317         return;
    318     }
    319 
    320     my $mdcParser = PS::IPP::Metadata::Config->new;
    321     my $images = parse_md_fast($mdcParser, $buf)
    322         or die ("Unable to parse metadata config doc");
    323 
     360    if ($filter_runs) {
     361        # The image selectors are such that multiple runs my have be returned for the same exposure.
     362        # Return only the latest one.
     363        $images = filterRuns($stage, $need_magic, $images, $verbose);
     364    }
     365    if ($choose_components) {
     366        # the list of "images" is actually a list of "Runs"
     367        # match the coords in the rows to the components in the runs
     368        # returns an actual list of images
     369        $images = selectComponents($ipprc, $imagedb, $req_type, $stage, $rowList, $images, $verbose);
     370    } else {
     371        # put index for each of the rows into all of the the images
     372        setRowRefs($rowList, $images);
     373    }
     374
     375    my $camera;
    324376    my $output = [];
    325 
    326     my $camera;
    327377    foreach my $image (@$images) {
    328378        my $base;
    329379
    330380        next if $image->{fault};
    331         next if ($img_type ne "raw") and $image->{quality};
     381        next if ($stage ne "raw") and $image->{quality};
    332382
    333383        if ($base_name) {
    … …  
    348398            $ipprc->define_camera($camera);
    349399        }
     400        # ok it's a keeper
    350401        my $out = $image;
    351402
    352403        # if uri is nil this will get overridded below
    353404        # (we do this here for raw stage)
    354         $out->{image}  = $image->{uri};
     405        $out->{image}  = $out->{uri};
    355406
    356407        if ($set_class_id) {
    357             $class_id = $image->{class_id};
     408            $class_id = $out->{class_id};
    358409            $out->{component} = $class_id;
    359410        } else {
    360             $out->{component} = $image->{skycell_id};
     411            $out->{component} = $out->{skycell_id};
    361412        }
    362413        my $stage_id;
    363         if ($img_type eq "raw") {
    364             $stage_id = $image->{exp_id};
    365         } elsif ($img_type eq "chip") {
    366             $stage_id = $image->{chip_id};
    367         } elsif ($img_type eq "warp") {
    368             $stage_id = $image->{warp_id};
    369         } elsif ($img_type eq "diff") {
    370             $stage_id = $image->{diff_id};
    371             if ($inverse && $image->{bothways}) {
     414        if ($stage eq "raw") {
     415            $stage_id = $out->{exp_id};
     416        } elsif ($stage eq "chip") {
     417            $stage_id = $out->{chip_id};
     418        } elsif ($stage eq "warp") {
     419            $stage_id = $out->{warp_id};
     420        } elsif ($stage eq "diff") {
     421            $stage_id = $out->{diff_id};
     422            if ($inverse && $out->{bothways}) {
    372423                $image_name  = "PPSUB.INVERSE";
    373424                $mask_name   = "PPSUB.INVERSE.MASK";
    … …  
    375426                $cmf_name    = "PPSUB.INVERSE.SOURCES";
    376427            }
    377         } elsif ($img_type eq "stack") {
    378             $stage_id = $image->{stack_id};
     428        } elsif ($stage eq "stack") {
     429            $stage_id = $out->{stack_id};
    379430        }
    380431        $out->{stage_id} = $stage_id;
    381         $out->{stage}    = $img_type;
    382         $out->{image_db} = $image_db;
     432        $out->{stage}    = $stage;
     433        $out->{imagedb} = $imagedb;
     434
     435        my $mask_base;
     436        if ($want_astrom) {
     437            if (! defined $out->{astrom}) {
     438                if (! find_astrometry($ipprc, $imagedb, $out, $verbose)) {
     439                    print STDERR "failed to find astrometry for $stage $stage_id\n";
     440                    next;
     441                }
     442            }
     443            # XXX: do this right by looking at the recipe
     444            $mask_base = $out->{cam_path_base};
     445        } else {
     446            $mask_base = $base;
     447        }
    383448
    384449        if ($base) {
    385450            $out->{image}  = $ipprc->filename($image_name,  $base, $class_id) if $image_name;
    386             $out->{mask}   = $ipprc->filename($mask_name,   $base, $class_id) if $mask_name;
     451            $out->{mask}   = $ipprc->filename($mask_name,   $mask_base, $class_id) if $mask_name;
    387452            $out->{weight} = $ipprc->filename($weight_name, $base, $class_id) if $weight_name;
    388             $out->{cmf}    = $ipprc->filename($cmf_name, $base, $class_id) if $cmf_name;
    389             $out->{psf}    = $ipprc->filename($psf_name, $base, $class_id) if $psf_name;
    390             $out->{backmdl}= $ipprc->filename($backmdl_name, $base, $class_id) if $backmdl_name;
    391         }
    392         $out->{astrom} = find_astrometry($ipprc, $image_db, $image, $verbose) if $want_astrom;
     453            $out->{cmf}    = $ipprc->filename($cmf_name,    $base, $class_id) if $cmf_name;
     454            $out->{psf}    = $ipprc->filename($psf_name,    $base, $class_id) if $psf_name;
     455            $out->{backmdl}= $ipprc->filename($backmdl_name,$base, $class_id) if $backmdl_name;
     456        }
    393457
    394458        push @$output, $out;
    … …  
    397461    return $output;
    398462}
     463
    399464sub lookup_diff {
    400465    my $ipprc    = shift;
    401     my $image_db = shift;
     466    my $rowList  = shift;
     467    my $imagedb = shift;
    402468    my $id       = shift;
    403469    my $skycell_id = shift;
    … …  
    409475    my $inverse = $option_mask & $PSTAMP_SELECT_INVERSE;
    410476
    411     my $missing_tools;
    412     my $difftool = can_run('difftool') or (warn "Can't find difftool" and $missing_tools = 1);
    413     if ($missing_tools) {
    414         warn("Can't find required tools.");
    415         exit ($PS_EXIT_CONFIG_ERROR);
    416     }
    417 
    418     my $command = "$difftool -diffskyfile -dbname $image_db";
     477    my $command = "$difftool -dbname $imagedb";
    419478   
     479    my $listrun = 0;
    420480    if ($byid) {
    421         $command .= " -diff_id $id";
     481        if ($skycell_id) {
     482            $command .= " -diffskyfile -diff_id $id -skycell_id $skycell_id";
     483        } else {
     484            $command .= " -listrun -diff_id $id";
     485            $listrun = 1;
     486        }
    422487    } else {
    423         $command .= " -diff_skyfile_id $id";
    424     }
    425     $command .= " -skycell_id $skycell_id" if $skycell_id;
    426 
    427     # run the tool and parse the output
    428     my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
    429                 run(command => $command, verbose => $verbose);
    430     unless ($success) {
    431         # not sure if we should die here
    432         print STDERR @$stderr_buf;
    433         return undef;
    434     }
    435 
    436     my $buf = join "", @$stdout_buf;
    437     if (!$buf) {
    438         return undef;
    439     }
    440 
    441     my $mdcParser = PS::IPP::Metadata::Config->new;
    442     my $images = parse_md_fast($mdcParser, $buf)
    443         or die ("Unable to parse metadata config doc");
    444 
    445     my $n = @$images;
    446     if (!$byid && ($n > 1)) {
     488        $command .= " -diffskyfile -diff_skyfile_id $id";
     489    }
     490
     491    my $output = runToolAndParse($command, $verbose);
     492
     493    my $n = $output ? scalar @$output : 0;
     494    if (!$listrun && ($n > 1)) {
    447495        die ("difftool returned an unexpected number of diffskyfiles: $n");
    448496    } elsif ($n == 0) {
    449497        return undef;
     498    }
     499
     500    my $images;
     501    if ($listrun) {
     502        $images = selectComponents($ipprc, $imagedb, 'byid', 'diff', $rowList, $output, $verbose);
     503    } else {
     504        $images = $output;
    450505    }
    451506
    … …  
    478533            if (($img_type ne "diff") and ($img_type ne "stack")) {
    479534                print STDERR "lookup_diff: cannot lookup IMG_TYPE $img_type bydiff from a stack stack diff run\n";
    480                 next;
     535                setErrorCodes($rowList, $PSTAMP_INVALID_REQUEST);
     536                # all images will be the same so we can stop
     537                last;
    481538            }
    482539            # stack-stack diff
    … …  
    527584
    528585        if ($img_type eq "diff") {
     586            my @imageList = ($image);
     587
     588            setRowRefs($rowList, \@imageList);
    529589            # the $image is going to be returned directly in this case so we need to duplicate
    530590            # some of processing that lookup does for other img_types
    … …  
    539599                $image->{stage_id} = $image->{diff_id};
    540600                $image->{stage}    = "diff";
    541                 $image->{image_db} = $image_db;
     601                $image->{imagedb} = $imagedb;
    542602                $image->{component} = $image->{skycell_id};
    543603            } else {
    544604                # XXX this will only happen if the minuend is not a warp. See hack above
    545                 print STDERR "WARNING: cannot resolve camera so cannot get resolve file rules\n";
     605                print STDERR "WARNING: cannot resolve camera so cannot find file rules\n";
    546606                next;
    547607            }
    … …  
    554614sub lookup_bycoord {
    555615    my $ipprc      = shift;
    556     my $image_db   = shift;
     616    my $rowList    = shift;
     617    my $imagedb    = shift;
    557618    my $img_type   = shift;
    558619    my $tess_id    = shift;
    … …  
    568629    my $verbose    = shift;
    569630
    570     my $missing_tools;
    571     my $regtool = can_run('regtool') or (warn "Can't find regtool" and $missing_tools = 1);
    572     my $camtool = can_run('camtool') or (warn "Can't find camtool" and $missing_tools = 1);
    573     my $dvoImagesAtCoords = can_run('dvoImagesAtCoords') or (warn "Can't find dvoImagesAtCoords" and $missing_tools = 1);
    574     my $whichimage = can_run('whichimage') or (warn "Can't find whichimage" and $missing_tools = 1);
    575     if ($missing_tools) {
    576         warn("Can't find required tools.");
    577         exit ($PS_EXIT_CONFIG_ERROR);
    578     }
    579 
    580631    my $results = ();
    581632    if (($img_type eq "raw") or ($img_type eq "chip")) {
    582633
    583         my $runs = lookup_runs_by_camid_and_coords($ipprc, $image_db, $img_type,
     634        my $runs = lookup_runs_by_cam_id_and_coords($ipprc, $imagedb, $img_type,
    584635            $ra, $dec, $need_magic, $dateobs_begin, $dateobs_end, $filter, $data_group, $verbose);
    585636
     637        # lookup is going to filter these we don't need to do it here
     638#        $runs = filterRuns($img_type, $need_magic, $runs, $verbose);
    586639        foreach my $run (@$runs) {
    587640            next if $component and ($run->{component} ne $component);
    588             my $these_results = lookup($ipprc, $image_db, "byid", $img_type, $run->{id},
     641            my $these_results = lookup($ipprc, $rowList, $imagedb, "byid", $img_type, $run->{id},
    589642                $tess_id, $run->{component}, $need_magic,
    590643                $dateobs_begin, $dateobs_end, $filter, $data_group, $option_mask, $verbose);
    … …  
    602655
    603656        foreach my $skycell (@$skycells) {
    604             my $these_results = lookup($ipprc, $image_db, "byskycell", $img_type, undef,
     657            my $these_results = lookup($ipprc, $rowList, $imagedb, "byskycell", $img_type, undef,
    605658                $skycell->{tess_id}, $skycell->{component}, $need_magic,
    606659                $dateobs_begin, $dateobs_end, $filter, $data_group, $option_mask, $verbose);
    … …  
    614667}
    615668
    616 # lookup_runs_by_camid_and_coords
     669# lookup_runs_by_cam_id_and_coords
    617670# given an ra, dec, and optionally other paramters, find camera runs for exposures
    618671# that are within some distance of the coordinates
    619 sub lookup_runs_by_camid_and_coords {
     672sub lookup_runs_by_cam_id_and_coords {
    620673    my $ipprc      = shift;
    621     my $image_db   = shift;
     674    my $imagedb   = shift;
    622675    my $img_type   = shift;
    623676    my $ra         = shift;
    … …  
    631684
    632685    my $camruns;
    633     my $missing_tools;
    634     my $camtool = can_run('camtool') or (warn "Can't find camtool" and $missing_tools = 1);
    635     my $dvoImagesAtCoords = can_run('dvoImagesAtCoords') or (warn "Can't find dvoImagesAtCoords" and $missing_tools = 1);
    636     if ($missing_tools) {
    637         warn("Can't find required tools.");
    638         exit ($PS_EXIT_CONFIG_ERROR);
    639     }
    640686
    641687    {
    642         my $command = "$camtool -dbname $image_db -processedexp";
     688        my $command = "$camtool -dbname $imagedb -processedexp -pstamp_order";
    643689           $command .= " -ra $ra -decl $dec -radius 1.6";
    644690           $command .= " -dateobs_begin $dateobs_begin" if $dateobs_begin;
    … …  
    652698           $command .= " -data_group $data_group" if $data_group;
    653699           $command .= " -destreaked" if $need_magic;
     700
    654701        # run the tool and parse the output
    655         my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
    656                     run(command => $command, verbose => $verbose);
    657         unless ($success) {
    658             print STDERR @$stderr_buf;
    659             return undef;
    660         }
    661         my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files
    662 
    663         my $output = join "", @$stdout_buf;
    664         if (!$output) {
    665             print STDERR "no output returned from $command\n" if $verbose;
    666             return undef;
    667         }
    668         $camruns = parse_md_fast($mdcParser, $output);
     702        $camruns = runToolAndParse($command, $verbose);
    669703    }
    670704    if (!$camruns) {
    … …  
    672706    }
    673707    my $runs;
     708    my $last_exp_id = 0;
    674709    foreach my $camRun (@$camruns) {
    675710        my $cam_id = $camRun->{cam_id};
    676 
    677         updateCamRunCache($camRun);
     711        my $exp_id = $camRun->{exp_id};
     712
     713        next if $exp_id eq $last_exp_id;
    678714
    679715        next if $camRun->{quality};
    680716        next if $camRun->{fault};
     717
     718        updateCamRunCache($camRun);
     719
     720        $last_exp_id = $exp_id;
     721
    681722        # XXX Use file rule
    682723        my $astrom = $camRun->{path_base} . ".smf";
    … …  
    684725        next if !$astrom_resolved;
    685726
     727        my $start_dvo = gettimeofday();
    686728        my $command = "$dvoImagesAtCoords -astrom $astrom_resolved $ra $dec";
    687729        # run the tool and parse the output
    688730        my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
    689                     run(command => $command, verbose => $verbose);
     731                    run(command => $command, verbose => $dvo_verbose);
     732        my $dtime_dvo = gettimeofday() - $start_dvo;
     733#        print "Time to run dvoImagesAtCoords: $dtime_dvo\n";
    690734        unless ($success) {
    691735            my $result_code = $error_code >> 8;
    692736            if ($result_code == $PSTAMP_NO_OVERLAP) {
    693                 print STDERR "no overlap for $astrom\n" if $verbose;
     737                print "no overlap for $astrom\n" if $verbose;
    694738                next;
    695739            }
    … …  
    709753        my $n = scalar @lines;
    710754        if ($n != 1) {
    711             print STDERR "unexpected number of lines returned by dvoImagesAtCoords: $n\n";
    712 
    713755            # XXX: There is a bug in dvo where each component is listed twice
    714756            # When that gets fixed remove the conditional and just die
    715             die "unexpected number lines returned by dvoImagesAtCoords: $n"
    716                 if ($n != 2) or ($lines[0] ne $lines[1]);
     757            if ($n ne 2 or $lines[0] ne $lines[1]) {
     758                print STDERR "unexpected number of lines returned by dvoImagesAtCoords: $n\n";
     759                print STDERR "OUTPUT:\n$output\n";
     760                # actually this seems to happen sometimes. Probably due to a problem with
     761                # astrometry. Just skip this camRun
     762                print STDERR "skipping: $astrom\n";
     763                next;
     764            }
    717765        }
    718766
    … …  
    721769            die "unexpected output from dvoImagesAtCoords: $lines[0]";
    722770        }
     771
     772        print "cam_id $cam_id exp_id $camRun->{exp_id} chip_id $camRun->{chip_id} $class_id\n";
     773
    723774        # build the hash to return
    724775        my $run = {
    … …  
    727778            chip_id   => $camRun->{chip_id},
    728779            cam_id    => $camRun->{cam_id},
    729             astrom    => $astrom_resolved,
     780            astrom    => $astrom_resolved,  # XXX: is astrom used?
    730781            class_id  => $class_id,
    731782            component => $class_id
    732783        };
    733784        if ($img_type eq "chip") {
    734             $run->{id} = $run->{chip_id};
     785            $run->{id} = $camRun->{chip_id};
     786            $run->{state} = $camRun->{chip_state};
     787            $run->{magicked} = $camRun->{chip_magicked};
    735788        } else {
    736             $run->{id} = $run->{exp_id};
     789            $run->{id} = $camRun->{exp_id};
     790            $run->{state} = 'full';
     791            $run->{magicked} = $camRun->{raw_magicked};
    737792        }
    738793        push @$runs, $run;
    … …  
    749804    my $dec        = shift;
    750805    my $verbose    = shift;
    751 
    752     my $missing_tools;
    753     my $whichimage = can_run('whichimage') or (warn "Can't find whichimage" and $missing_tools = 1);
    754     if ($missing_tools) {
    755         warn("Can't find required tools.");
    756         exit ($PS_EXIT_CONFIG_ERROR);
    757     }
    758806
    759807    $requested_tess_id = "" if isnull($requested_tess_id);
    … …  
    810858# cache of results of ppConfigDump
    811859my %astromSources;
    812 my $last_exp_id = 0;
    813 my $lastAstromFile;
    814860
    815861# find the astrometry file for a given exposure
    816862# return undef if no completed camRun exists
     863# XXX Right now this probably only works cameras where the astrometry is done at the camera stage
     864# What other possibilities are there for ASTROM.SOURCE besides PSASTRO.OUTPUT?
     865
    817866sub find_astrometry {
    818867    my $ipprc = shift;
    819     my $image_db = shift;
     868    my $imagedb = shift;
    820869    my $image = shift;      # hashref to output of the lookup tool
    821870    my $verbose = shift;
    … …  
    824873
    825874    my $exp_id = $image->{exp_id};
    826     if (($exp_id eq $last_exp_id) and $lastAstromFile) {
    827         # running camtool 60 times is really expensive when the answer is the same
    828         return $lastAstromFile;
    829     }
    830     $last_exp_id = 0;
    831     $lastAstromFile = undef;
    832 
    833     my $missing_tools;
    834     my $camtool = can_run("camtool") or (warn "Can't find camtool" and $missing_tools = 1);
    835     my $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1);
    836     if ($missing_tools) {
    837         warn("Can't find required tools.");
    838         exit ($PS_EXIT_CONFIG_ERROR);
    839     }
    840875
    841876    my $camRun = getCamRunByExpID($exp_id);
    842877    if (!$camRun) {
    843         my $command = "$camtool -dbname $image_db -processedexp -exp_id $exp_id";
     878        my $command = "$camtool -dbname $imagedb -processedexp -exp_id $exp_id -pstamp_order";
    844879        # run the tool and parse the output
    845880        my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
    … …  
    847882        unless ($success) {
    848883            print STDERR @$stderr_buf;
    849             return undef;
     884            return 0;
    850885        }
    851886
    … …  
    855890        if (!$output) {
    856891            print STDERR "no output returned from $command\n" if $verbose;
    857             return undef;
     892            return 0;
    858893        }
    859894        my $camruns = parse_md_fast($mdcParser, $output);
    860895        if (!$camruns) {
    861             return undef;
     896            return 0;
    862897        }
    863898
    864899        # If there are multiple cam runs for this exposure, take the last completed one with good quality
    865900        # on the assumption that it has the best astrometry.
    866         while ($camRun = pop @$camruns) {
    867             last if (($camRun->{quality} eq 0) and ($camRun->{fault} eq 0));
     901        foreach my $cr (@$camruns) {
     902            if (($cr->{state} eq 'full') and ($cr->{quality} eq 0) and ($cr->{fault} eq 0)) {
     903                $camRun = $cr;
     904                last;
     905            }
    868906        }
    869907        # XXX: this looks like a bug at least if ASTROM.SOURCE eq PSASTRO.OUTPUT
    870908        if (!$camRun) {
    871909            # no cam runs for this exposure id therefore best astrometry is whatever is in the header
    872             return undef;
     910            return 0;
    873911        }
    874912        updateCamRunCache($camRun);
    … …  
    899937    # XXX: Is this code correct if ASTROM.SOURCE ne "PSASTRO.OUTPUT"
    900938    my $astromFile = $ipprc->filename($astromSource, $camRoot);
    901     if ($astromFile) {
    902         $lastAstromFile = $astromFile;
    903         $last_exp_id = $exp_id;
    904     }
    905 
    906     return $astromFile;
     939    if (!$astromFile) {
     940        print STDERR "failed to find astrometry file from $astromSource $camRoot\n";
     941        return 0;
     942    }
     943
     944    $image->{astrom} = $astromFile;
     945    $image->{cam_path_base} = $camRoot;
     946
     947    return 1;
    907948}
    908949
    … …  
    9591000# resolve_project()
    9601001# get project specific information
    961 my $last_project = "";
    9621002sub resolve_project {
    9631003    my $ipprc = shift;
    9641004    my $project_name = shift;
    9651005
     1006    findTools();
     1007
    9661008    if (!$project_name) {
    9671009        carp ("project is not defined");
    … …  
    9691011    }
    9701012
    971     if ($project_name eq $last_project) {
     1013    if ($last_project and ($project_name eq ($last_project->{name}))) {
    9721014        return $last_project;
    9731015    }
    … …  
    9771019
    9781020    my $verbose = 0;
    979 
    980     my $missing_tools;
    981     my $pstamptool = can_run("pstamptool") or (warn "Can't find pstamptool" and $missing_tools = 1);
    982     if ($missing_tools) {
    983         warn("Can't find required tools.");
    984         exit ($PS_EXIT_CONFIG_ERROR);
    985     }
    9861021
    9871022    my $command = "$pstamptool -project -name $project_name";
    9881023    $command .= " -dbname $dbname" if defined $dbname;
    9891024    $command .= " -dbserver $dbserver" if defined $dbserver;
    990     # run the tool and parse the output
    991     my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
    992                 run(command => $command, verbose => $verbose);
    993     unless ($success) {
    994         print STDERR @$stderr_buf;
     1025
     1026    my $proj_hash = runToolAndParse($command, $verbose);
     1027    if (!$proj_hash or scalar @$proj_hash == 0) {
     1028        print STDERR "Project $project_name not found\n";
    9951029        return undef;
    9961030    }
    997 
    998     my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files
    999 
    1000     my $output = join "", @$stdout_buf;
    1001     if (!$output) {
    1002         print STDERR "no output returned from $command\n" if $verbose;
    1003         return undef;
    1004     }
    1005     my $proj_hash = parse_md_fast($mdcParser, $output);
    10061031
    10071032    $last_project = $proj_hash->[0];
    … …  
    10351060sub getCamRunByExpID {
    10361061    my $exp_id = shift;
    1037     die "getCamRun: exp_id is nil" if !$exp_id;
     1062    &my_die ("getCamRun: exp_id is nil", $PS_EXIT_PROG_ERROR) if !$exp_id;
    10381063
    10391064    return $camRunByExpIDCache{$exp_id};
    10401065}
     1066
    10411067sub getCamRunByCamID {
    10421068    my $cam_id = shift;
    1043     die "getCamRun: cam_id is nil" if !$cam_id;
     1069    &my_die ("getCamRun: cam_id is nil", $PS_EXIT_PROG_ERROR) if !$cam_id;
    10441070
    10451071    return $camRunByCamIDCache{$cam_id};
    10461072}
     1073
     1074sub selectComponents {
     1075    my $ipprc = shift;
     1076    my $imagedb = shift;
     1077    my $req_type = shift;
     1078    my $stage  = shift;
     1079    my $rowList = shift;
     1080    my $runList = shift;
     1081    my $verbose = shift;
     1082    my $results = [];
     1083   
     1084    my ($pointsList, $pointsListName) = tempfile ("/tmp/pointsList.XXXX", UNLINK => !$save_temps);
     1085    my $npoints = 0;
     1086    foreach my $row (@$rowList) {
     1087        print $pointsList "$npoints $row->{CENTER_X} $row->{CENTER_Y}\n";
     1088        $npoints++;
     1089        # this gets overwitten if an overlapping image is found
     1090        $row->{error_code} = $PSTAMP_NO_OVERLAP;
     1091    }
     1092    close $pointsList;
     1093
     1094    # XXX: need to loop over these
     1095    # my $run = $runList->[0];
     1096    if (($req_type eq "byid") or ($req_type eq "byexp")) {
     1097        my ($last_tess_id, $tess_dir_abs, $astrom_file) = ("", "", "");
     1098        foreach my $run (@$runList) {
     1099            my $command = "$dvoImagesAtCoords -coords $pointsListName";
     1100            if (($stage eq "chip") or ($stage eq "raw")) {
     1101                # XXX: use file rule and handle cameras where the astrometry is solved at
     1102                # the chip stage.
     1103                $astrom_file = $run->{cam_path_base} . ".smf";
     1104                my $astrom_file_resolved = $ipprc->file_resolve($astrom_file);
     1105                $command .= " -astrom $astrom_file_resolved";
     1106            } else {
     1107                my $tess_id = $run->{tess_id};
     1108                if ($tess_id ne $last_tess_id) {
     1109                    $tess_dir_abs = $ipprc->tessellation_catdir( $tess_id );
     1110                    $tess_dir_abs = $ipprc->convert_filename_absolute( $tess_dir_abs );
     1111                    $last_tess_id = $tess_id;
     1112                }
     1113                $command .= " -D CATDIR $tess_dir_abs"
     1114            }
     1115            my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
     1116                 run(command => $command, verbose => $dvo_verbose);
     1117            unless ($success) {
     1118                # don't fail if the program exited normally and exit status was PSTAMP_NO_OVERLAP
     1119                #                     # That just means that the coordinate didn't match any image/skycell
     1120                if (!WIFEXITED($error_code) || (WEXITSTATUS($error_code) ne $PSTAMP_NO_OVERLAP)) {
     1121                    print STDERR @$stderr_buf;
     1122                    my $rc = WIFEXITED($error_code) ? WEXITSTATUS($error_code) : $PS_EXIT_SYS_ERROR;
     1123                    &my_die( "dvoImagesAtCoords failed: $rc", $rc);
     1124                }
     1125            }
     1126            my %components;
     1127            my @lines = split "\n", join "", @$stdout_buf;
     1128            foreach my $line (@lines) {
     1129                my ($ptnum, undef, undef, $component) = split " ", $line;
     1130                my $ref = $components{$component};
     1131                if (!$ref) {
     1132                    $ref = $components{$component} = [];
     1133                }
     1134                push @$ref, $ptnum;
     1135                my $row = $rowList->[$ptnum];
     1136                # this row found a match
     1137                $row->{error_code} = 0;
     1138            }
     1139            if ($verbose) {
     1140                foreach my $c (keys %components) {
     1141                    my $ref = $components{$c};
     1142                    print "component $c contains: ";
     1143                    foreach my $i (@$ref) {
     1144                        print "$i ";
     1145                    }
     1146                    print "\n";
     1147                }
     1148            }
     1149            # now find the images for this run
     1150            foreach my $c (keys %components) {
     1151                my $command;
     1152                my $stage_id;
     1153                if ($stage eq 'raw') {
     1154                    $stage_id = $run->{exp_id};
     1155                    $command = "$regtool -processedimfile -exp_id $stage_id -class_id $c";
     1156                } elsif ($stage eq 'chip') {
     1157                    $stage_id = $run->{chip_id};
     1158                    $command = "$chiptool -processedimfile -chip_id $stage_id -class_id $c";
     1159                } elsif ($stage eq 'warp') {
     1160                    $stage_id = $run->{warp_id};
     1161                    $command = "$warptool -warped -warp_id $stage_id -skycell_id $c";
     1162                } elsif ($stage eq 'diff') {
     1163                    $stage_id = $run->{diff_id};
     1164                    $command = "$difftool -diffskyfile -diff_id $stage_id -skycell_id $c";
     1165                }
     1166                $command .= " -dbname $imagedb";
     1167                my $images = runToolAndParse($command, $verbose);
     1168                if (!defined $images) {
     1169                    print "No components containing coordinates found for ${stage}_id $stage_id\n";
     1170                    foreach my $row (@$rowList) {
     1171                        # XXX: This doesn't seem like the correct error code?
     1172                        $row->{error_code} = $PSTAMP_NO_OVERLAP;
     1173                    }
     1174                    next;
     1175                }
     1176                if (scalar @$images != 1) {
     1177                    my $num_images = scalar @$images;
     1178                    &my_die ("unexpected number of images returned: $num_images\n", $PS_EXIT_PROG_ERROR);
     1179                }
     1180                my $image = $images->[0];
     1181                   
     1182                my $ref = $components{$c};
     1183                $image->{row_index} = $ref;
     1184                if (($stage eq "raw") or ($stage eq 'chip')) {
     1185                    $image->{astrom} = $astrom_file;
     1186                    $image->{cam_id} = $run->{cam_id};
     1187                    $image->{cam_path_base} = $run->{cam_path_base};
     1188                }
     1189                push @$results, $image;
     1190            }
     1191        }
     1192    } else {
     1193        &my_die ("sorry not done with $req_type\n", $PS_EXIT_PROG_ERROR);
     1194    }
     1195    return $results;
     1196}
     1197
     1198sub filterRuns {
     1199    my $stage      = shift;
     1200    my $need_magic = shift;
     1201    my $inputs     = shift;
     1202    my $verbose    = shift;
     1203
     1204    if ($inputs and (scalar @$inputs) == 1)  {
     1205        # one run nothing to do
     1206        return $inputs;
     1207    }
     1208
     1209    my $output = [];
     1210
     1211    return $output if (!$inputs or scalar @$inputs == 0);
     1212
     1213    my $id_name = $stage . "_id";
     1214
     1215    # input list is "order by exp_id, run_id DESC"   run_id is one of (chip_id, warp_id, diff_id)
     1216    print "Starting filterRuns\n";
     1217    my $last_exp_id = 0;
     1218    my $last_run_id = 0;
     1219    my $printed = 0;
     1220    foreach my $input (@$inputs) {
     1221        my $exp_id = $input->{exp_id};
     1222        my $run_id = $input->{$id_name};
     1223        my $magicked = $input->{magicked};  # this will be either stageRun.magicked or stage%file.magicked
     1224        my $state = $input->{state};
     1225
     1226        # can't process run in these states
     1227        if (($state eq 'new') or ($state eq 'purged') or ($state eq 'scrubbed')) {
     1228            print "skipping ${stage}Run $run_id for exp_id $exp_id in state $state\n";
     1229            next;
     1230        }
     1231
     1232        $printed = 1 if (($exp_id == $last_exp_id) and ($run_id == $last_run_id));
     1233
     1234        # skip if we need magicked run and this one has never been magicked
     1235        if ($need_magic and !$magicked) {
     1236            print "skipping ${stage}Run $run_id for exp_id $exp_id not magicked\n" if !$printed;
     1237            next;
     1238        }
     1239
     1240        if (($exp_id == $last_exp_id) and ($run_id != $last_run_id)) {
     1241            print "Skipping duplicate ${stage}Run $run_id for $exp_id\n" if !$printed;
     1242            next;
     1243        }
     1244        print "Keeping ${stage}Run $run_id for $exp_id\n";
     1245        push @$output, $input;
     1246        $last_exp_id = $exp_id;
     1247        $last_run_id = $run_id;
     1248        $printed = 0;
     1249    }
     1250
     1251    my $num_runs = scalar @$output;
     1252    print "filterRuns returning $num_runs ${stage}Run\n";
     1253
     1254    return $output;
     1255}
     1256
     1257# run a command that produces metadata output and parse the results into an array of objects
     1258sub runToolAndParse {
     1259    my $command = shift;
     1260    my $verbose = shift;
     1261
     1262    my ($program) = split " ", $command;
     1263    $program = basename($program);
     1264
     1265    print "Running $command\n" if !$verbose;
     1266    my $start_tool = gettimeofday();
     1267    # run the command and parse the output
     1268
     1269    my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
     1270                run(command => $command, verbose => $verbose);
     1271    unless ($success) {
     1272        # not sure if we should die here
     1273        print STDERR @$stderr_buf;
     1274        return undef;
     1275    }
     1276
     1277    my $now = gettimeofday();
     1278    my $dtime_tool = $now - $start_tool;
     1279    print "Time to run $program: $dtime_tool\n";
     1280
     1281    my $buf = join "", @$stdout_buf;
     1282    if (!$buf) {
     1283        return undef;
     1284    }
     1285
     1286    my $start_parse = gettimeofday();
     1287
     1288    my $mdcParser = PS::IPP::Metadata::Config->new;
     1289    my $results = parse_md_fast($mdcParser, $buf)
     1290        or die ("Unable to parse metadata config doc");
     1291
     1292    my $dtime_parse = gettimeofday() - $start_parse;
     1293    print "Time to parse results from $program: $dtime_parse\n";
     1294
     1295    return $results;
     1296}
     1297
     1298sub findTools {
     1299    return if ($regtool);
     1300
     1301    my $missing_tools;
     1302    $regtool = can_run('regtool') or (warn "Can't find regtool" and $missing_tools = 1);
     1303    $chiptool = can_run('chiptool') or (warn "Can't find chiptool" and $missing_tools = 1);
     1304    $camtool = can_run('camtool') or (warn "Can't find camtool" and $missing_tools = 1);
     1305    $warptool = can_run('warptool') or (warn "Can't find warptool" and $missing_tools = 1);
     1306    $difftool = can_run('difftool') or (warn "Can't find difftool" and $missing_tools = 1);
     1307    $stacktool = can_run('stacktool') or (warn "Can't find stacktool" and $missing_tools = 1);
     1308    $pstamptool = can_run('pstamptool') or (warn "Can't find pstamptool" and $missing_tools = 1);
     1309    $dvoImagesAtCoords = can_run('dvoImagesAtCoords') or (warn "Can't find dvoImagesAtCoords"
     1310                                                                and $missing_tools = 1);
     1311    $whichimage = can_run('whichimage') or (warn "Can't find whichimage" and $missing_tools = 1);
     1312    $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1);
     1313    if ($missing_tools) {
     1314        warn("Can't find required tools.");
     1315        exit ($PS_EXIT_CONFIG_ERROR);
     1316    }
     1317}
     1318
     1319# add a row_index array to a set of images with entries for each of the rows in a list
     1320sub setRowRefs {
     1321    my $rowList = shift;
     1322    my $images  = shift;
     1323
     1324    my $row_index = [];
     1325    for (my $i = 0; $i < scalar @$rowList; $i++) {
     1326        push @$row_index, $i;
     1327    }
     1328    foreach my $image (@$images) {
     1329        $image->{row_index} = $row_index;
     1330    }
     1331}
     1332# set error_code for an array of rows to a given value
     1333sub setErrorCodes {
     1334    my $rowList = shift;
     1335    my $code = shift;
     1336    foreach my $row (@$rowList) {
     1337        $row->{error_code} = $code;
     1338    }
     1339}
     1340
     1341sub my_die
     1342{
     1343    my $msg = shift;
     1344    my $fault = shift;
     1345
     1346    carp $msg;
     1347
     1348    # we don't fault the request here pstamp_parser_run.pl handles that if necessary
     1349
     1350    return $fault;
     1351}
    104713521;
Note: See TracChangeset for help on using the changeset viewer.