Index: /trunk/tools/ipp_apply_burntool.pl
===================================================================
--- /trunk/tools/ipp_apply_burntool.pl	(revision 23542)
+++ /trunk/tools/ipp_apply_burntool.pl	(revision 23542)
@@ -0,0 +1,170 @@
+#!/usr/bin/env perl
+# this program is used to run 'burntool' on images for a single chip
+# for all exposures for a given time period.   
+# USAGE: ipp_apply_burntool.pl --dbname gpc1 --class_id XY00 --dateobs_begin YYYY/MM/DD --dateobs_end YYYY/MM/DD 
+
+# XXX todo:
+# - add filters to processedimfile
+# 
+
+use warnings;
+use strict;
+use Carp;
+
+use IPC::Cmd 0.36 qw( can_run );
+use IPC::Run 0.36 qw( run );
+use PS::IPP::Metadata::List qw( parse_md_list );
+use PS::IPP::Config 1.01 qw( :standard );
+use File::Temp qw( tempfile );
+use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt );
+use Pod::Usage qw( pod2usage );
+
+my ( $class_id, $dateobs_begin, $dateobs_end, $dbname, $verbose, $save_temps);
+GetOptions(
+    'class_id=s'        => \$class_id, # chip identifier
+    'dateobs_begin=s'   => \$dateobs_begin, # exposure date/time range start
+    'dateobs_end=s'     => \$dateobs_end, # exposure date/time range stop
+    'dbname|d=s'        => \$dbname, # Database name
+    'verbose'           => \$verbose,   # Print to stdout
+    'save-temps'        => \$save_temps, # Save temporary files?
+    ) or pod2usage( 2 );
+
+pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV;
+pod2usage(
+          -msg => "Required options: --class_id --dateobs_begin --dateobs_end",
+          -exitval => 3,
+          ) unless
+    defined $class_id and
+    defined $dateobs_begin and
+    defined $dateobs_end;
+
+my $missing_tools;
+my $regtool  = can_run('regtool')  or (warn "Can't find regtool" and $missing_tools = 1);
+my $funpack  = can_run('funpack')  or (warn "Can't find funpack" and $missing_tools = 1);
+my $burntool = can_run('burntool') or (warn "Can't find burntool" and $missing_tools = 1);
+my $fpack    = can_run('fpack')    or (warn "Can't find fpack" and $missing_tools = 1);
+if ($missing_tools) {
+    warn("Can't find required tools.");
+    exit($PS_EXIT_CONFIG_ERROR);
+}
+
+my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files
+
+my $command = "$regtool -processedimfile";
+$command .= " -class_id $class_id";
+$command .= " -dateobs_begin $dateobs_begin";
+$command .= " -dateobs_end $dateobs_end";
+# $command .= " -limit 10";
+$command .= " -dbname $dbname" if defined $dbname;
+
+my @command = split /\s+/, $command;
+my ( $stdin, $stdout, $stderr ); # Buffers for running program
+print "Running [$command]...\n" if $verbose;
+if (not run(\@command, \$stdin, \$stdout, \$stderr)) {
+    &my_die("Unable to perform regtool -processedimfile");
+}
+print $stdout . "\n" if $verbose;
+
+my @files;
+my @whole = split /\n/, $stdout;
+my @single = ();
+while ( scalar @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 ) ) );
+	&my_die("Unable to parse output from regtool") unless defined $list;
+	push @files, @$list;
+	@single = ();
+    }
+}
+
+# IPP configuration (including nebulous)
+my $ipprc = PS::IPP::Config->new() or my_die("Unable to set up");
+
+my $Nfiles = @files;
+print "files: $Nfiles\n";
+
+my $REALRUN = 0;
+
+my $prevFileOpt = "";
+foreach my $file (@files) {
+    my $exp_id = $file->{exp_id};
+
+    my $rawImfile = $file->{uri};
+    my $rawImfileReal;
+    if ($REALRUN) {
+	$rawImfileReal = $ipprc->file_resolve($rawImfile, 0);
+    } else {
+	($rawImfileReal) = $rawImfile =~ m|^neb:/(.*)|;
+    }
+    # print "rawImfile: $rawImfile -> $rawImfileReal\n";
+
+    # mangle name, create tmp file (always a UNIX file)
+    my $basename = `basename $rawImfile`; chomp $basename;
+    my ($tmpImfile, $tmpImfileReal) = tempfile( "/tmp/$basename.XXXX", UNLINK => !$save_temps );
+    # print "tmpImfile: $tmpImfile -> $tmpImfileReal\n";
+    
+    # destination for the burntool-applied image file (may be a NEB file)
+    my $outImfile = $rawImfile;
+    $outImfile =~ s/fits$/burn.fits/;
+    my $outImfileReal = $ipprc->file_resolve($outImfile, 1);
+    # print "outImfile: $outImfile -> $outImfileReal\n";
+
+    # destination for the burntool artifacts
+    my $artImfile = $rawImfile;
+    $artImfile =~ s/fits$/burn.tbl/;
+    my $artImfileReal = $ipprc->file_resolve($artImfile, 1);
+    # print "artImfile: $artImfile -> $artImfileReal\n";
+
+    # uncompress the image (do we need to check if it is compressed?)
+    my $status = vsystem ("$funpack -S $rawImfileReal > $tmpImfileReal", $REALRUN);
+    if ($status) {
+	&my_die("failed on funpack");
+    }
+
+    $status = vsystem ("$burntool $tmpImfileReal out=$artImfileReal $prevFileOpt", $REALRUN);
+    if ($status) {
+	&my_die("failed on burntool");
+    }
+
+    # compress the image (do we need to check if it is compressed?)
+    $status = vsystem ("$fpack -S $tmpImfileReal > $outImfileReal", $REALRUN);
+    if ($status) {
+	&my_die("failed on fpack");
+    }
+
+    $status = vsystem ("$regtool -dbname $dbname -updateprocessedimfile -exp_id $exp_id -class_id $class_id -user_1 1.0", 1);
+    if ($status) {
+	&my_die("failed to update imfile");
+    }
+
+    # save the artifact file for the next image
+    $prevFileOpt = "in=$artImfileReal";
+    print "\n";
+}
+
+exit 0;
+
+sub vsystem {
+    my $command = shift;
+    my $realrun = shift;
+
+    print "$command\n";
+    
+    my $status = 0;
+    if ($realrun) {
+	$status = system ($command);
+    }
+
+    return $status;
+}
+
+sub my_die {
+    my $message = shift;
+
+    printf STDERR "$message\n";
+    exit 1;
+}
