Index: trunk/pstamp/scripts/pstamp_request_file
===================================================================
--- trunk/pstamp/scripts/pstamp_request_file	(revision 25724)
+++ trunk/pstamp/scripts/pstamp_request_file	(revision 25724)
@@ -0,0 +1,319 @@
+#!/usr/bin/env perl
+
+# create a Postage Stamp Request file from a textual description
+
+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 File::Basename;
+
+use constant EXTNAME => 'PS1_PS_REQUEST'; # Extension name for output table
+
+my ( $input,			# Name of input text file
+     $output,			# Name of output table
+     $req_name, 
+     $help
+     );
+
+GetOptions(
+	   'input|i=s'    => \$input,
+	   'output|o=s'   => \$output,
+	   'req_name|j=s' => \$req_name,
+           'help|h'         => \$help,
+) or pod2usage( 2 );
+
+printhelp($0) if $help;
+pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV;
+pod2usage( -msg => "Required options: --input",
+           -exitval => 3) unless defined $input;
+
+# The header kewords
+my $header = [
+        { name =>  'REQ_NAME', 
+                    writetype => TSTRING, 
+                    comment => 'Postage Stamp request name',
+                    value => undef
+        },
+        { name =>  'EXTVER', 
+                    writetype => TSTRING, 
+                    comment => 'Extension version',
+                    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 },
+        { 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 => 'LABEL ',     type => '64A', writetype => TSTRING },
+
+        { name => 'REQFILT',    type => '16A', writetype => TSTRING },
+        { name => 'MJD_MIN',    type => 'D',   writetype => TDOUBLE },
+        { name => 'MJD_MAX',    type => 'D',   writetype => TDOUBLE },
+];
+
+my $in;
+if ($input eq '-') {
+    $in = \*STDIN;
+} else {
+    open $in, "<$input" or die "cannot open $input for reading";
+}
+
+my @colData;
+foreach (@$columns) {
+    push @colData, [];
+}
+
+
+my $minimum_cols = 6;
+my $numRows = read_data_for_table($in,'\s+', \@colData, $header, $minimum_cols); 
+if (!$numRows) {
+    print STDERR "no data in $input\n";
+    exit 1;
+}
+
+# overwrite the REQ_NAME value from the input file with the command
+# line argument
+
+if ($req_name) {
+    $header->[0]->{value} = $req_name;
+} else {
+    $req_name = $header->[0]->{value};
+}
+
+die "no request name defined" unless defined $req_name;
+
+$output = $req_name . ".fits" if !$output;
+
+my $status = make_fits_table($output, EXTNAME, $numRows, \@colData, $columns, $header);
+
+exit $status;
+
+# XXXXX: This should be 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 $minimum_required_vals = shift;
+
+    my $line_num = 0;
+
+    # read data for header if any data is expected
+    if ($header) {
+        my $nhead = @$header;
+        while (my $line = <$in>) {
+            $line_num++;
+            chomp $line;
+            next if !$line;             # skip blank lines
+            next if ($line =~ /^#/);    # skip comment lines
+            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 $num_rows = 0;
+    my $ncols = @$colData;
+    my @last_vals;
+    my %used_ROWNUMS;
+    my $auto_row_num = 0;
+    while (my $line = <$in>) {
+        chomp $line;
+        $line_num++;
+        next if !$line;             # skip blank lines
+        next if ($line =~ /^#/);    # skip comment lines
+
+        my @vals = split /$sep/, $line;
+        my $nvals = @vals;
+        if ($nvals < $minimum_required_vals) {
+            die "Too few values $nvals found at line $line_num. Each row must contain at least $minimum_required_vals columns\n";
+        }
+        if ($nvals < $ncols) {
+            if (!scalar @last_vals) {
+                die "Too few values $nvals found at line $line_num. $ncols values are required\n";
+            }
+            for (my $i = $nvals; $i < $ncols; $i++) {
+                $vals[$i] = $last_vals[$i];
+            }
+        }
+        @last_vals = @vals;
+    
+        # check the input ROWNUM value. If zero set it automatically
+        my $this_ROWNUM = $vals[0];
+        $this_ROWNUM = ++$auto_row_num if $this_ROWNUM eq 0;
+
+        # fail if this ROWNUM value has already been used
+        my $previous = $used_ROWNUMS{$this_ROWNUM};
+        if ($previous) {
+            die "ROWNUM for line $line_num: $this_ROWNUM has already been used at line $previous\n";
+        }
+        $used_ROWNUMS{$this_ROWNUM} = $line_num;
+
+        $colData->[0]->[$num_rows] = $this_ROWNUM;
+        for (my $col = 1; $col < @$colData; $col++) {
+            $colData->[$col]->[$num_rows] = $vals[$col];
+        }
+        $num_rows++;
+    }
+
+    # we return the number of rows read
+    return $num_rows;
+}
+
+# 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";
+    }
+}
+
+sub printhelp
+{
+    my $prog = basename($_[0]);
+
+    print "Create a postage stamp request fits file from a textual description.\n";
+    print "Usage:\n";
+    print "\t$prog --input input_file_name [--req_name request_name] [--output output_file_name ]\n\n";
+    print "If --req_name is provided the REQ_NAME value in the input file is ignored.\n";
+    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 "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 LABEL REQFILT MJD_MIN MJD_MAX\n\n";
+
+    exit 0;
+}