Merge pull request #4606 from solgenomics/topic/fix-germplasm-log
[sgn.git] / bin / delete_stocks.pl
blobb15cbbd8f4183a3d4579a493ac7bf68465cabdb9
2 =head1 NAME
4 delete_stocks.pl - delete stocks from a cxgn database
6 =head1 DESCRIPTION
8 perl delete_stocks.pl -H [host] -D [dbname] [-s accession ] -t (for testing) file
10 where the file contains a list of uniquenames specifying the stocks to be deleted, one per line.
12 The parameter -s specifies the type of stock (accession, plot, family_name, etc) to be deleted.
13 The default is "accession".
15 If the -t flag is provided, the changes will be rolled back in the database.
17 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.
19 =head1 AUTHOR
21 Lukas Mueller <lam87@cornell.edu>
23 =cut
25 use strict;
26 use Getopt::Std;
27 use DBI;
28 use Bio::Chado::Schema;
29 use CXGN::Phenome::Schema;
31 our ($opt_H, $opt_D, $opt_t, $opt_s);
33 getopts('H:D:s:t');
35 my $stock_type = $opt_s || "accession";
37 my $file = shift;
39 print "Password for $opt_H / $opt_D: \n";
40 my $pw = <>;
41 chomp($pw);
43 print STDERR "Connecting to database...\n";
44 my $dsn = 'dbi:Pg:database='.$opt_D.";host=".$opt_H.";port=5432";
46 my $dbh = DBI->connect($dsn, "postgres", $pw);
48 print STDERR "Connecting to DBI schema...\n";
49 my $bcs_schema = Bio::Chado::Schema->connect($dsn, "postgres", $pw);
50 my $phenome_schema = CXGN::Phenome::Schema->connect($dsn, "postgres", $pw, { on_connect_do => ['set search_path to public,phenome;'] });
52 my $stock_count = 0;
53 my $deleted_stock_count = 0;
54 my $stock_owner_count = 0;
55 my $missing_stocks = 0;
57 my $cv_id = $bcs_schema->resultset("Cv::Cv")->find( { name => 'stock_type' } )->cv_id();
58 my $stock_type_cvterm_id = $bcs_schema->resultset("Cv::Cvterm")->find( { name => $stock_type, cv_id=> $cv_id })->cvterm_id();
60 open(my $F, "<", $file) || die " Can't open file $file\n";
62 while (<$F>) {
63 chomp;
65 my $stock = $_;
66 $stock =~ s/\r//g;
67 if (!$stock) {
68 next();
71 $stock_count++;
73 print STDERR "Processing $stock\n";
75 my $stock_row = $bcs_schema->resultset("Stock::Stock")->find( { uniquename => $stock, type_id => $stock_type_cvterm_id });
77 if (!$stock_row) {
78 print STDERR "Could not find stock $stock of type $stock_type. Skipping...\n";
79 $missing_stocks++;
80 next;
83 my $owner_rs = $phenome_schema->resultset("StockOwner")->search( { stock_id => $stock_row->stock_id() });
84 if ($owner_rs->count() > 1) {
85 print STDERR "Weird. $stock has more than one owner.\n";
88 my $subject_relationship_rs = $bcs_schema->resultset("Stock::StockRelationship")->search( { object_id => $stock_row->stock_id() });
90 while (my $r = $subject_relationship_rs->next()) {
91 print STDERR "Found object relationship with stock ".$r->subject_id()." of type ".$r->type_id()."\n";
94 my $object_relationship_rs = $bcs_schema->resultset("Stock::StockRelationship")->search( { subject_id => $stock_row->stock_id() });
95 while (my $r = $object_relationship_rs->next()) {
96 print STDERR "Found subject relationship with stock ".$r->object_id()." of type ".$r->type_id()."\n";
99 while (my $owner_row = $owner_rs->next()) {
101 if (! $opt_t) {
102 eval {
103 print STDERR "Removing stockowner (".$owner_row->stock_id().")...\n";
104 $owner_row->delete();
106 if ($@) {
107 print STDERR "Could not delete owner of stock $stock because of: $@\stock";
111 $stock_owner_count++;
114 if (! $opt_t) {
115 eval {
116 $stock_row->delete();
118 if ($@) {
119 print STDERR "Could not delete entry for stock $stock because of: $@\n";
121 else {
122 $deleted_stock_count++;
127 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";