Index: /trunk/tools/fixburntool
===================================================================
--- /trunk/tools/fixburntool	(revision 34364)
+++ /trunk/tools/fixburntool	(revision 34364)
@@ -0,0 +1,121 @@
+#!/usr/bin/env perl
+
+# script to regenrate the burntool table for a single exp_id/class_id
+# Moves and then deletes existing file if found
+
+use strict;
+use warnings;
+use Carp;
+use IPC::Cmd 0.36 qw( can_run run );
+use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt );
+use Pod::Usage qw( pod2usage );
+use PS::IPP::Metadata::Config;
+use PS::IPP::Metadata::List qw( parse_md_list );
+use PS::IPP::Config 1.01 qw( :standard );
+
+
+my $missing_tools;
+my $regtool = can_run('regtool') or (warn "Can't find regtool" and $missing_tools = 1);
+my $burntool = can_run('ipp_apply_burntool_single.pl') or (warn "Can't find ipp_burntool_apply_single.pl" 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 $exp_id;
+my $class_id;
+my $dbname = 'gpc1';
+my $verbose = 1;
+GetOptions(
+    'exp_id|e=s'    => \$exp_id,
+    'class_id|c=s'  => \$class_id,
+    'verbose|v'     => \$verbose,
+) or pod2usage( 2 );
+
+die "usage: $0 (exp_id) (class_id)\n" unless $class_id and $exp_id;
+
+$regtool  .= " -dbname gpc1 -exp_id $exp_id -class_id $class_id";
+$burntool .= " --dbname gpc1";
+
+
+my $regData;
+{
+    my $command = "$regtool -processedimfile";
+    my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
+        run(command => $command, verbose => 0);
+    unless ($success) {
+        $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
+        carp("Unable to perform $command: $error_code");
+        exit $error_code;
+    }
+    my $list = $mdcParser->parse(join "", @$stdout_buf) or die("Unable to parse regtool metadata");
+    my $mdc = parse_md_list($list);
+    $regData = $mdc->[0];
+}
+my $exp_name = $regData->{exp_name};
+my $uri = $regData->{uri};
+
+die "failed to find exp_name in regtool output" unless $exp_name;
+die "failed to find uri in regtool output" unless $uri;
+
+my $table;
+($table = $uri) =~ s/\.fits/\.burn\.tbl/;
+# print "$table\n";
+my $table_exists;
+{
+    my $command = "neb-stat $table";
+    my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
+        run(command => $command, verbose => 0);
+    if ($success) {
+        $table_exists = 1;
+    } else {
+        $table_exists = 0;
+    }
+}
+if ($table_exists) {
+    # file exists
+    my $moved = "$table.bad";
+    my $command = "neb-mv $table $moved";
+    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);
+        carp("Unable to perform $command: $error_code");
+        exit $error_code;
+    }
+    # don't care if this fails
+    system "neb-rm --force $moved";
+}
+
+my $left = substr $exp_name, 0, 6;
+my $num = substr $exp_name, 6, 4;
+my $end = substr $exp_name, 10, 1;
+
+# print "$left $num $end\n";
+
+
+my $prev = $num - 1;
+my $prev_name = sprintf "$left%04d$end", $prev;
+
+my $prev_uri = $uri;
+$prev_uri =~ s/$exp_name/$prev_name/g;
+die "failed" unless $prev_uri;
+# print "$prev_name $prev_uri\n";
+
+
+{
+    my $command = "$burntool --continue 10 --exp_id $exp_id --class_id $class_id --this_uri $uri --previous_uri $prev_uri";
+    print "$command\n";
+    my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
+        run(command => $command, verbose => 0);
+    unless ($success) {
+        $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
+        carp("Unable to perform $command: $error_code");
+        exit $error_code;
+    }
+}
+system "chiptool -dbname $dbname -revertprocessedimfile -exp_id $exp_id -class_id $class_id";
+print "Success\n";
+exit 0;