Index: trunk/pstamp/scripts/psmkreq =================================================================== --- trunk/pstamp/scripts/psmkreq (revision 34445) +++ trunk/pstamp/scripts/psmkreq (revision 34447) @@ -52,4 +52,11 @@ my $comment; +my $survey_name = 'null'; +my $release = 'null'; +my $stack_type = 'null'; +my $bgrestore; +my $jpeg; +my $nocompress; + my $missing_tools; my $pstamp_request_file = can_run('pstamp_request_file') or (warn "Can't find required program pstamp_request_file" and $missing_tools = 1); @@ -68,5 +75,6 @@ 'width=i' => \$width, 'height=i' => \$height, - 'pixcenter' => \$pixcenter, +# pixcenter is deprecated +# 'pixcenter' => \$pixcenter, 'arcseconds' => \$arcseconds, 'coord_mask=i' => \$coord_mask, @@ -87,9 +95,14 @@ 'comment=s' => \$comment, + # new columns for version 2 + 'survey=s' => \$survey_name, + 'release=s' => \$release, + 'stack_type' => \$stack_type, + 'option_mask=i' => \$option_mask, 'image' => \$image, 'mask' => \$mask, 'variance' => \$variance, - 'cmf' => \$cmf, + 'sources' => \$cmf, 'psf' => \$psf, 'backmdl' => \$backmdl, @@ -99,4 +112,8 @@ 'do_not_wait' => \$no_wait, + # new options for version 2 + 'no_compress' => \$nocompress, + 'bgrestore' => \$bgrestore, + 'verbose' => \$verbose, 'save-temps' => \$save_temps, @@ -110,7 +127,7 @@ pod2usage( -msg => "Invalid job_type: $job_type", -exitval =>1 ) - unless ($job_type eq 'stamp' or $job_type eq 'get_image'); - -if ($job_type eq 'stamp') { + unless ($job_type eq 'stamp' or $job_type eq 'get_image' or $job_type eq 'listtargets'); + +if (($job_type eq 'stamp') or ($job_type eq 'listtargets')) { if (defined $list) { pod2usage( -msg => "--ra --dec --x --y are not used with --list", -exitval =>1 ) @@ -152,6 +169,7 @@ $id = 0 if !$id; -unless ($stage eq 'raw' or $stage eq 'chip' or $stage eq 'warp' or $stage eq 'diff' or $stage eq 'stack') { - die "$stage is not a valid value for stage\n"; + +unless (($job_type eq 'listtargets' and $stage eq 'exposure') or $stage eq 'raw' or $stage eq 'chip' or $stage eq 'warp' or $stage eq 'diff' or $stage eq 'stack') { + die "$stage is not a valid stage for $job_type jobs\n"; } @@ -207,16 +225,16 @@ } else { $rows = []; - push @$rows, buildRow("", $comment, $x, $y, $filter, $mjd_min, $mjd_max); + push @$rows, buildRow("", $comment, $x, $y, $filter, $mjd_min, $mjd_max, $survey_name, $release, $stack_type); } my ($tdf, $table_def_name) = tempfile ("/tmp/tabledef.XXXX", UNLINK => !$save_temps); -print $tdf "$req_name 1\n"; +print $tdf "$req_name 2\n"; my $rownum = 0; foreach my $row (@$rows) { $rownum++; my $line = "$rownum $row->{ra}\t$row->{dec}\t$width $height" - . " $coord_mask $job_type $option_mask $project $req_type" + . " $coord_mask $job_type $option_mask $project $row->{survey_name} $row->{release} $req_type" . " $stage $id $tess_id $component $data_group" - . " $row->{filter} $row->{mjd_min} $row->{mjd_max}"; + . " $row->{filter} $row->{mjd_min} $row->{mjd_max} $row->{stack_type}"; if ($row->{comment} and $row->{comment} ne '') { @@ -230,4 +248,7 @@ } close $tdf; + +system "cat $table_def_name"; +#exit 0; { @@ -277,6 +298,9 @@ $row->{dec} = checkDEC($vals[1], $linenumber); $row->{filter} = checkFilter($vals[2], $filter, $linenumber); - $row->{mjd_min} = checkMJD($vals[3], $mjd_min, $linenumber);; - $row->{mjd_max} = checkMJD($vals[4], $mjd_max, $linenumber);; + $row->{mjd_min} = checkMJD($vals[3], $mjd_min, $linenumber); + $row->{mjd_max} = checkMJD($vals[4], $mjd_max, $linenumber); + $row->{survey_name} = $vals[5]; + $row->{release} = $vals[6]; + $row->{stack_type} = $vals[7]; $row->{comment} = $comment; Index: trunk/pstamp/scripts/pstamp_finish.pl =================================================================== --- trunk/pstamp/scripts/pstamp_finish.pl (revision 34445) +++ trunk/pstamp/scripts/pstamp_finish.pl (revision 34447) @@ -107,7 +107,8 @@ my ($header, $rows) = read_request_file($req_file); - if (!$header or !$rows) { - # Since a request got queued, the request file must have been readable at some - # point + my $action = $header->{ACTION}; + + if (!$header or (($action eq 'PROCESS') and !$rows)) { + # Since a request got queued, the request file must have been readable at some point my_die("failed to read request file $req_file", $req_id, $PS_EXIT_CONFIG_ERROR); } @@ -126,152 +127,158 @@ } - # The results table definition file - my ($tdf, $table_def_name) = tempfile ("$outdir/tabledef.XXXX", UNLINK => !$save_temps); - - # data for the header - print $tdf "$req_name|$req_id|\n"; - - # get the list of jobs generated for this request - my @jobs; - { - my $command = "$pstamptool -listjob -req_id $req_id"; - $command .= " -dbname $dbname" if $dbname; - $command .= " -dbserver $dbserver" if $dbserver; - my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = - run(command => $command, verbose => $verbose); - unless ($success) { - die("Unable to perform $command error code: $error_code"); - } - my $output = join "", @$stdout_buf; - if (!$output) { - # This should not happen. A fake job should have been entered - my_die("Request $req_id produced no jobs", $req_id, $PS_EXIT_PROG_ERROR); - } else { - my $jobs = parse_md_fast($mdcParser, $output); - - @jobs = @$jobs; - } - } - - my $exp_info; - foreach my $job (@jobs) { - my $job_id = $job->{job_id}; - my $job_type = $job->{jobType}; - my $rownum = $job->{rownum}; - my $fault = $job->{fault}; - my $exp_id = $job->{exp_id}; - - my $error_string = get_error_string($fault); - - if (($fault eq $PSTAMP_DUP_REQUEST) and ($req_name eq "NULL")) { - # this request had a duplicate request name yet the parser didn't give - # it an "ERROR style name. - my_die("duplicate request not given a request name", $req_id, $PS_EXIT_PROG_ERROR); - } - my ($row, $req_info, $project) = get_request_info($rows, $rownum); - - my $proj_hash = resolve_project($ipprc, $project, $dbname, $dbserver); - my $image_db = $proj_hash->{dbname}; - if (!$image_db and !$fault) { - # if project isn't resolvable, the paser should have faulted this job - my_die("failed to find imagedb for project $project", $req_id, $PS_EXIT_CONFIG_ERROR); - } - - my $job_params = get_job_parameters($job); - my $stage = ""; - if ($job_params) { - $stage = $job_params->{stage}; - } - - if ($stage ne 'stack') { - # get the metadata for the exposure (if any i.e. stack) - # returns an appropriate string if !$exp_id - $exp_info = get_exposure_info($job_params, $image_db, $exp_id); - } else { - my $filter = $job_params->{filter}; - $filter = "0" if !$filter; - my $mjd_obs = $job_params->{mjd_obs}; - $mjd_obs = "0" if !$mjd_obs; - $exp_info = "$mjd_obs|0|0|$filter|0|0"; - } - - if (($job_type eq "stamp") || ($job_type eq "get_image") || ($job_type eq "none")) { - my $jreglist = "$outdir/reglist$job_id"; - if (open JRL, "<$jreglist") {; - # process the reglist file to get the list of files produced by this job - foreach my $line () { - - # XXX: we are getting many cases where the size and/or md5sum calculated by - # the job has changed by the time the request_finish has run - # Don't - # add line to the requests's reglist - # .... -# print $rlf $line; - - - chomp $line; - my ($img_name, $reported_size, $reported_sum, $filetype) = split '\|', $line; - # ... instead let dsreg compute the paramters by leaving them blank - print $rlf "$img_name|||$filetype|\n"; - - # add line to the table definition file - print $tdf "$rownum|$fault|$error_string|$img_name|$job_id|"; - - # ra_deg and dec_deg are the coordinates of center of the stamp - # first assume that the image is compressed and check the first extension. - # If not found check the PHU. If that doesn't work just set them to zero. - # XXX do this more cleanly - my (undef, $ra_deg, $dec_deg) = split " ", `echo $outdir/$img_name | fields -x 0 RA_DEG DEC_DEG`; - if (!defined $ra_deg) { - (undef, $ra_deg, $dec_deg) = split " ", `echo $outdir/$img_name | fields RA_DEG DEC_DEG`; + my $request_fault = 0; + if ($action eq 'PROCESS') { + # The results table definition file + my ($tdf, $table_def_name) = tempfile ("$outdir/tabledef.XXXX", UNLINK => !$save_temps); + # data for the header + print $tdf "$req_name|$req_id|\n"; + # get the list of jobs generated for this request + my @jobs; + { + my $command = "$pstamptool -listjob -req_id $req_id"; + $command .= " -dbname $dbname" if $dbname; + $command .= " -dbserver $dbserver" if $dbserver; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + die("Unable to perform $command error code: $error_code"); + } + my $output = join "", @$stdout_buf; + if (!$output) { + # This should not happen. A fake job should have been entered + my_die("Request $req_id produced no jobs", $req_id, $PS_EXIT_PROG_ERROR); + } else { + my $jobs = parse_md_fast($mdcParser, $output); + + @jobs = @$jobs; + } + } + + my $exp_info; + foreach my $job (@jobs) { + my $job_id = $job->{job_id}; + my $job_type = $job->{jobType}; + my $rownum = $job->{rownum}; + my $fault = $job->{fault}; + my $exp_id = $job->{exp_id}; + + my $error_string = get_error_string($fault); + + if (($fault eq $PSTAMP_DUP_REQUEST) and ($req_name eq "NULL")) { + # this request had a duplicate request name yet the parser didn't give + # it an "ERROR style name. + my_die("duplicate request not given a request name", $req_id, $PS_EXIT_PROG_ERROR); + } + my ($row, $req_info, $project) = get_request_info($rows, $rownum); + + my $proj_hash = resolve_project($ipprc, $project, $dbname, $dbserver); + my $image_db = $proj_hash->{dbname}; + if (!$image_db and !$fault) { + # if project isn't resolvable, the paser should have faulted this job + my_die("failed to find imagedb for project $project", $req_id, $PS_EXIT_CONFIG_ERROR); + } + + my $job_params = get_job_parameters($job); + my $stage = ""; + if ($job_params) { + $stage = $job_params->{stage}; + } + + if ($stage ne 'stack') { + # get the metadata for the exposure (if any i.e. stack) + # returns an appropriate string if !$exp_id + $exp_info = get_exposure_info($job_params, $image_db, $exp_id); + } else { + my $filter = $job_params->{filter}; + $filter = "0" if !$filter; + my $mjd_obs = $job_params->{mjd_obs}; + $mjd_obs = "0" if !$mjd_obs; + $exp_info = "$mjd_obs|0|0|$filter|0|0"; + } + + if (($job_type eq "stamp") || ($job_type eq "get_image") || ($job_type eq "none")) { + my $jreglist = "$outdir/reglist$job_id"; + if (open JRL, "<$jreglist") {; + # process the reglist file to get the list of files produced by this job + foreach my $line () { + + # XXX: we are getting many cases where the size and/or md5sum calculated by + # the job has changed by the time the request_finish has run + # Don't + # add line to the requests's reglist + # .... + # print $rlf $line; + + + chomp $line; + my ($img_name, $reported_size, $reported_sum, $filetype) = split '\|', $line; + # ... instead let dsreg compute the paramters by leaving them blank + print $rlf "$img_name|||$filetype|\n"; + + # add line to the table definition file + print $tdf "$rownum|$fault|$error_string|$img_name|$job_id|"; + + # ra_deg and dec_deg are the coordinates of center of the stamp + # first assume that the image is compressed and check the first extension. + # If not found check the PHU. If that doesn't work just set them to zero. + # XXX do this more cleanly + my (undef, $ra_deg, $dec_deg) = split " ", `echo $outdir/$img_name | fields -x 0 RA_DEG DEC_DEG`; + if (!defined $ra_deg) { + (undef, $ra_deg, $dec_deg) = split " ", `echo $outdir/$img_name | fields RA_DEG DEC_DEG`; + } + $ra_deg = 0.0 if (!$ra_deg); + $dec_deg = 0.0 if (!$dec_deg); + print $tdf "$ra_deg|$dec_deg|"; + + print $tdf "$exp_info|"; + print $tdf "$req_info|"; + print $tdf "\n"; } - $ra_deg = 0.0 if (!$ra_deg); - $dec_deg = 0.0 if (!$dec_deg); - print $tdf "$ra_deg|$dec_deg|"; - + close JRL; + } else { + my_die("No reglist for successful job: $job_id", $req_id, $PS_EXIT_PROG_ERROR) + if $fault eq $PSTAMP_SUCCESS; + print STDERR "no reglist file for job $job_id\n" if $verbose; + print $tdf "$rownum|$fault|$error_string|0|$job_id|"; + print $tdf "0|0|"; # center of (non-existent) stamp print $tdf "$exp_info|"; print $tdf "$req_info|"; print $tdf "\n"; } - close JRL; } else { - my_die("No reglist for successful job: $job_id", $req_id, $PS_EXIT_PROG_ERROR) - if $fault eq $PSTAMP_SUCCESS; - print STDERR "no reglist file for job $job_id\n" if $verbose; - print $tdf "$rownum|$fault|$error_string|0|$job_id|"; - print $tdf "0|0|"; # center of (non-existent) stamp - print $tdf "$exp_info|"; - print $tdf "$req_info|"; - print $tdf "\n"; - } - } else { - # XXX do list jobs - # we can probably arange things to use the code as above and skip the fileset registration - print STDERR "Unknown jobType: $job_type"; - next; - } - } - close $rlf; - close $tdf; - my $request_fault = 0; - # make the results file - { - my $command = "$pstamp_results --input $table_def_name --output $outdir/results.fits"; - my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = - run(command => $command, verbose => $verbose); - unless ($success) { - print STDERR "Unable to perform $command error code: $error_code\n"; - $request_fault = $error_code >> 8; - } else { - # dump a textual representation - my $command = "$pstampdump $outdir/results.fits > $outdir/results.mdc"; + # XXX do list jobs + # we can probably arange things to use the code as above and skip the fileset registration + print STDERR "Unknown jobType: $job_type"; + next; + } + } + close $tdf; + # make the results file + { + my $command = "$pstamp_results --input $table_def_name --output $outdir/results.fits"; my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $command, verbose => $verbose); unless ($success) { + print STDERR "Unable to perform $command error code: $error_code\n"; $request_fault = $error_code >> 8; - my_die("Unable to perform $command error code: $error_code", $req_id, $request_fault); - } - } - } + } else { + # dump a textual representation + my $command = "$pstampdump $outdir/results.fits > $outdir/results.mdc"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + $request_fault = $error_code >> 8; + my_die("Unable to perform $command error code: $error_code", $req_id, $request_fault); + } + } + } + } elsif ($action ne 'LIST') { + my_die("Unexpected action $action found", $req_id, $PS_EXIT_PROG_ERROR); + } else { + # pstampparse did all of the work + } + + close $rlf; + if (!$request_fault) { # register the fileset Index: trunk/pstamp/scripts/pstamp_request_file =================================================================== --- trunk/pstamp/scripts/pstamp_request_file (revision 34445) +++ trunk/pstamp/scripts/pstamp_request_file (revision 34447) @@ -49,8 +49,57 @@ value => undef }, + { name => 'ACTION', + writetype => TSTRING, + comment => 'Action to perform: LIST or PROCESS', + value => undef + }, + { name => 'USERNAME', + writetype => TSTRING, + comment => 'username for request (optional)', + value => undef + }, + { name => 'EMAIL', + writetype => TSTRING, + comment => 'email for submittor (optional)', + value => undef + }, ]; # Specification of columns to write my $columns = [ + { name => 'ROWNUM', type => 'J', writetype => TULONG }, + + { name => 'CENTER_X', type => 'D', writetype => TDOUBLE }, + { name => 'CENTER_Y', type => 'D', writetype => TDOUBLE }, + { name => 'WIDTH', type => 'D', writetype => TDOUBLE }, + { name => 'HEIGHT', type => 'D', writetype => TDOUBLE }, + # 2 bits in COORD_MASK indicate what units of roi coords are + { name => 'COORD_MASK', type => 'J', writetype => TULONG }, + + { name => 'JOB_TYPE', type => '16A', writetype => TSTRING }, + { name => 'OPTION_MASK',type => 'J', writetype => TULONG }, + + # image selection parameters + { name => 'PROJECT', type => '16A', writetype => TSTRING }, + # new in version 2 + { name => 'SURVEY_NAME',type => '16A', writetype => TSTRING }, + { name => 'IPP_RELEASE', type => '16A', writetype => TSTRING }, + # end of new in version 2 + { name => 'REQ_TYPE', type => '16A', writetype => TSTRING }, + { name => 'IMG_TYPE', type => '16A', writetype => TSTRING }, + { name => 'ID', type => '16A', writetype => TSTRING }, + { name => 'TESS_ID', type => '64A', writetype => TSTRING }, + { name => 'COMPONENT', type => '64A', writetype => TSTRING }, + + { name => 'DATA_GROUP ',type => '64A', writetype => TSTRING }, + + { name => 'REQFILT', type => '16A', writetype => TSTRING }, + { name => 'MJD_MIN', type => 'D', writetype => TDOUBLE }, + { name => 'MJD_MAX', type => 'D', writetype => TDOUBLE }, + { name => 'RUN_TYPE', type => '16A', writetype => TSTRING }, + + { name => 'COMMENT ', type => '64A', writetype => TSTRING }, +]; +my $columns_v1 = [ { name => 'ROWNUM', type => 'J', writetype => TULONG }, @@ -89,4 +138,6 @@ } +# build array of arrays for the column data. Note if the input file is version 1 then +# some of thes will get dropped my @colData; foreach (@$columns) { @@ -96,5 +147,6 @@ my $minimum_cols = 6; -my $numRows = read_data_for_table($in,'\s+', \@colData, $header, $minimum_cols); +my $extver = 2; +my $numRows = read_data_for_table($in,'\s+', \@colData, $header, $minimum_cols, \$extver); if (!$numRows) { print STDERR "no data in $input\n"; @@ -115,5 +167,5 @@ $output = $req_name . ".fits" if !$output; -my $status = make_fits_table($output, EXTNAME, $numRows, \@colData, $columns, $header); +my $status = make_fits_table($output, EXTNAME, $numRows, \@colData, $extver > 1 ? $columns : $columns_v1, $header); exit $status; @@ -230,4 +282,5 @@ my $header = shift; # rerence to array of header keyword descriptions my $minimum_required_vals = shift; + my $r_extver = shift; # reference to extension version my $line_num = 0; @@ -243,13 +296,34 @@ my @vals = split /$sep/, $line; my $nvals = @vals; - die "number of header columns in input $nvals does not equal expected number of header words $nhead" + die "two few columns $nvals in header definition. Require at least 2" if @vals < 2; + + $$r_extver = $vals[1]; + if ($extver > 1) { + die "number of header columns in input $nvals does not equal expected number of header words $nhead" if (@vals != @$header); - - for (my $i=0; $i < @$header; $i++) { - $header->[$i]->{value} = $vals[$i]; - } - - last; # only one header line - } + } else { + # drop header keywords not used in version 1 + for (my $i = @$header - 1; $i >= $nvals; $i--) { + pop @$header; + } + } + + for (my $i=0; $i < $nvals; $i++) { + my $val = $vals[$i]; + if (defined $val) { + $header->[$i]->{value} = $val; + } else { + $header->[$i]->{value} = 'null'; + } + } + + last; # one line defines the header + } + } + if ($$r_extver == 1) { + # pop off the colData arrays to account for the unused columns + pop @colData; + pop @colData; + pop @colData; } @@ -271,4 +345,6 @@ exit 1; } + # trim leading whitespace from comment + $comment =~ s/^\s+//; if ($comment) { if ($comment =~ /#/) { @@ -381,7 +457,7 @@ print "If --output is omitted the output file name is set to REQ_NAME.fits\n\n"; print "Header 1 Line. Format:\n\n"; - print " REQ_NAME EXTVER\n\n"; + print "REQ_NAME EXTVER ACTION USERNAME EMAIL\n\n"; print "REQUEST specification (1 or more lines). Format:\n\n"; - print " ROWNUM CENTER_X CENTER_Y WIDTH HEIGHT COORD_MASK JOB_TYPE OPTION_MASK PROJECT REQ_TYPE IMG_TYPE ID TESS_ID COMPONENT DATA_GROUP REQFILT MJD_MIN MJD_MAX | COMMENT\n\n"; + print "ROWNUM CENTER_X CENTER_Y WIDTH HEIGHT COORD_MASK JOB_TYPE OPTION_MASK PROJECT SURVEY_NAME IPP_RELEASE REQ_TYPE IMG_TYPE ID TESS_ID COMPONENT DATA_GROUP REQFILT MJD_MIN MJD_MAX RUN_TYPE | COMMENT\n\n"; exit 0; Index: trunk/pstamp/scripts/pstamp_targetlist_file.pl =================================================================== --- trunk/pstamp/scripts/pstamp_targetlist_file.pl (revision 34447) +++ trunk/pstamp/scripts/pstamp_targetlist_file.pl (revision 34447) @@ -0,0 +1,292 @@ +#!/bin/env perl + +# program to create a fits binary table with EXTNAME PS1_PS_TARGETLIST + +use warnings; +use strict; + +use Astro::FITS::CFITSIO qw( :constants ); +Astro::FITS::CFITSIO::PerlyUnpacking(1); +use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt ); +use Pod::Usage qw( pod2usage ); +use Math::Trig; +use Data::Dumper; + +use constant EXTNAME => 'PS1_PS_TARGETLIST'; # Extension name for output table +use constant EXTVER => 2; + +my ( $input, # Name of input Detectabilty Query table + $output, # Name of output table + $save_temps, # Save temporary files? + ); + +GetOptions( + 'input|i=s' => \$input, + 'output|o=s' => \$output, + 'save-temps' => \$save_temps, +) or pod2usage( 2 ); + +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; +pod2usage( -msg => "Required options: --input --output", + -exitval => 3) + unless defined $input + and defined $output; + + +# The header kewords +my $header = [ + { name => 'REQ_NAME', + writetype => TSTRING, + comment => 'Postage Stamp Request Name', + value => undef + }, + { name => 'REQ_ID', + writetype => TLONGLONG, + comment => 'Postage Stamp Server Request id', + value => undef + }, +]; + +# Specification of columns to write +my $columns = [ + # rownum from original request + { name => 'ROWNUM', type => 'V', writetype => TULONG }, + + # single exposure results + { name => 'FPA_ID', type => '20A', writetype => TSTRING }, + { name => 'EXP_ID', type => 'V', writetype => TULONG }, + { name => 'CHIP_ID', type => 'V', writetype => TULONG }, + { name => 'CHIP_READY', type => '2A', writetype => TSTRING}, +# { name => 'CAM_ID', type => 'V', writetype => TULONG }, + { name => 'WARP_ID', type => 'V', writetype => TULONG }, + { name => 'WARP_READY', type => '2A', writetype => TSTRING}, + + # stack columns + { name => 'STACK_ID', type => 'V', writetype => TULONG }, + { name => 'STACK_FAILED', type => '2A', writetype => TSTRING}, + { name => 'SEEING', type => 'D', writetype => TDOUBLE }, + + # stack and diff specific columns + { name => 'TESS_ID', type => '64A', writetype => TSTRING }, + { name => 'SKYCELL_ID', type => '64A', writetype => TSTRING }, + { name => 'RUN_TYPE', type => '64A', writetype => TSTRING }, + + # actual start time of exposure + { name => 'MJD_OBS', type => 'D', writetype => TDOUBLE }, + # field center at midpoint of expsure, in degrees + { name => 'RA_OBS', type => 'D', writetype => TDOUBLE }, + # field center at midpoint of expsure, in degrees + { name => 'DEC_OBS', type => 'D', writetype => TDOUBLE }, + # actual filter + { name => 'FILTER', type => '16A', writetype => TSTRING }, + # exposure time of parent image + { name => 'EXPTIME', type => 'D', writetype => TDOUBLE }, + + # the following are copied from the original pstamp request + + # image selection parameters + { name => 'PROJECT', type => '16A', writetype => TSTRING }, + { name => 'SURVEY_NAME',type => '64A', writetype => TSTRING }, + { name => 'IPP_RELEASE',type => '64A', writetype => TSTRING }, + { name => 'REQ_TYPE', type => '16A', writetype => TSTRING }, + { name => 'IMG_TYPE', type => '16A', writetype => TSTRING }, + { name => 'ID', type => '16A', writetype => TSTRING }, + { name => 'DATA_GROUP', type => '64A', writetype => TSTRING }, + + # error code from processing this row + { name => 'ERROR_CODE',type => 'V', writetype => TULONG }, + # error string correspoding to ERROR_CODE + { name => 'ERROR_STR',type => '24A', writetype => TSTRING }, + + # from original request + { name => 'COMMENT', type => '64A', writetype => TSTRING }, + +]; + +my $in; +if ($input eq '-') { + $in = \*STDIN; +} else { + open $in, "<$input" or die "cannot open $input for reading"; +} + +my @colData; +my $i = 0; +foreach my $col (@$columns) { + print "$i $col->{name}\n"; + push @colData, []; + $i++; +} + + +my $numRows = read_data_for_table($in,'\|', \@colData, $header); +if (!$numRows) { + print STDERR "no data in $input\n"; + exit 1; +} + +my $status = make_fits_table($output, EXTNAME, $numRows, \@colData, $columns, $header); + +exit $status; + +# TODO: put this in a module + +# two utility functions that may be used to create a FITS binary +# table from hashes describing the header keywords and columns + +# read_table_description reads the data for a table from a simple text file +# make_fits_table writes out the table to a named file + + +# A function to build a fits binary table from supplied data +# +sub make_fits_table { + my $output = shift; # name of output file + my $extname = shift; # extension name + my $numRows = shift; # number of rows in the table + my $colData = shift; # ref to array of arrays containing the data for each column + my $columns = shift; # ref to array of column descriptions (each a hash) + # with keys: name, type, and writetype + my $header = shift; # ref to array of header keyword descriptions - each a hash + # with keys: name, name, writetype, comment, and value + my $status = 0; + + die "incorrect arguments" if !defined($columns); + # note $header can be nil + + # build arrays for cfitsio + my @colNames; # Names of columns + my @colTypes; # Types of columns + my @colWriteType; # type to use to write + + foreach my $colSpec ( @$columns) { + push @colNames, $colSpec->{name}; + push @colTypes, $colSpec->{type}; + push @colWriteType, $colSpec->{writetype}; + } + + if (-e $output) { + unlink "$output" or die "failed to remove existing $output"; + } + + my $outFits = Astro::FITS::CFITSIO::create_file( $output, $status ); # Output file handle + check_fitsio( $status ); + + $outFits->create_img( 16, 0, undef, $status ); + check_fitsio( $status ); + + # Create the table + + $outFits->create_tbl( BINARY_TBL(), $numRows, scalar @colNames, + \@colNames, \@colTypes, undef, $extname, $status ); + check_fitsio( $status ); + + # if header keyword descriptions were provided add them + if ($header) { + foreach my $headerword ( @$header ) { + my $value = $headerword->{value}; + unless (defined $value) { + print "Can't find header keyword $headerword\n"; + next; + } + # zap quotation marks + $value =~ s/\'//g; + my $name = $headerword->{name}; + my $type = $headerword->{writetype}; + my $comment = $headerword->{comment}; + $outFits->write_key( $type, $name, $value, $comment, $status ); + check_fitsio( $status ); + } + } + + + for (my $i = 0; $i < scalar @colNames; $i++) { + my $writeType = $colWriteType[$i]; + $outFits->write_col( $writeType, $i + 1, 1, 1, $numRows, $colData->[$i], $status ); + check_fitsio( $status ); + } + + $outFits->close_file( $status ); + + return 0; + +} # end of sub make_fits_table + + + +# read the table contents from a file +# +# input text file format: +# lines that begin with '#' are comment lines and are skipped. +# other lines are data. Each data line is split into fields with the +# provided separator +# +# if $header is not null header the first non-commented line is read to +# fill the value for each header keyword. The number of fields must match +# the number of keywords. +# +# Following the optional header data, each data line contains data for each +# row in the table. The number of fields must match the number of column +# arrays provided. + +sub read_data_for_table { + my $in = shift; # input file handle + my $sep = shift; # string containing field separator + my $colData = shift; # reference to an array of arrays for the data + my $header = shift; # rerence to array of header keyword descriptions + + my $line_num = 0; + + # read data for header if any data is expected + if ($header) { + my $nhead = @$header; + while (my $line = <$in>) { + $line_num++; + next if ($line =~ /^#/); # skip comment lines + chomp $line; + my @vals = split /$sep/, $line; + my $nvals = @vals; + die "number of header columns in input $nvals does not equal expected number of header words $nhead" + if (@vals != @$header); + + for (my $i=0; $i < @$header; $i++) { + $header->[$i]->{value} = $vals[$i]; + } + + last; # only one header line + } + } + + my $row_num = 0; + my $ncols = @$colData; + while (my $line = <$in>) { + $line_num++; + next if ($line =~ /^#/); # skip comment lines + chomp $line; + + my @vals = split /$sep/, $line; + my $nvals = @vals; + die "number of columns $nvals in input does not equal expected number of header " + . " words $ncols on line $line_num" if ($nvals != $ncols); + + for (my $col = 0; $col < @$colData; $col++) { + $colData->[$col]->[$row_num] = $vals[$col]; + } + $row_num++; + } + + # we return the number of rows read + return $row_num; +} + +# From Astro::FITS::CFITSIO demo +sub check_fitsio +{ + my $status = shift; # Status of FITSIO calls + + if ($status != 0) { + my $msg; # Message to output + Astro::FITS::CFITSIO::fits_get_errstatus( $status , $msg ); + die "CFITSIO error: $msg\n"; + } +} Index: trunk/pstamp/scripts/pstampparse.pl =================================================================== --- trunk/pstamp/scripts/pstampparse.pl (revision 34445) +++ trunk/pstamp/scripts/pstampparse.pl (revision 34447) @@ -93,5 +93,5 @@ my $fields_output; { - my $command = "echo $request_file_name | $fields -x 0 EXTNAME EXTVER REQ_NAME"; + my $command = "echo $request_file_name | $fields -x 0 EXTNAME EXTVER REQ_NAME ACTION USER EMAIL"; my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = run(command => $command, verbose => $verbose); @@ -102,5 +102,5 @@ $fields_output = join "", @$stdout_buf; } -my (undef, $extname, $extver, $req_name) = split " ", $fields_output; +my (undef, $extname, $extver, $req_name, $action, $username, $email) = split " ", $fields_output; # make sure the file contains what we are expecting @@ -109,5 +109,5 @@ my_die("$request_file_name is not a PS1_PS_REQEST", $PS_EXIT_PROG_ERROR) if $extname ne "PS1_PS_REQUEST"; my_die("REQ_NAME not found in $request_file_name", $PS_EXIT_PROG_ERROR) if (!$req_name); -my_die("wrong EXTVER $extver found in $request_file_name", $PS_EXIT_PROG_ERROR) if ($extver ne "1"); +my_die("wrong EXTVER $extver found in $request_file_name", $PS_EXIT_PROG_ERROR) if ($extver ne "1" and $extver ne "2"); @@ -230,5 +230,5 @@ # the images of interest for this new row doesn't match the list. # process the list ... - $num_jobs += processRows(\@rowList); + $num_jobs += processRows($action, \@rowList); # and reset the list to contain just the new row @@ -238,8 +238,8 @@ # out of rows process the list if (scalar @rowList > 0) { - $num_jobs += processRows(\@rowList); -} - -if (($mode eq "queue_job") and ($num_jobs eq 0)) { + $num_jobs += processRows($action, \@rowList); +} + +if (($action eq 'LIST' or $mode eq "queue_job") and ($num_jobs eq 0)) { print STDERR "no jobs created for $req_name\n" if $verbose; insertFakeJobForRow(undef, 0, $PSTAMP_INVALID_REQUEST); @@ -387,7 +387,20 @@ } -sub processRows { +sub list_targets { my $rowList = shift; my $num_jobs = 0; + + $num_jobs = 1; + return $num_jobs; +} + +sub processRows { + my $action = shift; + my $rowList = shift; + my $num_jobs = 0; + + if ($action eq 'LIST') { + return list_targets($rowList); + } # all rows in the list are compatible