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 and .xlsx.
  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 Spreadsheet::ParseXLSX;
  51 use Bio::Chado::Schema;
  52 use CXGN::DB::InsertDBH;
  53 use Try::Tiny;
  54
  55 our ($opt_H, $opt_D, $opt_i, $opt_t);
  56
  57 getopts('H:D:i:t');
  58
  59 if (!$opt_H || !$opt_D || !$opt_i) {
  60     pod2usage(-verbose => 2, -message => "Must provide options -H (hostname), -D (database name), -i (input file)\n");
  61 }
  62
  63 my $dbhost = $opt_H;
  64 my $dbname = $opt_D;
  65
  66 # Match a dot, extension .xls / .xlsx
  67 my ($extension) = $opt_i =~ /(\.[^.]+)$/;
  68 my $parser;
  69
  70 if ($extension eq '.xlsx') {
  71         $parser = Spreadsheet::ParseXLSX->new();
  72 }
  73 else {
  74         $parser = Spreadsheet::ParseExcel->new();
  75 }
  76
  77 my $excel_obj = $parser->parse($opt_i);
  78
  79 my $dbh = CXGN::DB::InsertDBH->new({
  80         dbhost=>$dbhost,
  81         dbname=>$dbname,
  82         dbargs => {AutoCommit => 1, RaiseError => 1}
  83 });
  84
  85 my $schema= Bio::Chado::Schema->connect(  sub { $dbh->get_actual_dbh() } );
  86 $dbh->do('SET search_path TO public,sgn');
  87
  88
  89 my $worksheet = ( $excel_obj->worksheets() )[0]; #support only one worksheet
  90 my ( $row_min, $row_max ) = $worksheet->row_range();
  91 my ( $col_min, $col_max ) = $worksheet->col_range();
  92
  93 my $coderef = sub {
  94     for my $row ( 0 .. $row_max ) {
  95
  96         my $plot_name = $worksheet->get_cell($row, 0)->value();
  97         my $plot_id = $worksheet->get_cell($row, 1)->value();
  98         my $db_uniquename = $worksheet->get_cell($row,2)->value();
  99         my $new_uniquename = $worksheet->get_cell($row,3)->value();
 100
 101         my $new_plotname = "";
 102         eval {
 103             $new_plotname = $worksheet->get_cell($row, 4)->value();
 104         };
 105
 106         if ($@) {
 107             print STDER "no alternate plot name provided. Keeping old name.\n";
 108         }
 109
 110         print STDERR "$db_uniquename -> $new_uniquename\n";
 111
 112         my $old_stock = $schema->resultset('Stock::Stock')->find({ uniquename => $db_uniquename });
 113         my $new_stock = $schema->resultset('Stock::Stock')->find({ uniquename => $new_uniquename });
 114
 115         if (!$old_stock) {
 116             print STDERR "Warning! Stock with uniquename $db_uniquename was not found in the database.\n";
 117             next();
 118         }
 119         if (!$new_stock) {
 120             print STDERR "Warning! Stock with uniquename $new_uniquename was not found in the database.\n";
 121             next();
 122
 123         }
 124         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'";
 125
 126         my $h = $dbh->prepare($q);
 127         $h->execute($plot_id, $db_uniquename);
 128
 129         my ($plot, $acc, $stock_relationship_id) = $h->fetchrow_array();
 130
 131         #update stock_relationship row with new object_id...
 132         my $uq = "UPDATE stock_relationship set object_id=? where stock_relationship_id=?";
 133         my $uh = $dbh->prepare($uq);
 134         print STDERR "Changing object_id to ".$new_stock->stock_id()." for relationship $stock_relationship_id\n";
 135         if ($opt_t) {
 136             print STDERR "Not updating because of -t option...\n";
 137         }
 138         else {
 139             $uh->execute($new_stock->stock_id, $stock_relationship_id);
 140         }
 141
 142         if ($new_plotname) {
 143             print STDERR "Renaming plot to $new_plotname...\n";
 144             my $pq = "UPDATE stock SET uniquename=?, name=? WHERE stock_id=?";
 145             my $ph = $dbh->prepare($pq);
 146             $ph->execute($new_plotname, $new_plotname, $plot_id);
 147         }
 148     }
 149 };
 150
 151
 152 my $transaction_error;
 153 try {
 154     $schema->txn_do($coderef);
 155 } catch {
 156     $transaction_error =  $_;
 157 };
 158
 159 if ($transaction_error) {
 160     print STDERR "Transaction error storing terms: $transaction_error\n";
 161 } else {
 162     print STDERR "Script Complete.\n";
 163 }