bin/delete_trials.pl

   1
   2 =head1 NAME
   3
   4 delete_trials.pl - script to delete trials
   5
   6 =head1 DESCRIPTION
   7
   8 perl delete_trials.pl -i trial_id -H host -D dbname
   9
  10 Deletes trials that whose ids are provided as a comma separated list for the -i parameter.
  11 First, it deletes metadata, then trial layouts, then phenotypes, and finally the trial entry in the project table. All deletes are hard deletes. There is no way of bringing the trial back, except from a backup. So be careful!
  12
  13 =head1 AUTHOR
  14
  15 Lukas Mueller <lam87@cornell.edu>
  16
  17 =cut
  18
  19 use strict;
  20
  21 use Getopt::Std;
  22 use Bio::Chado::Schema;
  23 use CXGN::Metadata::Schema;
  24 use CXGN::Phenome::Schema;
  25 use CXGN::DB::InsertDBH;
  26 use CXGN::Trial;
  27
  28 our ($opt_H, $opt_D, $opt_i, $opt_n, $opt_t);
  29
  30 getopts('H:D:i:t:n');
  31
  32 my $dbhost = $opt_H;
  33 my $dbname = $opt_D;
  34 my $trial_ids = $opt_i;
  35 my $trial_names = $opt_t;
  36 my $non_interactive = $opt_n;
  37
  38 my $dbh = CXGN::DB::InsertDBH->new( { dbhost=>$dbhost,
  39                                       dbname=>$dbname,
  40                                       dbargs => {AutoCommit => 0,
  41                                       RaiseError => 1}
  42                                     }
  43     );
  44
  45 print STDERR "Connecting to database...\n";
  46 my $schema= Bio::Chado::Schema->connect(  sub { $dbh->get_actual_dbh() } );
  47 my $metadata_schema = CXGN::Metadata::Schema->connect( sub { $dbh->get_actual_dbh() });
  48 my $phenome_schema = CXGN::Phenome::Schema->connect( sub { $dbh->get_actual_dbh() });
  49
  50 my @trial_ids = split ",", $trial_ids;
  51 my @trial_names = split ",", $trial_names;
  52
  53 foreach my $name (@trial_names) {
  54     my $trial = $schema->resultset("Project::Project")->find( { name => $name });
  55     if (!$trial) { print STDERR "Trial $name not found. Skipping...\n"; next; }
  56     push @trial_ids, $trial->project_id();
  57 }
  58
  59 foreach my $trial_id (@trial_ids) {
  60     print STDERR "Retrieving trial information for trial $trial_id...\n";
  61
  62     my $t = CXGN::Trial->new( { bcs_schema => $schema , trial_id => $trial_id } );
  63
  64     my $answer = "";
  65     if (!$non_interactive) {
  66         print $t->get_name().", ".$t->get_description().". Delete? ";
  67         $answer = <>;
  68     }
  69     if ($non_interactive || $answer =~ m/^y/i) {
  70         eval {
  71             delete_trial($metadata_schema, $phenome_schema, $t);
  72         };
  73         if ($@) {
  74             print STDERR "An error occurred trying to delete trial ".$t->get_name()." ($@)\n";
  75             $dbh->rollback();
  76         }
  77         else {
  78             $dbh->commit();
  79             print STDERR "Trial ".$t->get_name()." successfully deleted\n";
  80         }
  81
  82     }
  83
  84 }
  85
  86 $dbh->disconnect();
  87 print STDERR "Done with everything.\n";
  88
  89 sub delete_trial {
  90     my $metadata_schema = shift;
  91     my $phenome_schema = shift;
  92     my $t = shift;
  93
  94     print STDERR "Deleting trial ".$t->get_name()."\n";
  95     print STDERR "Delete metadata...\n";
  96     $t->delete_metadata($metadata_schema, $phenome_schema);
  97     print STDERR "Deleting phenotypes...\n";
  98     $t->delete_phenotype_data();
  99     print STDERR "Deleting layout...\n";
 100     $t->delete_field_layout();
 101     print STDERR "Delete project entry...\n";
 102     $t->delete_project_entry();
 103 }
 104