Index: trunk/ippScripts/Build.PL
===================================================================
--- trunk/ippScripts/Build.PL	(revision 26290)
+++ trunk/ippScripts/Build.PL	(revision 26378)
@@ -98,4 +98,5 @@
         scripts/rcserver_checkstatus.pl
         scripts/publish_file.pl
+	scripts/dqstats_bundle.pl
         scripts/whichimage
     )],
Index: trunk/ippScripts/scripts/dqstats_bundle.pl
===================================================================
--- trunk/ippScripts/scripts/dqstats_bundle.pl	(revision 26378)
+++ trunk/ippScripts/scripts/dqstats_bundle.pl	(revision 26378)
@@ -0,0 +1,162 @@
+#! /usr/bin/env perl
+
+use warnings;
+use strict;
+use Carp;
+
+## report the program and machine
+use Sys::Hostname;
+my $host = hostname();
+print "\n\n";
+print "Starting script $0 on $host\n\n";
+
+use DateTime;
+my $mjd_start = DateTime->now->mjd;   # MJD of starting script
+
+use vars qw( $VERSION );
+$VERSION = '0.01';
+
+use IPC::Cmd 0.36 qw( can_run run );
+use PS::IPP::Metadata::Config;
+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 );
+
+# Look for programs we need
+my $missing_tools;
+my $dqstatstool = can_run('dqstatstool') or (warn "Can't find dqstatstool" and $missing_tools = 1);
+my $dsreg       = can_run('dsreg') or (warn "Can't find dsreg" and $missing_tools = 1);
+if ($missing_tools) {
+    warn("Can't find required tools.");
+    exit($PS_EXIT_CONFIG_ERROR);
+}
+
+my ( $exp_tag, $dqstats_id, $camera, $uri, $dbname, $verbose, $no_update, $no_op, $redirect, $save_temps);
+GetOptions(
+	   'exp_tag=s'       => \$exp_tag, # exposure identifier
+	   'dqstats_id=s'    => \$dqstats_id, # dqstatsrun ID
+	   'camera|c=s'      => \$camera,  # camera
+	   'dbname|d=s'      => \$dbname,  # database name
+	   'uri=s'           => \$uri, # output file destination
+	   'verbose'         => \$verbose, # print to stdout
+	   'no-update'       => \$no_update, # Update the database
+	   'no-op'           => \$no_op,   # don't do the operations
+	   'redirect-output' => \$redirect, 
+	   'save-temps'      => \$save_temps, # save temporary files
+	   ) or pod2usage( 2 );
+
+pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV;
+pod2usage( -msg => "Required options --exp_tag --dqstats_id --camera",
+	   -exitval => 3,
+	   ) unless
+    defined $exp_tag and
+    defined $dqstats_id and
+    defined $camera;
+
+my $ipprc = PS::IPP::Config->new( $camera ) 
+    or my_die( "Unable to set up", $dqstats_id, $PS_EXIT_CONFIG_ERROR ); # IPP config
+#my $logDest = $ipprc->filename("LOG.EXP", $uri) 
+#    or my_die("Missing entry from camera config", $dqstats_id, $PS_EXIT_CONFIG_ERROR);
+
+if ($redirect) {
+#    $ipprc->redirect_output($logDest) 
+#	or my_die( "Unable to redirect output", $dqstats_id, $PS_EXIT_SYS_ERROR );
+    print "\n\n";
+    print "Starting script $0 on $host\n\n";
+    print "COMMAND IS: @ARGV\n\n";
+}
+
+my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files
+
+# Output products
+unless (defined($uri)) {
+    $uri = "/data/${host}.0/tmp/dqstats.${dqstats_id}.fits";
+}
+#$ipprc->outroot_prepare($uri); # hm....need to think more here.
+
+my $bundle_command = "$dqstatstool -dbname $dbname  -createbundle ";
+$bundle_command .= "-dqstats_id $dqstats_id ";
+$bundle_command .= "-uri $uri ";
+
+my $filesetID = "dqstats.${dqstats_id}";
+
+unless ($no_op) {
+    # This bit needs to make the bundle.
+    
+    my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
+	run(command => $bundle_command, verbose => $verbose);
+    unless ($success) {
+	$error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
+	&my_die("Unable to create the bundle.: $error_code", $dqstats_id, $error_code);
+    }
+    
+    # Parse stdout_buf to get output file name
+    ## Begin partial
+    my ($tempFile, $tempName) = tempfile( "/tmp/dqstats.XXXX",
+					  UNLINK => !$save_temps, SUFFIX => 'dsin' );
+    print $tempFile $uri . '|||notset' . "\n";
+
+    my $register_cmd = "$dsreg --product 'DQstats' --add $filesetID --type table --list $tempName --abspath --copy";
+
+    # It can't be that simple, can it? This should probably add a fault on failure.
+    ($success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
+	run(command => $register_cmd, verbose => $verbose);
+    unless ($success) {
+	$error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
+	&my_die("Unable to register the bundle.: $error_code", $dqstats_id, $error_code);
+    }
+    
+    # We no longer need the file generated by dqstatstool.
+    unlink($uri);
+}
+
+my $update_command = "$dqstatstool -dbname $dbname  -dqstats_id $dqstats_id";
+$update_command .= " -updaterun -set_state 'full' ";
+
+unless ($no_update) {
+    # This bit needs to set the database state to full
+    my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
+	run(command => $update_command, verbose => $verbose);
+    unless ($success) {
+	$error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
+	warn("Unable to add result to database: $error_code\n");
+	exit($error_code);
+    }
+} else {
+    print "skipping command: $update_command\n";
+}
+
+
+sub my_die
+{
+    my $msg = shift; # Warning message on die
+    my $dqstats_id = shift; # Camtool identifier
+    my $exit_code = shift; # Exit code to add
+
+    $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code;
+
+    carp($msg);
+    if (defined $dqstats_id and not $no_update) {
+	# There is no fault handling, which may be a mistake. This is where a fault coding would be.
+#         my $command = "$addtool -add_id $add_id";
+#         $command .= " -addprocessedexp";
+#         $command .= " -fault $exit_code";
+#         $command .= " -path_base $outroot" if defined $outroot;
+#         $command .= (" -dtime_addstar " . ((DateTime->now->mjd - $mjd_start) * 86400));
+#         $command .= " -dbname $dbname" if defined $dbname;
+#         system ($command);
+    }
+    exit $exit_code;
+}
+
+END {
+    my $status = $?;
+    system("sync") == 0
+        or die "failed to execute sync: $!" ;
+    $? = $status;
+}
+
+__END__
Index: trunk/ippScripts/scripts/register_imfile.pl
===================================================================
--- trunk/ippScripts/scripts/register_imfile.pl	(revision 26290)
+++ trunk/ippScripts/scripts/register_imfile.pl	(revision 26378)
@@ -130,4 +130,5 @@
     }
     elsif (($isGPC1 == 1) && ($burntoolState == 1)) {
+#	print STDERR "In the good region: >>$burntoolState<<\n";
 	my $ppConfigDump_cmd = "$ppConfigDump -camera GPC1 -dump-camera -";
 	my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
@@ -148,4 +149,5 @@
 	}
 	$burntoolState = $burntoolStateGood; # Positive because this has the header table.
+	
     }
     $cmdflags .= " -burntool_state $burntoolState ";
