Index: trunk/ippScripts/scripts/ipp_darkstats.pl
===================================================================
--- trunk/ippScripts/scripts/ipp_darkstats.pl	(revision 13848)
+++ trunk/ippScripts/scripts/ipp_darkstats.pl	(revision 13979)
@@ -1,14 +1,45 @@
 #!/usr/bin/env perl
 
-use warnings;
-use strict;
+# use warnings;
+# use strict;
 use Carp;
+use Getopt::Long qw( GetOptions :config auto_help auto_version gnu_getopt );
+use Pod::Usage qw( pod2usage );
+use IPC::Cmd 0.36 qw( can_run run );
 
-# USAGE: ipp_darkstats.pl --dbname (name) --det_id (id)
+use PS::IPP::Metadata::List qw( parse_md_list );
+
+use PS::IPP::Config qw($PS_EXIT_SUCCESS          
+		       $PS_EXIT_UNKNOWN_ERROR
+		       $PS_EXIT_SYS_ERROR
+		       $PS_EXIT_CONFIG_ERROR
+		       $PS_EXIT_PROG_ERROR
+		       $PS_EXIT_DATA_ERROR
+		       $PS_EXIT_TIMEOUT_ERROR
+		       caturi
+		       );                        # tools to parse the IPP configuration information
+
+my $ipprc = PS::IPP::Config->new(); # IPP configuration
+
+my ($dbname, $det_id, $camera);
+
+GetOptions('dbname=s'    => \$dbname,
+	   'det_id=s'    => \$det_id,
+	   'camera|c=s'  => \$camera,
+	   ) or pod2usage( 2 );
+
+pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV;
+
+pod2usage(
+	  -msg => "USAGE: ipp_darkstats.pl --dbname (name) --det_id (id) --camera (name)",
+	  -exitval => 3,
+	  ) unless defined $dbname and defined $det_id and defined $camera;
+
+$ipprc->define_camera($camera);
 
 ###  Get list of dark imfile results
 
 # define the dettool command
-my $command = "$dettool -processedimfile -select_state stop"; # Command to run
+my $command = "dettool -processedimfile -select_state stop"; # Command to run
 $command .= " -det_id $det_id";
 $command .= " -dbname $dbname" if defined $dbname;
@@ -16,17 +47,95 @@
 # run the dettool command and catch the output
 my ( $success, $error_code, $full_buf, $stdout_buf, $stderr_buf ) =
-    run(command => $command, verbose => 1);
+    run(command => $command, verbose => 0);
 unless ($success) {
     $error_code = (($error_code >> 8) or $PS_EXIT_PROG_ERROR);
-    &my_die("Unable to perform dettool: $error_code", $det_id, $error_code);
+    &my_die("Unable to perform dettool: $error_code", $error_code);
 }
 
 # parse the output into a list
+my $mdcParser = PS::IPP::Metadata::Config->new;	# Parser for metadata config files
 my $metadata = $mdcParser->parse(join "", @$stdout_buf) or
-    &my_die("Unable to parse metadata config doc", $det_id, $PS_EXIT_PROG_ERROR);
-my $files = parse_md_list($metadata) or
-    &my_die("Unable to parse metadata list", $cam_id, $PS_EXIT_PROG_ERROR);
+    &my_die("Unable to parse metadata config doc", $PS_EXIT_PROG_ERROR);
+my $list = parse_md_list($metadata) or
+    &my_die("Unable to parse metadata list", $PS_EXIT_PROG_ERROR);
 
-# XXX finish this off:
+my @bg_data;
+my @bg_stdev_data;
+my @bg_name;
+my @bg_exptime;
+
+# we now have a list of imfiles; we need to extract the background for each cell
+# from the stats files for each imfile
+foreach my $item (@$list) {
+    my $path_base = $item->{path_base};
+    my $class_id = $item->{class_id};
+    my $exp_time = $item->{exp_time};
+
+    my $rootName  = $ipprc->file_resolve ($path_base);
+    my $statsName = "$rootName.$class_id.stats";
+
+    # print STDERR "rootName: $rootName\n";
+    # print STDERR "statsName: $statsName\n";
+
+    my $statsFile;
+    open $statsFile, $statsName;
+    my @contents = <$statsFile>;
+    close ($statsFile);
+
+    # print STDERR "contents: @contents\n";
+
+    my $parser = PS::IPP::Metadata::Config->new;	# Parser for metadata config files
+    my $statsList = $parser->parse(join "", @contents) or &my_die("Unable to parse metadata for imfile stats", $PS_EXIT_SYS_ERROR);
+
+    &parse_stats_table ($exp_time, $class_id, $statsList);
+}
+
+print STDERR "dumping stats\n";
+
+for (my $i = 0; $i < @bg_data; $i++) {
+    $name1 = "$bg_name[$i].bg";
+    $name2 = "$bg_name[$i].exp";
+    push @{$name1}, $bg_data[$i];
+    push @{$name2}, $bg_exptime[$i];
+}
+
+exit 0;
+
+sub parse_stats_table
+{
+    my ($exp_time, $tag, $md) = @_;
+
+    # descend through the fpa        
+    foreach my $entry (@$md) {
+	# print STDERR "name: $entry->{name}, class: $entry->{class}\n";
+        # recurse on nested metadata
+        if ($entry->{class} eq 'metadata') {
+	    my $newtag = $tag . ":" . $entry->{name};
+            &parse_stats_table ($exp_time, $newtag, $entry->{value});
+        }
+
+        if ($entry->{name} =~ /^(SAMPLE|ROBUST|FITTED|CLIPPED)_/) {
+            # It's a statistic of some sort
+            if ($entry->{name} =~ /_STDEV$/) {
+                push @bg_stdev_data, $entry->{value};
+            } else {
+                push @bg_data, $entry->{value};
+            }
+	    push @bg_name, $tag;
+	    push @bg_exptime, $exp_time;
+	    next;
+	} 
+    }
+    return 1;
+}
+
+sub my_die
+{
+    my $msg = shift; # Warning message on die
+    my $exit_code = shift; # Exit code to add
+
+    carp($msg);
+    exit $exit_code;
+}
 
 # - get the exp_time as well from dettool
