Index: unk/pstamp/lib/PStamp.pm =================================================================== --- /trunk/pstamp/lib/PStamp.pm (revision 19216) +++ (revision ) @@ -1,86 +1,0 @@ - -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: unk/pstamp/lib/PStamp/Job.pm =================================================================== --- /trunk/pstamp/lib/PStamp/Job.pm (revision 19216) +++ (revision ) @@ -1,360 +1,0 @@ -### -### 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); - - $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; - - # special class_id value "null" means all - if ($class_id eq "null") { - $class_id = undef; - } - - 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 - } 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->{camera} = $camera; - $out->{astrom} = find_astrometry($ipprc, $image_db, $image, $verbose) if $want_astrom; - - push @$output, $out; - } - - return $output; -} - -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: - # Full lookups by coordinate require looking at the DVO database. However, - # dateobs and filter which is all that MOPS has asked for. - - 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"; - } - - if (!$args) { - # avoid returning every exposure in the DB - print STDERR "no query arguments provided for bycoord\n"; - return undef; - } - - # 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 - # the query I used in the C version of locateimages used - # WHERE dateobs >= FROM_UNIXTIME(%ld) AND dateobs <= FROM_UNIXTIME(%ld + exp_time) - - 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; -} - -# find the astrometry file for a given exposure -# return undef if no completed camRun exists -sub find_astrometry { - my $ipprc = shift; - my $image_db = shift; - my $image = shift; # hashref to output of the lookup tool - my $verbose = shift; - - my $missing_tools; - my $camtool = can_run("camtool") or (warn "Can't find camtool" and $missing_tools = 1); - my $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" and $missing_tools = 1); - if ($missing_tools) { - warn("Can't find required tools."); - exit ($PS_EXIT_CONFIG_ERROR); - } - - my $command = "$camtool -dbname $image_db -processedexp -exp_id $image->{exp_id}"; - # run the tool and parse the output - my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = - run(command => $command, verbose => $verbose); - unless ($success) { - print STDERR @$stderr_buf; - return undef; - } - - 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 $camruns = parse_md_fast($mdcParser, $output); - if (!$camruns) { - return undef; - } - - # If there are multiple cam runs for this exposure, take the last one - # assuming that it has the best astrometry - my $camdata = pop @$camruns; - if (!$camdata) { - # no cam runs for this exposure id therefore best astrometry is whatever is in the header - return undef; - } - my $camRoot = $camdata->{path_base}; - my $camera = $image->{camera}; - my $astromSource; - { - my $command = "$ppConfigDump -camera $camera -dump-recipe PSWARP -"; - my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) = - run(command => $command, verbose => $verbose); - unless ($success) { - $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR); - die("Unable to perform ppConfigDump: $error_code"); - } - my $metadata = $mdcParser->parse(join "", @$stdout_buf) or - die("Unable to parse metadata config doc"); - $astromSource = metadataLookupStr($metadata, 'ASTROM.SOURCE'); - } - - my $astromFile = $ipprc->filename($astromSource, $camRoot); - - return $astromFile; -} - -# splits meta data config input stream into single units to work around the pathalogically -# slow parser. This is similar to and adapted from code in various 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: unk/pstamp/lib/PStamp/RequestFile.pm =================================================================== --- /trunk/pstamp/lib/PStamp/RequestFile.pm (revision 19216) +++ (revision ) @@ -1,129 +1,0 @@ -#!/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;