Index: trunk/tools/probe_burntool_states.pl
===================================================================
--- trunk/tools/probe_burntool_states.pl	(revision 28665)
+++ trunk/tools/probe_burntool_states.pl	(revision 28665)
@@ -0,0 +1,245 @@
+#! /usr/bin/env perl
+
+use warnings;
+use strict;
+use Carp;
+use IPC::Cmd 0.36 qw( can_run run);
+use PS::IPP::Metadata::List qw( parse_md_list );
+use PS::IPP::Config 1.01 qw( :standard );
+use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt );
+use Pod::Usage qw( pod2usage );
+use DateTime;
+
+my $debug = 0;
+my $missing_tools = 0;
+my $ppConfigDump = can_run('ppConfigDump') or (warn "Can't find ppConfigDump" 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;
+
+my ($help,$date,$camera,$dbname,$verbose,$bt_state);
+
+GetOptions(
+    'help|h'           => \$help,
+    'date=s'           => \$date,
+    'camera=s'         => \$camera,
+    'dbname=s'         => \$dbname,
+    'verbose'          => \$verbose,
+    'bt_state=s'       => \$bt_state,
+    ) or pod2usage ( 2 );
+pod2usage( -msg =>
+"USAGE: probe_burntool_state.pl <options>
+       Options:
+          --help                 This help
+          --date YYYY-MM-DD      Check only this date.
+          --camera <camera>      Default GPC1.                                                
+          --dbname <db>          Default gpc1.
+          --verbose              
+          --bt_state <value>     Pretend this value is good.\n",
+	   -exitval => 2, ) if (defined($help));
+pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV;
+
+
+unless(defined($camera)) {
+    $camera = 'GPC1';
+}
+unless(defined($dbname)) {
+    $dbname = 'gpc1';
+}
+unless(defined($bt_state)) {
+    $bt_state = get_goodBTvalue();
+}
+# Read the config file for nightly science, and construct a list of targets.
+my @target_list;
+my %object_list;
+my %obsmode_list;
+my %comment_list;
+
+my $conf_cmd = "$ppConfigDump -dump-recipe NIGHTLY_SCIENCE -";
+my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
+    run(command => $conf_cmd, verbose => $debug);
+unless ($success) {
+    $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
+    &my_die("Unable to perform ppConfigDUmp: $error_code", $date, $PS_EXIT_SYS_ERROR);
+}
+
+my $metadata = $mdcParser->parse(join "", @$stdout_buf);
+foreach my $entry (@{ $metadata }) {
+    if (${ $entry }{name} eq 'TARGETS') {
+        my @target_data = @{ ${ $entry }{value} };
+        my $this_target = '';
+        
+        foreach my $tentry (@target_data) {
+            if (${ $tentry }{name} eq 'NAME') {
+                $this_target = ${ $tentry }{value};
+                push @target_list, $this_target;
+                $obsmode_list{$this_target} = '.*';
+                $object_list{$this_target} = '.*';
+                $comment_list{$this_target} = '.*';
+            }
+            elsif (${ $tentry }{name} eq 'OBSMODE') {
+                $obsmode_list{$this_target} = ${ $tentry }{value};
+                $obsmode_list{$this_target} =~ s/%//;
+            }
+            elsif (${ $tentry }{name} eq 'OBJECT') {
+                $object_list{$this_target} = ${ $tentry }{value};
+                $object_list{$this_target} =~ s/%//;
+            }
+            elsif (${ $tentry }{name} eq 'COMMENT') {
+                $comment_list{$this_target} = ${ $tentry }{value};
+                $comment_list{$this_target} =~ s/%//;
+            }
+        }
+    }
+}
+
+my $db = init_gpc_db();
+
+my ($start_date,$end_date);
+
+if (defined($date)) {
+    my ($year,$month,$day) = split /-/,$date;
+    $start_date = DateTime->new(year => $year, month => $month, day => $day,
+				hour => 0, minute => 0, second => 0, nanosecond => 0,
+				time_zone => 'Pacific/Honolulu');
+    $end_date   = DateTime->new(year => $year, month => $month, day => $day,
+				hour => 0, minute => 0, second => 0, nanosecond => 0,
+				time_zone => 'Pacific/Honolulu');
+    $end_date->add(days => 1);
+}
+else {
+    my @now = localtime();
+    $start_date = DateTime->new(year => 2009, month => 5, day => 1,
+				hour => 0, minute => 0, second => 0, nanosecond => 0,
+				time_zone => 'Pacific/Honolulu');
+    $end_date   = DateTime->new(year => 1900 + $now[5], month => $now[4] + 1, day => $now[3],
+				hour => 0, minute => 0, second => 0, nanosecond => 0,
+				time_zone => 'Pacific/Honolulu');
+    $end_date->add(days => 1);
+}
+
+my %to_process = ();
+while (DateTime->compare($start_date,$end_date) != 0) {
+    my $search_date = $start_date->ymd;
+#    print "$search_date " . $start_date->ymd . " " . $end_date->ymd . ">>$bt_state<<\n";
+    my $sth = "SELECT DISTINCT SUBSTR(rawExp.dateobs,1,10),rawExp.exp_type,rawExp.obs_mode,rawExp.object,rawExp.comment,burntool_state ";
+    $sth .=   " FROM rawExp JOIN rawImfile USING(exp_id) WHERE ";
+    $sth .=   "     date(rawExp.dateobs) >= '${search_date}T00:00:00' ";
+    $sth .=   " AND date(rawExp.dateobs) <= '${search_date}T23:59:59' ";
+    $sth .=   " ORDER BY SUBSTR(rawExp.dateobs,1,10),burntool_state ";
+#    print "$sth\n";
+    my $data_ref = $db->selectall_arrayref( $sth );
+    
+    my %count = ();
+    my $date = $search_date;
+    foreach my $row_ref (@{ $data_ref }) {
+	my ($date_str,$exp_type,$obs_mode,$object,$comment,$burntool_state) = @{ $row_ref };
+	unless(defined($burntool_state)) {
+	    $burntool_state = 0;
+	}
+	unless(defined($exp_type)) {
+	    $exp_type = '';
+	}
+	unless(defined($obs_mode)) {
+	    $obs_mode = '';
+	}
+	unless(defined($object)) {
+	    $object = '';
+	}
+	unless(defined($comment)) {
+	    $comment = '';
+	}
+#	print ">$date_str><$exp_type><$obs_mode><$object><$comment><$burntool_state>" . is_science($exp_type,$obs_mode,$object,$comment) . "<\n";
+	if (is_science($exp_type,$obs_mode,$object,$comment) == 1) {
+	    $count{$burntool_state} ++;
+	}
+    }
+#     if ($verbose) {
+# 	print "$date\n";
+#     }
+    foreach my $burntool_state (sort {$a <=> $b} (keys %count)) {
+	if ($verbose) {
+	    print "$date\t$count{$burntool_state}\t$burntool_state\t$bt_state\n";
+	}
+	unless(exists($to_process{$date})) {
+	    if ((abs($burntool_state) != $bt_state)
+		&&($count{$burntool_state} != 0)) {
+		print "\tbt.add.date $date\n";
+		$to_process{$date} = 1;
+	    }
+	}
+    }
+    $start_date->add(days => 1);
+}
+		
+
+
+
+sub get_goodBTvalue {
+    my $mdcParser = PS::IPP::Metadata::Config->new;
+
+    my $config_cmd = "$ppConfigDump -camera $camera -dump-camera - | grep BURNTOOL.STATE.GOOD | uniq";
+    my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
+        run ( command => $config_cmd, verbose => $debug);
+    unless ($success) {
+        $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
+        &my_die("Unable to perform ppConfigDump: $error_code", 0, 0, 0, $PS_EXIT_SYS_ERROR);
+    }
+    my $recipeData = $mdcParser->parse(join "", @$stdout_buf) or
+        &my_die("Unable to parse metadata config doc", 0, 0, 0, $PS_EXIT_SYS_ERROR);
+    my $burntoolStateGood = 999;
+    foreach my $cfg (@$recipeData) {
+        if ($cfg->{name} eq 'BURNTOOL.STATE.GOOD') {
+            $burntoolStateGood = $cfg->{value};
+        }
+    }
+    if ($burntoolStateGood == 999) {
+        &my_die("Failed to determine BURNTOOL.STATE.GOOD", $burntoolStateGood, 0, 0, $PS_EXIT_SYS_ERROR);
+    }
+    return($burntoolStateGood);
+}
+
+
+sub init_gpc_db {
+    use constant DB_SOCKET => '/var/run/mysqld/mysqld.sock';
+    my $dbserver = 'ippdb01';
+    my $dbuser = 'ippuser';
+    my $dbpass = 'ippuser';
+    $db = DBI->connect("DBI:mysql:database=${dbname};host=${dbserver};" .
+                       "mysql_socket=" . DB_SOCKET(),
+                       ${dbuser},${dbpass},
+		       { RaiseError => 1, AutoCommit => 1}
+        ) or die "Unable to connect to database $DBI::errstr\n";
+    return($db);
+}
+
+sub is_science {
+#    if (is_science($exp_type,$obs_mode,$object,$comment)) {
+    my ($exp_type,$obs_mode,$object,$comment) = @_;
+    my $return_value = 0;
+    unless($object) {
+        $object = '';
+    }
+    unless($exp_type) {
+	return(0);
+    }
+    if ($exp_type eq 'OBJECT') {
+        foreach my $target (@target_list) {
+#           print STDERR "$target $obsmode_list{$target} $exp_type $obs_mode $object $comment\n";
+            if (($obs_mode =~ /$obsmode_list{$target}/i)&&
+                ($object   =~ /$object_list{$target}/i)&&
+                ($comment  =~ /$comment_list{$target}/i)) {
+                $return_value = 1;
+            }
+#	    print ">$return_value $exp_type $obs_mode $object $comment <> $target $obsmode_list{$target} $object_list{$target} $comment_list{$target}\n";
+            if ($return_value) {
+                return($return_value);
+            }
+        }
+    }
+    return(0);
+}