Index: /trunk/tools/stsci_disks/p3_permcheck.pl
===================================================================
--- /trunk/tools/stsci_disks/p3_permcheck.pl	(revision 38678)
+++ /trunk/tools/stsci_disks/p3_permcheck.pl	(revision 38678)
@@ -0,0 +1,167 @@
+#! /usr/bin/env perl
+
+use DBI;
+use PS::IPP::Config 1.01 qw( :standard );
+use PS::IPP::Metadata::Config;
+use PS::IPP::Metadata::List qw( parse_md_list );
+use IPC::Cmd 0.36 qw( can_run run );
+use Carp;
+use Pod::Usage qw( pod2usage );
+
+use Nebulous::Server::SQL;
+use Nebulous::Client;
+use SQL::Interp qw( sql_interp );
+use strict;
+use warnings FATAL => qw( all );
+use Getopt::Long qw( GetOptions :config auto_help auto_version );
+use File::Basename;
+
+my (    $db, $dbhost, $dbpass, $dbuser);
+my $conffile = "/home/panstarrs/ipp/ippconfig/nebulous.config";
+if (-e $conffile) {
+#    printf STDERR "found config\n";
+    open(IN,$conffile);
+    while(<IN>) {
+        chomp;
+        if ($_ =~ /NEB_DB\s+/) {
+            $db = (split /\s+/,$_)[2];
+        }
+        elsif ($_ =~ /NEB_DBHOST/) {
+            $dbhost = (split /\s+/,$_)[2];
+        }
+        elsif ($_ =~ /NEB_USER/) {
+            $dbuser = (split /\s+/,$_)[2];
+        }
+        elsif ($_ =~ /NEB_PASS/) {
+            $dbpass = (split /\s+/,$_)[2];
+        }
+    }
+    close(IN);
+#    print STDERR  "$db $dbhost $dbuser $dbpass\n";
+}
+
+
+my $debug = 0;
+my $verbose = 0;
+my ($stage,$stage_id,$dbname);
+GetOptions(
+    'stage=s' => \$stage,
+    'stage_id=s' => \$stage_id,
+    'dbname=s' => \$dbname,
+    ) || pod2usage(2);
+
+my $server = $ENV{'NEB_SERVER'};
+my $neb = Nebulous::Client->new(
+    proxy => "$server",
+    );
+
+
+
+my $camera = 'GPC1';
+my $ipprc = PS::IPP::Config->new( $camera ) or my_die("Unable to set_up", $stage, $stage_id);
+my $mdcParser = PS::IPP::Metadata::Config->new; # Parser for metadata config files
+
+my $time = time();
+my $logDest = "neb://any/stsci_shuffle/${stage}/${stage}.${stage_id}.log.${time}";
+unless ($debug) {
+    $ipprc->redirect_output($logDest) or &my_die("Could not redirect output to logfile ${logDest}", $stage,$stage_id);
+}
+
+
+
+my @volumes = ();
+for (my $i = 4; $i <= 4; $i++) {
+    for (my $j = 0; $j < 3; $j++) {
+        push @volumes, sprintf("ippb%02d.%1d",$i,$j);
+    }
+}
+my $rand_vol = $volumes[rand @volumes];
+
+
+my $command;
+if ($stage eq 'raw') {
+    $command = "regtool -processedimfile -data_state full -exp_id $stage_id -dbname $dbname";
+}
+elsif ($stage eq 'cam') {
+    $command = "camtool -processedexp -cam_id $stage_id -dbname $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 run STAGEtool -liststagestuff ", $stage,$stage_id);
+}
+my $MDlist = $mdcParser->parse(join "", @$stdout_buf) or &my_die("Unable to run STAGEtool -liststagestuff ", $stage,$stage_id);
+my $stageData = parse_md_list($MDlist);
+
+my @keys = ();
+foreach my $stageEntry ( @{ $stageData } ) {
+    if ($stage eq 'raw') {
+	if ($stageEntry->{ignored}) { next; }
+	push @keys, $stageEntry->{uri};
+    }
+    elsif ($stage eq 'cam') {
+	push @keys, $stageEntry->{path_base} . ".smf";
+	for (my $u = 0; $u < 8; $u++) {
+	    for (my $v = 0; $v < 8; $v++) {
+		if ((($u == 0)||($u == 7))&&
+		    (($v == 0)||($v == 7))) { next; }
+		push @keys, $stageEntry->{path_base} . ".XY${u}${v}.mk.fits";
+	    }
+	}
+    }
+}
+
+my @issues = ();
+my $good = 0;
+foreach my $key (@keys) {
+    my ($ipp_copies,$stsci_copies) = check_instances($key);
+    if ($stsci_copies != 0) {
+	for (my $i = 0; $i < $stsci_copies; $i++) {
+	    $neb->replicate($key,$rand_vol);
+	}
+	print ">> REP: $key\n";
+	sleep(5);
+	my ($ipp_copies,$stsci_copies) = check_instances($key);
+    }
+    
+    if ($ipp_copies >= 2) {
+	$good ++;
+    }
+    else {
+	print ">> $ipp_copies $stsci_copies\n";
+	push @issues, $key;
+    }
+    print "$key $good $#issues\n";
+}
+
+my $bad = 0;
+if ($#issues != -1) {
+    foreach my $key (@issues) {
+	my ($ipp_copies,$stsci_copies) = check_instances($key);
+	if ($ipp_copies < 2) {
+	    print "CHECK: $key\n";
+	    $bad++;
+	}
+    }
+}
+if ($bad != 0) {
+    exit(2);
+}
+
+
+sub check_instances {
+    my $key = shift;
+    my $uris = $neb->find_instances($key);
+    my $ipp_copies = 0;
+    my $stsci_copies = 0;
+    foreach my $uri (@{ $uris }) { 
+	if ($uri =~ /file:...data.ipp/) {
+	    $ipp_copies++;
+	}
+	if ($uri =~ /file:...data.stsci/) {
+	    $stsci_copies++;
+	}
+    }
+    return($ipp_copies,$stsci_copies);
+}