bin/change_accessions_to_crosses.pl

   1 #!/usr/bin/perl
   2
   3 =head1
   4
   5 change_accessions_to_crosses.pl - a script for changing stocks with type accession to type cross, linking these crosses to female and male parents, nd_experiments and crossing experiments
   6
   7 =head1 SYNOPSIS
   8
   9 change_accessions_to_crosses.pl -H [dbhost] -D [dbname] -i [infile]
  10
  11 =head1 COMMAND-LINE OPTIONS
  12   ARGUMENTS
  13  -H host name (required) e.g. "localhost"
  14  -D database name (required) e.g. "cxgn_cassava"
  15  -i path to infile (required)
  16
  17 =head1 DESCRIPTION
  18 Use case: Previously, users were not able to use cross stock type in trials because cross stock type was not allowed. As a result, some of the cross names were uploaded as accession stock type. After an improvement by allowing cross stock type in trials, users would like to change those names with accession stock type to cross stock type.
  19
  20 This script changes stocks with type accession to type cross, then links each cross to parents,a cross type, an nd_experiment and a project.  The infile provided has 5 columns. The first column contains stock uniquenames stored as accession stock type. The second column contains female parent uniquenames. The third column contains male parent uniquenames. The forth column contains cross type info. The fifth column contains crossing experiment names. There is no header on the infile and the infile is .xls.
  21 =head1 AUTHOR
  22
  23 Titima Tantikanjana <tt15@cornell.edu>
  24
  25 =cut
  26
  27 use strict;
  28
  29 use Getopt::Std;
  30 use Data::Dumper;
  31 use Carp qw /croak/ ;
  32 use Pod::Usage;
  33 use Spreadsheet::ParseExcel;
  34 use Bio::Chado::Schema;
  35 use CXGN::DB::InsertDBH;
  36 use Try::Tiny;
  37 use SGN::Model::Cvterm;
  38
  39 our ($opt_H, $opt_D, $opt_i);
  40
  41 getopts('H:D:i:');
  42
  43 if (!$opt_H || !$opt_D || !$opt_i) {
  44     pod2usage(-verbose => 2, -message => "Must provide options -H (hostname), -D (database name), -i (input file)\n");
  45 }
  46
  47 my $dbhost = $opt_H;
  48 my $dbname = $opt_D;
  49 my $parser   = Spreadsheet::ParseExcel->new();
  50 my $excel_obj = $parser->parse($opt_i);
  51
  52 my $dbh = CXGN::DB::InsertDBH->new({
  53         dbhost=>$dbhost,
  54         dbname=>$dbname,
  55         dbargs => {AutoCommit => 1, RaiseError => 1}
  56 });
  57
  58 my $schema= Bio::Chado::Schema->connect(  sub { $dbh->get_actual_dbh() } );
  59 $dbh->do('SET search_path TO public,sgn');
  60
  61
  62 my $worksheet = ( $excel_obj->worksheets() )[0]; #support only one worksheet
  63 my ( $row_min, $row_max ) = $worksheet->row_range();
  64 my ( $col_min, $col_max ) = $worksheet->col_range();
  65
  66 my $coderef = sub {
  67     my $accession_cvterm_id  =  SGN::Model::Cvterm->get_cvterm_row($schema, 'accession', 'stock_type')->cvterm_id();
  68     my $cross_cvterm_id  =  SGN::Model::Cvterm->get_cvterm_row($schema, 'cross', 'stock_type')->cvterm_id();
  69     my $female_parent_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'female_parent', 'stock_relationship')->cvterm_id();
  70     my $male_parent_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'male_parent', 'stock_relationship')->cvterm_id();
  71     my $project_location_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'project location', 'project_property')->cvterm_id();
  72     my $cross_experiment_cvterm =  SGN::Model::Cvterm->get_cvterm_row($schema, 'cross_experiment', 'experiment_type');
  73
  74     for my $row ( 0 .. $row_max ) {
  75
  76         my $stock_uniquename = $worksheet->get_cell($row,0)->value();
  77         $stock_uniquename =~ s/^\s+|\s+$//g;
  78
  79         my $female_parent_uniquename = $worksheet->get_cell($row,1)->value();
  80         $female_parent_uniquename =~ s/^\s+|\s+$//g;
  81
  82         my $male_parent_uniquename = $worksheet->get_cell($row,2)->value();
  83         $male_parent_uniquename =~ s/^\s+|\s+$//g;
  84
  85         my $cross_type = $worksheet->get_cell($row,3)->value();
  86         $cross_type =~ s/^\s+|\s+$//g;
  87
  88         my $crossing_experiment_name = $worksheet->get_cell($row,4)->value();
  89         $crossing_experiment_name =~ s/^\s+|\s+$//g;
  90
  91         my $stock_rs = $schema->resultset('Stock::Stock')->find({ uniquename => $stock_uniquename, type_id => $accession_cvterm_id });
  92         my $female_rs = $schema->resultset('Stock::Stock')->find({ uniquename => $female_parent_uniquename, type_id => $accession_cvterm_id });
  93         my $male_rs = $schema->resultset('Stock::Stock')->find({ uniquename => $male_parent_uniquename, type_id => $accession_cvterm_id });
  94         my $crossing_experiment_rs = $schema->resultset("Project::Project")->find( { name => $crossing_experiment_name });
  95
  96         if (!$stock_rs) {
  97             print STDERR "Error! Stock with uniquename $stock_uniquename was not found in the database.\n";
  98             next();
  99         }
 100         if (!$female_rs) {
 101             print STDERR "Error! Female parent with uniquename $female_parent_uniquename was not found in the database.\n";
 102             next();
 103         }
 104         if (!$male_rs) {
 105             print STDERR "Error! Male parent with uniquename $male_parent_uniquename was not found in the database.\n";
 106             next();
 107         }
 108         if (!$crossing_experiment_rs) {
 109             print STDERR "Error! Crossing experiment: $crossing_experiment_name was not found in the database.\n";
 110             next();
 111         }
 112
 113         my $crossing_experiment_id = $crossing_experiment_rs->project_id();
 114         my $geolocation_rs = $schema->resultset("Project::Projectprop")->find({project_id => $crossing_experiment_id, type_id => $project_location_cvterm_id});
 115
 116         #update stock type
 117         my $cross_stock_rs = $stock_rs->update({ type_id => $cross_cvterm_id});
 118
 119          #link cross to female and male parents
 120         my $stock_female_rs = $schema->resultset("Stock::StockRelationship")->search({ object_id => $cross_stock_rs->stock_id(), type_id => $female_parent_cvterm_id });
 121         my $previous_female = $stock_female_rs->count();
 122 #        print STDERR "FEMALE COUNT =".Dumper($previous_female)."\n";
 123         if ($previous_female > 0) {
 124             print STDERR "Stock: $stock_uniquename already has female parent in the database.\n";
 125             next();
 126         } else {
 127             $cross_stock_rs->find_or_create_related('stock_relationship_objects', {
 128                 type_id => $female_parent_cvterm_id,
 129                 object_id => $cross_stock_rs->stock_id(),
 130                 subject_id => $female_rs->stock_id(),
 131                 value => $cross_type,
 132             });
 133         }
 134
 135         my $stock_male_rs = $schema->resultset("Stock::StockRelationship")->search({ object_id => $cross_stock_rs->stock_id(), type_id => $male_parent_cvterm_id });
 136         my $previous_male = $stock_male_rs->count();
 137         if ($previous_male > 0) {
 138             print STDERR "Stock: $stock_uniquename already has male parent in the database.\n";
 139             next();
 140         } else {
 141             $cross_stock_rs->find_or_create_related('stock_relationship_objects', {
 142                 type_id => $male_parent_cvterm_id,
 143                 object_id => $cross_stock_rs->stock_id(),
 144                 subject_id => $male_rs->stock_id(),
 145             });
 146         }
 147
 148         #create experiment
 149         my $experiment = $schema->resultset('NaturalDiversity::NdExperiment')->create({
 150             nd_geolocation_id => $geolocation_rs->value,
 151             type_id => $cross_experiment_cvterm->cvterm_id(),
 152         });
 153
 154         #link cross unique id to the experiment
 155         $experiment->find_or_create_related('nd_experiment_stocks' , {
 156               stock_id => $cross_stock_rs->stock_id(),
 157               type_id  =>  $cross_experiment_cvterm->cvterm_id(),
 158             });
 159
 160         #link experiment to the project
 161         $experiment->find_or_create_related('nd_experiment_projects', {
 162             project_id => $crossing_experiment_id,
 163         });
 164     }
 165 };
 166
 167 my $transaction_error;
 168 try {
 169     $schema->txn_do($coderef);
 170 } catch {
 171     $transaction_error =  $_;
 172 };
 173
 174 if ($transaction_error) {
 175     print STDERR "Transaction error storing terms: $transaction_error\n";
 176 } else {
 177     print STDERR "Script Complete.\n";
 178 }