bin/delete_stocks.pl

   1
   2 =head1 NAME
   3
   4 delete_stocks.pl - delete stocks from a cxgn database
   5
   6 =head1 DESCRIPTION
   7
   8 perl delete_stocks.pl -H [host] -D [dbname] -t (for testing) file
   9
  10 where the file contains a list of uniquenames specifying the stocks to be deleted, one per line.
  11
  12 If the -t flag is provided, the changes will be rolled back in the database.
  13
  14 Note that it may be possible that some stocks have additional connections, such as images, that this script does not delete yet, and so won't be able to delete those stocks.
  15
  16 =head1 AUTHOR
  17
  18 Lukas Mueller <lam87@cornell.edu>
  19
  20 =cut
  21
  22 use strict;
  23 use Getopt::Std;
  24 use DBI;
  25 use Bio::Chado::Schema;
  26 use CXGN::Phenome::Schema;
  27
  28 our ($opt_H, $opt_D, $opt_t);
  29 getopts('H:D:t');
  30
  31 my $file = shift;
  32
  33 print "Password for $opt_H / $opt_D: \n";
  34 my $pw = <>;
  35 chomp($pw);
  36
  37 print STDERR "Connecting to database...\n";
  38 my $dsn = 'dbi:Pg:database='.$opt_D.";host=".$opt_H.";port=5432";
  39
  40 my $dbh = DBI->connect($dsn, "postgres", $pw);
  41
  42 print STDERR "Connecting to DBI schema...\n";
  43 my $bcs_schema = Bio::Chado::Schema->connect($dsn, "postgres", $pw);
  44 my $phenome_schema = CXGN::Phenome::Schema->connect($dsn, "postgres", $pw,  { on_connect_do => ['set search_path to public,phenome;'] });
  45
  46 my $stock_count = 0;
  47 my $deleted_stock_count = 0;
  48 my $stock_owner_count = 0;
  49 my $missing_stocks = 0;
  50
  51 open(my $F, "<", $file) || die " Can't open file $file\n";
  52
  53 while (<$F>) {
  54     chomp;
  55
  56     my $stock = $_;
  57     $stock =~ s/\r//g;
  58     if (!$stock) {
  59         next();
  60     }
  61
  62     $stock_count++;
  63
  64     print STDERR "Processing $stock\n";
  65
  66     my $stock_row = $bcs_schema->resultset("Stock::Stock")->find( { uniquename => $stock });
  67
  68     if (!$stock_row) {
  69         print STDERR "Could not find stock $stock. Skipping...\n";
  70         $missing_stocks++;
  71         next;
  72     }
  73
  74     my $owner_rs = $phenome_schema->resultset("StockOwner")->search( { stock_id => $stock_row->stock_id() });
  75     if ($owner_rs->count() > 1) {
  76         print STDERR "Weird. $stock has more than one owner.\n";
  77     }
  78
  79     my $subject_relationship_rs = $bcs_schema->resultset("Stock::StockRelationship")->search( { object_id => $stock_row->stock_id() });
  80
  81     while (my $r = $subject_relationship_rs->next()) {
  82         print STDERR "Found object relationship with stock ".$r->subject_id()." of type ".$r->type_id()."\n";
  83     }
  84
  85     my $object_relationship_rs = $bcs_schema->resultset("Stock::StockRelationship")->search( { subject_id => $stock_row->stock_id() });
  86     while (my $r = $object_relationship_rs->next()) {
  87         print STDERR "Found subject relationship with stock ".$r->object_id()." of type ".$r->type_id()."\n";
  88     }
  89
  90     while (my $owner_row = $owner_rs->next()) {
  91
  92         if (! $opt_t) {
  93             eval {
  94                 print STDERR "Removing stockowner (".$owner_row->stock_id().")...\n";
  95                 $owner_row->delete();
  96             };
  97             if ($@) {
  98                 print STDERR "Could not delete owner of stock $stock because of: $@\stock";
  99             }
 100         }
 101
 102         $stock_owner_count++;
 103     }
 104
 105     if (! $opt_t) {
 106         eval {
 107             $stock_row->delete();
 108         };
 109         if ($@) {
 110             print STDERR "Could not delete entry for stock $stock because of: $@\n";
 111         }
 112         else {
 113             $deleted_stock_count++;
 114         }
 115     }
 116 }
 117
 118 print STDERR "Done. Total stocks deleted: $deleted_stock_count of $stock_count stocks, and removed $stock_owner_count owner relationships. Stocks not found: $missing_stocks\n";
 119
 120
 121