Index: trunk/tools/repair_bad_instance
===================================================================
--- trunk/tools/repair_bad_instance	(revision 33036)
+++ trunk/tools/repair_bad_instance	(revision 33036)
@@ -0,0 +1,134 @@
+#!/bin/env perl
+
+use strict;
+use warnings;
+
+use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt );
+use Pod::Usage qw( pod2usage );
+use DBI;
+use IPC::Cmd 0.36 qw( can_run run );
+use PS::IPP::Metadata::Config;
+use PS::IPP::Config 1.01 qw( :standard );
+
+
+my ( $exp_id,
+     $class_id,
+     $pretend,
+     $go,
+     );
+my $dbname ='gpc1';
+
+# the char to the right of the bar may be used as a single - alias for the longer name
+# for example --input and -i are equivalent
+GetOptions(
+	   'exp_id|e=s'     => \$exp_id,
+	   'class_id|c=s'   => \$class_id,
+	   'repair'         => \$go,
+	   'pretend'        => \$pretend,
+) or pod2usage( 2 );
+
+pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV;
+# pod2usage( -msg => "Required options: --exp_id --class_id",
+ #           -exitval => 3)
+unless (defined $exp_id and defined $class_id ) {
+    print STDERR "Usage: $0 --exp_id <exp_id> --class_id <class_id> [--repair]\n";
+    exit 1;
+}
+
+$pretend = "" if !$pretend;
+
+# print "supplied parameters: $exp_id $class_id $pretend\n";
+
+my $ipprc =  PS::IPP::Config->new();
+my $dbh = getDBHandle();
+
+my $stmt = $dbh->prepare("SELECT ignored, uri from rawImfile where exp_id = ? and class_id = ?") or die $dbh->errstr;
+
+$stmt->execute($exp_id, $class_id);
+
+my $file = $stmt->fetchrow_hashref();
+
+my $uri = $file->{uri};
+my $ignored = $file->{ignored};
+
+my $output = `neb-locate -p -a $uri`;
+
+if (!$output) {
+    die "failed to locate any instances for $uri\n";
+}
+
+my @files = split "\n", $output;
+
+my $n = scalar @files;
+print "$n instances for $uri:\n";
+my $good_instance;
+my @bad_instances;
+foreach my $instance (@files) {
+    if (check_file($instance)) {
+        print "  $instance is ok\n";
+        $good_instance = $instance;
+    } else {
+        print "  $instance has problems\n";
+        push @bad_instances, $instance;
+    }
+}
+
+if ($good_instance) {
+    foreach my $bad (@bad_instances) {
+        my $cmd =  "cp   $good_instance $bad";
+        print "    $cmd\n";
+        system $cmd if $go;
+    }
+} else {
+    print "No good instances of $uri found. To fix run:\n";
+    my $cmd = "regtool -updateprocessedimfile -set_ignored -exp_id $exp_id -class_id $class_id\n";
+    print "$cmd\n";
+    system $cmd if $go;
+}
+
+
+sub check_file {
+    my $file = shift;
+
+    my $command = "fhead $file | grep NEXTEND | awk '{print \$3}'";
+    my $nextend = `$command`;
+    chomp $nextend;
+    if (!$nextend) {
+        return 0;
+    }
+    print "\t$file: $nextend extensions\n";
+
+    $command = 'fhead -x ' . ($nextend - 1) . " $file | grep EXTNAME | awk '{print \$3}'";
+    my $extname = `$command`;
+    chomp $extname;
+    if (!$extname) {
+        print "\tno EXTNAME found in extension $nextend\n";
+        return 0;
+    }
+
+    return 1;
+}
+
+
+
+
+
+sub getDBHandle {
+    my $dbserver = metadataLookupStr($ipprc->{_siteConfig}, "DBSERVER");
+    my $dbuser = metadataLookupStr($ipprc->{_siteConfig}, "DBUSER");
+    my $dbpassword = metadataLookupStr($ipprc->{_siteConfig}, "DBPASSWORD");
+    if (!$dbname) {
+        $dbname = metadataLookupStr($ipprc->{_siteConfig}, "DBNAME");
+    }
+
+    die "database configuration set up" unless defined($dbserver) and defined($dbuser)
+        and defined($dbpassword) and defined($dbname);
+
+    my $dsn = "DBI:mysql:host=$dbserver;database=$dbname";
+
+    my $dbh = DBI->connect($dsn, $dbuser, $dbpassword) 
+        or die "Cannot connect to database.\n";
+
+    return $dbh;
+}
+