Index: trunk/ippScripts/scripts/listvideocells.pl
===================================================================
--- trunk/ippScripts/scripts/listvideocells.pl	(revision 32125)
+++ trunk/ippScripts/scripts/listvideocells.pl	(revision 32125)
@@ -0,0 +1,71 @@
+#!/usr/bin/env perl
+
+use Carp;
+use warnings;
+use strict;
+
+use vars qw( $VERSION );
+$VERSION = '0.01';
+
+use IPC::Cmd 0.36 qw( can_run run );
+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 );
+
+# Look for programs we need
+my $missing_tools;
+my $fhead = can_run('fhead') or (warn "Can't find fhead" and $missing_tools = 1);
+
+my ($uri, $verbose);
+
+# Parse the command-line arguments
+GetOptions(
+           'file=s'         => \$uri,        # uri to examine
+           'verbose'        => \$verbose,    # Print stuff?
+           ) or pod2usage( 2 );
+
+pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV;
+pod2usage( -msg => "Required options: --file",
+           -exitval => 3) unless
+    defined $uri;
+
+my $num_ext = 0;
+my $num_video_ext = 0;
+for (my $i = 0; ; $i++) {
+    my $command = "$fhead -x $i $uri | grep EXTNAME";
+
+    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);
+        if ($error_code != 1) {
+            carp("Unable to perform $command: $error_code");
+            exit $error_code;
+        }
+        last;
+    }
+    $num_ext++;
+
+    my $output = join "", @$stdout_buf;
+    chomp $output;
+    last if ! $output;
+
+    my ($exttag, undef, $extname) = split " ", $output;
+
+    last if !$exttag;
+
+    die ("unexpected output from fhead: $output") unless $exttag eq 'EXTNAME';
+
+    if ($extname =~ /video_table/) {
+        $num_video_ext++;
+        # get rid of the quotes in the ftable output
+        $extname =~ s/\'//g;
+        my (undef, undef, $cell) = split "_", $extname;
+        print "$cell\n";
+    }
+}
+
+die "no extensions found in $uri" unless $num_ext > 0;
+print "no video extensions found in $uri" unless $num_video_ext > 0;
+exit 0;
Index: trunk/ippScripts/scripts/videophot_process.pl
===================================================================
--- trunk/ippScripts/scripts/videophot_process.pl	(revision 32125)
+++ trunk/ippScripts/scripts/videophot_process.pl	(revision 32125)
@@ -0,0 +1,177 @@
+#!/usr/bin/env perl
+
+use warnings;
+use strict;
+
+## report the program and machine
+use Sys::Hostname;
+my $host = hostname();
+my $date = `date`;
+print "\n\n";
+print "Starting script $0 on $host at $date\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 Data::Dumper;
+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 );
+
+# Look for programs we need
+my $missing_tools;
+my $vptool = can_run('vptool') or (warn "Can't find vptool" and $missing_tools = 1);
+my $regtool = can_run('regtool') or (warn "Can't find regtool" and $missing_tools = 1);
+my $psvideophot = can_run('psvideophot') or (warn "Can't find psvideophot" and $missing_tools = 1);
+my $listvideocells = can_run('listvideocells.pl') or (warn "Can't find listvideocells.pl" and $missing_tools = 1);
+if ($missing_tools) {
+    warn("Can't find required tools.");
+    exit($PS_EXIT_CONFIG_ERROR);
+}
+my ($vp_id, $exp_id, $camera, $outroot, $dbname, $verbose, $no_update, $no_op, $redirect);
+
+GetOptions(
+    'vp_id=s'           => \$vp_id,
+    'exp_id=s'          => \$exp_id,
+    'camera=s'          => \$camera, 
+    'outroot=s'         => \$outroot,
+    'dbname|d=s'        => \$dbname,
+    'verbose'           => \$verbose,
+    'no-update'         => \$no_update, # Don't update the database?
+    'no-op'             => \$no_op,     # Don't do any operations?
+    'redirect-output'   => \$redirect,  # redirect output streams to logfile
+) or pod2usage( 2 );
+
+pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV;
+pod2usage(
+    -msg => "Required options: --vp_id --exp_id --outroot --camera",
+    -exitval => 3,
+          ) unless defined $vp_id
+            and defined $exp_id
+            and defined $camera
+            and defined $outroot;
+
+
+$no_update = 1 if $no_op;
+
+my $ipprc = PS::IPP::Config->new($camera) or my_die( "Unable to set up", $vp_id, 'nochip', 'nocell', $PS_EXIT_CONFIG_ERROR ); # IPP configuration
+
+my $logDest = $ipprc->filename("LOG.EXP", $outroot);
+$ipprc->redirect_output($logDest) or my_die( "Unable to redirect output", $vp_id, 'nochip', 'nocell', $PS_EXIT_SYS_ERROR ) if $redirect;
+
+my $source_id = $ipprc->source_id($dbname, $PS_TABLE_ID_DIFF);
+
+# Get list of components for subtraction
+my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files
+my $files;
+{
+#    my $command = "$vptool -pendingimfile -vp_id $vp_id";
+#    $command .= " -dbname $dbname" if defined $dbname;
+    my $command = "$regtool -processedimfile -video_cells -exp_id $exp_id";
+    $command .= " -dbname $dbname" if defined $dbname;
+    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);
+        &my_die("Unable to perform vptool -pendingimfile: $error_code", $vp_id, 'nochip', 'nocell', $error_code);
+    }
+
+    my $metadata = $mdcParser->parse(join "", @$stdout_buf) or
+        &my_die("Unable to parse metadata config doc", $vp_id, 'nochip', 'nocell', $PS_EXIT_PROG_ERROR);
+    $files = parse_md_list($metadata) or
+        &my_die("Unable to parse metadata list", $vp_id, 'nochip', 'nocell', $PS_EXIT_PROG_ERROR);
+}
+
+foreach my $file (@$files) {
+    my $class_id = $file->{class_id};
+    my $uri = $file->{uri};
+
+    my $resolved = $ipprc->file_resolve($uri);
+    &my_die("Unable to resolve $uri", $vp_id, $class_id, 'nocell', $PS_EXIT_UNKNOWN_ERROR) unless $resolved;
+
+    my $command = "$listvideocells --file $resolved";
+    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);
+        &my_die("Unable to perform $command: $error_code", $vp_id, $class_id, 
+            'nocell', $error_code);
+    }
+
+    my @video_cells = split "\n", (join "", @$stdout_buf);
+    &my_die("No video cells found in $uri", $vp_id, $class_id, 
+            'nocell', $PS_EXIT_UNKNOWN_ERROR) unless scalar @video_cells;
+
+    foreach my $cell_id (@video_cells) {
+        my $command = "$psvideophot $outroot";
+        $command .= " -file $uri";
+        $command .= " -cell_id $cell_id";
+        $command .= " -dbname $dbname" if defined $dbname;
+        unless ($no_op) {
+            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);
+                &my_die("Unable to perform ppSub: $error_code", $vp_id, $class_id, $cell_id, $error_code);
+            }
+
+            # check_output($outputStats, 1);
+        } else {
+            print "Not executing: $command\n";
+        }
+        unless ($no_update) {
+            my $command = "$vptool -addvpcell -vp_id $vp_id -class_id $class_id -cell_id $cell_id";
+            $command .= " -path_base $outroot";
+
+            $command .= " -dbname $dbname" if defined $dbname;
+
+            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);
+                my $err_message = "Unable to perform vptool -addvpcell";
+                &my_die("$err_message: $error_code", $vp_id, $class_id, $cell_id, $error_code);
+            }
+        }
+    }
+}
+
+exit 0;
+
+sub my_die
+{
+    my $msg = shift;            # Warning message on die
+    my $vp_id = shift;
+    my $class_id = shift;       # chip identifier
+    my $cell_id = shift;       # chip identifier
+    my $exit_code = shift;      # Exit code to add
+
+    $exit_code = $PS_EXIT_PROG_ERROR unless defined $exit_code;
+
+    warn($msg);
+    if (defined $vp_id and defined $class_id and not $no_update) {
+        my $command = "$vptool -vp_id $vp_id -class_id $class_id -cell_id -fault $exit_code";
+        $command .= " -addvpcell";
+        $command .= (" -dtime_script " . ((DateTime->now->mjd - $mjd_start) * 86400));
+        $command .= " -hostname $host" if defined $host;
+        $command .= " -path_base $outroot" if defined $outroot;
+        $command .= " -dbname $dbname" if defined $dbname;
+        run(command => $command, verbose => $verbose);
+    }
+    exit $exit_code;
+}
+
+END {
+    my $exit = $?;
+    system("sync") == 0 or die "failed to execute sync: $!";
+    $? = $exit;
+}
+
+__END__