Index: trunk/pstamp/lib/PStamp.pm =================================================================== --- trunk/pstamp/lib/PStamp.pm (revision 18979) +++ trunk/pstamp/lib/PStamp.pm (revision 18979) @@ -0,0 +1,86 @@ + +package PStamp; + +use strict; +use warnings; + +use vars qw($VERSION); +$VERSION = '1.0'; + +=pod + +=head1 NAME + +PStamp - Perl Module of Postage Stamp Server functions + +=head1 SYNOPSIS + + use PStamp; + + # equivalent to: + + use Pstamp::RequestFile; + +=head1 DESCRIPTION + +This is a convenience module so that that don't have to individualy load (C) all of the common PStamp inteface modules. Please see the POD of the +individual modules for usage information. + +=head1 USAGE + +=head2 Import Parameters + +This module accepts no arguments to it's C method and exports no +I. + +=head2 Methods + +None. + +=head1 EXAMPLE PROGRAM + +=cut + +use PStamp::RequestFile; + +=head1 CREDITS + + +=head1 SUPPORT + +Please contact the author directly via e-mail. + +=head1 AUTHOR + +Bill Sweeney + +=head1 COPYRIGHT + +Copyright (C) 2008 Bill Sweeney. All rights reserved. + +This program is free software; you can redistribute it and/or modify it under +the terms of the GNU General Public License as published by the Free Software +Foundation; either version 2 of the License, or (at your option) any later +version. + +This program is distributed in the hope that it will be useful, but WITHOUT ANY +WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A +PARTICULAR PURPOSE. See the GNU General Public License for more details. + +You should have received a copy of the GNU General Public License along with +this program; if not, write to the Free Software Foundation, Inc., 59 Temple +Place - Suite 330, Boston, MA 02111-1307, USA. + +The full text of the license can be found in the LICENSE file included with +this module, or in the L Pod as supplied with Perl 5.8.1 and later. + +=head1 SEE ALSO + +L + +=cut + +1; + +__END__ Index: trunk/pstamp/lib/PStamp/Job.pm =================================================================== --- trunk/pstamp/lib/PStamp/Job.pm (revision 18979) +++ trunk/pstamp/lib/PStamp/Job.pm (revision 18979) @@ -0,0 +1,305 @@ +### +### PStamp/Job.pm +### subroutines and constants related to Postage Stamp Jobs +### + +package PStamp::Job; + +use strict; +use warnings; + +our $VERSION = '1.0'; + +use base qw( Exporter ); + +our @EXPORT_OK = qw( + locate_images + ); +our %EXPORT_TAGS = (standard => [@EXPORT_OK]); + + +use IPC::Cmd 0.36 qw( can_run run ); + +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config qw( :standard ); + +### my @images = locate_images($image_db, $req_type, $img_type, $id, $lookup_class_id, +### $mjd_min, $mjd_max, $filter); + +sub locate_images { + my $ipprc = shift; # required + my $image_db = shift; # required + my $req_type = shift; # required + my $img_type = shift; # required + my $id = shift; # required unless req_type eq bycoord + my $class_id = shift; + my $x = shift; + my $y = shift; + my $mjd_min = shift; + my $mjd_max = shift; + my $filter = shift; + my $verbose = shift; + + # we die in response to bad data in request files + die "Unknown req_type: $req_type" if ($req_type ne "byid") and ($req_type ne "byexp") + and ($req_type ne "bycoord"); + if ($req_type eq "bycoord") { + + # run + # regtool -dbname $image_db -processedimfile -time_begin $mjd_min -time_end = $mjd_max -filter $filter + # + my $results = lookup_bycoord($ipprc, $image_db, $x, $y, $mjd_min, $mjd_max, $filter, $verbose); + + # If the type is raw we're done, otherwise we have more work to do + if ($img_type eq "raw") { + return $results; + } + $req_type = "byexp"; + $id = $results->{exp_name}; + } + + my $results = lookup($ipprc, $image_db, $req_type, $img_type, $id, $class_id, $verbose); + + return $results; +} + +sub lookup { + my $ipprc = shift; + my $image_db = shift; + my $req_type = shift; + my $img_type = shift; + my $id = shift; + my $class_id = shift; + my $verbose = shift; + + my $missing_tools; + my $regtool = can_run('regtool') or (warn "Can't find regtool" and $missing_tools = 1); + my $chiptool = can_run('chiptool') or (warn "Can't find chiptool" and $missing_tools = 1); + my $warptool = can_run('warptool') or (warn "Can't find warptool" and $missing_tools = 1); + my $difftool = can_run('difftool') or (warn "Can't find difftool" and $missing_tools = 1); + my $stacktool = can_run('stacktool') or (warn "Can't find stacktool" and $missing_tools = 1); + if ($missing_tools) { + warn("Can't find required tools."); + exit ($PS_EXIT_CONFIG_ERROR); + } + my $command; + my $id_opt; # option for the lookup + my $mask_name; + my $weight_name; + my $base_name; + my $want_astrom; + my $use_class_id; + + if ($img_type eq "raw") { + $command = "$regtool -processedimfile -dbname $image_db"; + $id_opt = "-exp_id"; + $command .= " -class_id $class_id" if $class_id; + $want_astrom = 0; + $use_class_id = 1; + } elsif ($img_type eq "chip") { + $command = "$chiptool -processedimfile -dbname $image_db"; + $command .= " -class_id $class_id" if $class_id; + $id_opt = "-chip_id"; + $mask_name = "PPIMAGE.CHIP.MASK"; + $weight_name = "PPIMAGE.CHIP.WEIGHT"; + $base_name = "path_base"; # name of the field for the chiptool output + $want_astrom = 1; + $use_class_id = 1; + } elsif ($img_type eq "warp") { + $command = "$warptool -warped -dbname $image_db"; + $id_opt = "-warp_id"; + $mask_name = "PSWARP.OUTPUT.MASK"; + $weight_name = "PSWARP.OUTPUT.WEIGHT"; + $base_name = "path_base"; # name of the field for the warptool output + $want_astrom = 1; + $use_class_id = 1; + } elsif ($img_type eq "diff") { + $command = "$difftool -diffskyfile -dbname $image_db"; + $id_opt = "-diff_id"; + $mask_name = "PPSUB.OUTPUT.MASK"; + $weight_name = "PPSUB.OUTPUT.WEIGHT"; + $base_name = "path_base"; + } elsif ($img_type eq "stack") { + $command = "$stacktool -sumskyfile -dbname $image_db"; + $id_opt = "-stack_id"; + + $mask_name = "PPSTACK.OUTPUT.MASK"; + $weight_name = "PPSTACK.OUTPUT.WEIGHT"; + $base_name = "path_base"; + } else { + die "Unknown img_type supplied: $img_type"; + } + + if ($req_type eq "byid") { + $command .= " $id_opt $id"; + } elsif ($req_type eq "byexp") { + $command .= " -exp_name $id"; + } else { + die "Unknown req_type supplied: $req_type"; + } + + # run the tool 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 $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files + + my $images = parse_md_fast($mdcParser, join "", @$stdout_buf) + or die ("Unable to parse metadata config doc"); + + my $output = []; + + my $camera; + foreach my $image (@$images) { + my $base; + if ($base_name) { + $base = $image->{$base_name}; + # if base is undef then the output pruducts for thjis image are incomplete + # This may only happen for warps. + next if !$base; + } + if (!$camera) { + # This assumes that all images have the same camera + $ipprc->define_camera($image->{camera}); + $camera = $image->{camera}; + } + my $out = {}; + $out->{exp_id} = $image->{exp_id}; + $out->{image} = $image->{uri}; + $out->{state} = $image->{state}; # state is undef for rawExp, but that's ok + $class_id = $image->{class_id} if $use_class_id; + + # find the mask and weight images + if ($base) { + $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->{astrom} = find_astrometry($ipprc, $image) if $want_astrom; + $out->{camera} = $camera; + + push @$output, $out; + } + + return $output; +} + +sub lookup_byexp { + my $ipprc = shift; + my $image_db = shift; + my $img_type = shift; + my $exp_name = shift; + my $class_id = shift; + + return undef; +} + +# $results = lookup_bycoord($ipprc, $image_db, $x, $y, $mjd_min, $mjd_max, $filter); +sub lookup_bycoord { + my $ipprc = shift; + my $image_db = shift; + my $x = shift; + my $y = shift; + my $mjd_min = shift; + my $mjd_max = shift; + my $filter = shift; + my $verbose = shift; + + my $missing_tools; + my $regtool = can_run('regtool') or (warn "Can't find regtool" and $missing_tools = 1); + if ($missing_tools) { + warn("Can't find required tools."); + exit ($PS_EXIT_CONFIG_ERROR); + } + + # XXX TODO: we don't yet do real lookups by cordinate but we can lookup by date and filter + + my $args; + if ($mjd_min) { + my $dateobs_min = mjd_to_dateobs($mjd_min); + $args .= " -dateobs_begin $dateobs_min"; + } + if ($mjd_max) { + my $dateobs_max = mjd_to_dateobs($mjd_max); + $args .= " -dateobs_end $dateobs_max"; + } + if ($filter) { + $args .= " -filter $filter"; + } + + # XXX TODO: This query doesn't work Something appears to be out of + # sync about the times I'm passing and what regtool and or the DB expect + my $command = "$regtool -processedexp -dbname $image_db $args"; + + # run the tool 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 $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 $images = parse_md_fast($mdcParser, $output) or die ("Unable to parse metadata config doc"); + + return $images; +} + +sub find_astrometry { + # + #XXX need to get this from the config as in warp_overlap.pl +# $astrom_name = "PSASTRO.OUTPUT.MEF"; +# $astrom_name = "PSASTRO.OUTPUT"; +# $out->{astrom} = $ipprc->filename($astrom_name, $base, $class_id) if $astrom_name; + return undef; +} + +# 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 of the 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-%02d %02d:%02d:%02d'", $year+1900, $mon+1, $day, $hr, $min, $sec; +} + +1; Index: trunk/pstamp/lib/PStamp/RequestFile.pm =================================================================== --- trunk/pstamp/lib/PStamp/RequestFile.pm (revision 18979) +++ trunk/pstamp/lib/PStamp/RequestFile.pm (revision 18979) @@ -0,0 +1,129 @@ +#!/bin/env perl + +### +### PStamp/RequestFile.pm +### subroutines and constants related to Postage Stamp Request Files +### + +package PStamp::RequestFile; + +use strict; +use warnings; + +our $VERSION = '1.0'; + +use base qw( Exporter ); + +our @EXPORT_OK = qw( + read_request_file + $PSTAMP_CENTER_IN_PIXELS + $PSTAMP_RANGE_IN_PIXELS + $PSTAMP_SELECT_IMAGE + $PSTAMP_SELECT_MASK + $PSTAMP_SELECT_WEIGHT + ); +our %EXPORT_TAGS = (standard => [@EXPORT_OK]); + + +our $PSTAMP_CENTER_IN_PIXELS = 1; +our $PSTAMP_RANGE_IN_PIXELS = 2; + +our $PSTAMP_SELECT_IMAGE = 1; +our $PSTAMP_SELECT_MASK = 2; +our $PSTAMP_SELECT_WEIGHT = 4; + +use IPC::Cmd 0.36 qw( can_run run ); + +use PS::IPP::Metadata::List qw( parse_md_list ); +use PS::IPP::Config qw( :standard ); + +sub read_request_file { + my $request_file_name = shift; + die "need request file name\n" unless $request_file_name; + + my $verbose = shift; + + my $ipprc = PS::IPP::Config->new(); # IPP Configuration + + my $missing_tools; + + my $pstampdump = can_run('pstampdump') or (warn "Can't find pstampdump" and $missing_tools = 1); + my $fields = can_run('fields') or (warn "Can't find fields" and $missing_tools = 1); + + if ($missing_tools) { + warn("Can't find required tools."); + exit ($PS_EXIT_CONFIG_ERROR); + } + + # Parser for metadata config files + my $mdcParser = PS::IPP::Metadata::Config->new; + + # + # get the data from the extension header + # + my $fields_output; + { + my $command = "echo $request_file_name | $fields -x 0 EXTNAME EXTVER REQ_NAME"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + $fields_output = join "", @$stdout_buf; + } + my (undef, $extname, $extver, $req_name) = split " ", $fields_output; + + # make sure the file contains what we are expecting + + die "$request_file_name is not a PS1_PS_REQUEST" + if !$extname or ($extname ne "PS1_PS_REQUEST"); + die "REQ_NAME not found in $request_file_name" if (!$req_name); + die "wrong EXTVER $extver found in $request_file_name" if ($extver ne "1"); + + my %header; + $header{REQ_NAME} = $req_name; + $header{EXTVER} = $extver; + $header{EXTNAME} = $extname; + + # + # now convert the request table to an array of hashes + # + + my $rows; + { + my $command = "$pstampdump $request_file_name"; + my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = + run(command => $command, verbose => $verbose); + unless ($success) { + print STDERR @$stderr_buf; + } + my $table = $mdcParser->parse(join "", @$stdout_buf) or + die("Unable to parse metdata config doc"); + + $rows = parse_md_list($table); + } + + my %req_specs; + foreach my $row (@$rows) { + my $rownum = $row->{ROWNUM}; + $req_specs{$rownum} = $row; + + my $job_type = $row->{JOB_TYPE}; + my $project = $row->{PROJECT}; + my $req_type = $row->{REQ_TYPE}; + my $img_type = $row->{IMG_TYPE}; + my $id = $row->{ID}; + my $class_id = $row->{CLASS_ID}; + my $stamp_name = $row->{STAMP_NAME}; + my $filter = $row->{REQFILT}; + my $mjd_min = $row->{MJD_MIN}; + my $mjd_max = $row->{MJD_MAX}; + my $x = $row->{CENTER_X}; + my $y = $row->{CENTER_Y}; + my $w = $row->{WIDTH}; + my $h = $row->{HEIGHT}; + my $coord_mask = $row->{COORD_MASK}; + my $option_mask= $row->{OPTION_MASK}; + + print "$rownum $req_type $img_type $id\n" if $verbose; + } + return (\%header, \%req_specs); +} +1;