Index: trunk/tools/cleandsproduct.pl
===================================================================
--- trunk/tools/cleandsproduct.pl	(revision 31801)
+++ trunk/tools/cleandsproduct.pl	(revision 31801)
@@ -0,0 +1,98 @@
+#!/usr/bin/env perl
+
+use Carp;
+use warnings;
+use strict;
+
+## report the program and machine
+use Sys::Hostname;
+my $host = hostname();
+
+use vars qw( $VERSION );
+$VERSION = '0.01';
+
+use IPC::Cmd 0.36 qw( can_run run );
+use File::Temp qw( tempfile );
+use File::Basename qw( basename );
+use Digest::MD5::File qw( file_md5_hex );
+use PS::IPP::Metadata::Config;
+use PS::IPP::Metadata::List qw( parse_md_list );
+
+use PS::IPP::Config 1.01 qw( :standard );
+
+my $ipprc = PS::IPP::Config->new(); # IPP configuration
+
+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 $dsproductls = can_run('dsproductls') or (warn "Can't find dsproductls" and $missing_tools = 1);
+my $dsreg   = can_run('dsreg') or (warn "Can't find dsreg.pl" and $missing_tools = 1);
+if ($missing_tools) {
+    warn("Can't find required tools.");
+    exit($PS_EXIT_CONFIG_ERROR);
+}
+
+my ($product, $datastore, $last_fileset, $keep_files, $verbose);
+
+# Parse the command-line arguments
+GetOptions(
+           'product=s'      => \$product,      #product name
+           'datastore=s'    => \$datastore,     #datastore uri
+           'last_fileset=s' => \$last_fileset, # last fileset to delete
+           'no_rm'          => \$keep_files, # last fileset to delete
+           'verbose'        => \$verbose,    # Print stuff?
+           ) or pod2usage( 2 );
+
+pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV;
+pod2usage( -msg => "Required options: --product",
+           -exitval => 3) unless
+    defined $product;
+
+
+$datastore = "http://datastore.ipp.ifa.hawaii.edu" if !$datastore;
+
+my $uri = "$datastore/$product/index.txt";
+
+{
+    my $command = "$dsproductls --uri $uri --extra --timeout 150";
+
+    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);
+        die("Unable to perform $command: $error_code");
+    }
+
+    my @lines = split "\n", join("", @$stdout_buf);
+
+    if ((scalar @lines) eq 1) {
+        print "no filesets found in $uri\n";
+        exit 0;
+    }
+
+    foreach my $line (@lines) {
+        chomp $line;
+        next if $line =~ /#/;
+
+        my ($fsuri, $fs_name, $registered, $fs_type, $target_id, $stage, $stage_id) = split " ", $line;
+
+        $command = "$dsreg --del $fs_name --product $product";
+        
+        $command .= " --rm" unless $keep_files;
+
+        print "$command\n";
+
+        my $rc = system $command;
+        if ($rc) {
+            my $error_code = $rc >> 8;
+            die "$command failed with $error_code $rc\n";
+        }
+        last if $last_fileset and ($fs_name eq $last_fileset);
+    }
+
+
+}
+
+__END__