bin/replace_plots.pl

   1 #!/usr/bin/perl
   2
   3 =head1 NAME
   4
   5 replace_plots.pl - a bulk script to replace accessions in field layouts
   6
   7 =head1 SYNOPSIS
   8
   9 rename_stocks.pl -H [dbhost] -D [dbname] -i [infile] <-t>
  10
  11 =head1 COMMAND-LINE OPTIONS
  12
  13 -H host name (required) e.g. "localhost"
  14 -D database name (required) e.g. "cxgn_cassava"
  15 -i path to infile (required)
  16 -t (optional) test - do not modify the database.
  17
  18 =head1 DESCRIPTION
  19
  20 This script replaces accessions in field layouts in bulk.
  21
  22 The infile provided has three columns:
  23
  24 1) the stock_id of the plot that needs to be changed.
  25 2) the stock uniquename as it is in the database that is currently associated
  26 3) the new stock uniquename (needs to be in the database).
  27 4) optional: a new plot name
  28
  29 There is no header on the infile and the infile is .xls.
  30
  31 The script will dissociate the old accession in column 1 and associate the new accession. The plot name will be unchanged.
  32
  33 =head1 AUTHOR
  34
  35     Lukas Mueller (lam87@cornell.edu)
  36
  37     Adapted from a cvterm renaming script by:
  38     Guillaume Bauchet (gjb99@cornell.edu)
  39     Nicolas Morales (nm529@cornell.edu)
  40
  41 =cut
  42
  43 use strict;
  44
  45 use Getopt::Std;
  46 use Data::Dumper;
  47 use Carp qw /croak/ ;
  48 use Pod::Usage;
  49 use Spreadsheet::ParseExcel;
  50 use Bio::Chado::Schema;
  51 use CXGN::DB::InsertDBH;
  52 use Try::Tiny;
  53
  54 our ($opt_H, $opt_D, $opt_i, $opt_t);
  55
  56 getopts('H:D:i:t');
  57
  58 if (!$opt_H || !$opt_D || !$opt_i) {
  59     pod2usage(-verbose => 2, -message => "Must provide options -H (hostname), -D (database name), -i (input file)\n");
  60 }
  61
  62 my $dbhost = $opt_H;
  63 my $dbname = $opt_D;
  64 my $parser   = Spreadsheet::ParseExcel->new();
  65 my $excel_obj = $parser->parse($opt_i);
  66
  67 my $dbh = CXGN::DB::InsertDBH->new({
  68         dbhost=>$dbhost,
  69         dbname=>$dbname,
  70         dbargs => {AutoCommit => 1, RaiseError => 1}
  71 });
  72
  73 my $schema= Bio::Chado::Schema->connect(  sub { $dbh->get_actual_dbh() } );
  74 $dbh->do('SET search_path TO public,sgn');
  75
  76
  77 my $worksheet = ( $excel_obj->worksheets() )[0]; #support only one worksheet
  78 my ( $row_min, $row_max ) = $worksheet->row_range();
  79 my ( $col_min, $col_max ) = $worksheet->col_range();
  80
  81 my $coderef = sub {
  82     for my $row ( 0 .. $row_max ) {
  83
  84         my $plot_name = $worksheet->get_cell($row, 0)->value();
  85         my $plot_id = $worksheet->get_cell($row, 1)->value();
  86         my $db_uniquename = $worksheet->get_cell($row,2)->value();
  87         my $new_uniquename = $worksheet->get_cell($row,3)->value();
  88
  89         my $new_plotname = "";
  90         eval {
  91             $new_plotname = $worksheet->get_cell($row, 4)->value();
  92         };
  93
  94         if ($@) {
  95             print STDER "no alternate plot name provided. Keeping old name.\n";
  96         }
  97
  98         print STDERR "$db_uniquename -> $new_uniquename\n";
  99
 100         my $old_stock = $schema->resultset('Stock::Stock')->find({ uniquename => $db_uniquename });
 101         my $new_stock = $schema->resultset('Stock::Stock')->find({ uniquename => $new_uniquename });
 102
 103         if (!$old_stock) {
 104             print STDERR "Warning! Stock with uniquename $db_uniquename was not found in the database.\n";
 105             next();
 106         }
 107         if (!$new_stock) {
 108             print STDERR "Warning! Stock with uniquename $new_uniquename was not found in the database.\n";
 109             next();
 110
 111         }
 112         my $q = "select plot.uniquename, accession.uniquename, sr.stock_relationship_id, cvterm.name from stock as plot join stock_relationship as sr on (plot.stock_id=sr.subject_id) join stock as accession on (accession.stock_id=sr.object_id) join cvterm on (sr.type_id=cvterm.cvterm_id) where plot.stock_id=? and accession.uniquename=? and cvterm.name='plot_of'";
 113
 114         my $h = $dbh->prepare($q);
 115         $h->execute($plot_id, $db_uniquename);
 116
 117         my ($plot, $acc, $stock_relationship_id) = $h->fetchrow_array();
 118
 119         #update stock_relationship row with new object_id...
 120         my $uq = "UPDATE stock_relationship set object_id=? where stock_relationship_id=?";
 121         my $uh = $dbh->prepare($uq);
 122         print STDERR "Changing object_id to ".$new_stock->stock_id()." for relationship $stock_relationship_id\n";
 123         if ($opt_t) {
 124             print STDERR "Not updating because of -t option...\n";
 125         }
 126         else {
 127             $uh->execute($new_stock->stock_id, $stock_relationship_id);
 128         }
 129
 130         if ($new_plotname) {
 131             print STDERR "Renaming plot to $new_plotname...\n";
 132             my $pq = "UPDATE stock SET uniquename=?, name=? WHERE stock_id=?";
 133             my $ph = $dbh->prepare($pq);
 134             $ph->execute($new_plotname, $new_plotname, $plot_id);
 135         }
 136     }
 137 };
 138
 139
 140 my $transaction_error;
 141 try {
 142     $schema->txn_do($coderef);
 143 } catch {
 144     $transaction_error =  $_;
 145 };
 146
 147 if ($transaction_error) {
 148     print STDERR "Transaction error storing terms: $transaction_error\n";
 149 } else {
 150     print STDERR "Script Complete.\n";
 151 }