db/00085/AddSeedlotForEveryAccession.pm

   1 #!/usr/bin/env perl
   2
   3
   4 =head1 NAME
   5
   6  AddSeedlotForEveryAccession.pm
   7
   8 =head1 SYNOPSIS
   9
  10 mx-run AddSeedlotForEveryAccession [options] -H hostname -D dbname -u username [-F]
  11
  12 this is a subclass of L<CXGN::Metadata::Dbpatch>
  13 see the perldoc of parent class for more details.
  14
  15 =head1 DESCRIPTION
  16 This patch inserts a seedlot for every accession.
  17
  18
  19 This subclass uses L<Moose>. The parent class uses L<MooseX::Runnable>
  20
  21 =head1 AUTHOR
  22
  23  Nick Morales<nm529@cornell.edu>
  24
  25 =head1 COPYRIGHT & LICENSE
  26
  27 Copyright 2010 Boyce Thompson Institute for Plant Research
  28
  29 This program is free software; you can redistribute it and/or modify
  30 it under the same terms as Perl itself.
  31
  32 =cut
  33
  34
  35 package AddSeedlotForEveryAccession;
  36
  37 use Moose;
  38 use Bio::Chado::Schema;
  39 use Try::Tiny;
  40 use SGN::Model::Cvterm;
  41 use CXGN::Stock::Seedlot;
  42 use CXGN::Stock::Seedlot::Transaction;
  43 use Data::Dumper;
  44 use CXGN::BreedersToolbox::Projects;
  45
  46 extends 'CXGN::Metadata::Dbpatch';
  47
  48
  49 has '+description' => ( default => <<'' );
  50 Update cassava_trait db prefix
  51
  52 has '+prereq' => (
  53         default => sub {
  54         ['AddSeedlotCurrentCountCvterm'],
  55     },
  56
  57   );
  58
  59 sub patch {
  60         my $self=shift;
  61
  62         print STDOUT "Executing the patch:\n " .   $self->name . ".\n\nDescription:\n  ".  $self->description . ".\n\nExecuted by:\n " .  $self->username . " .";
  63
  64         print STDOUT "\nChecking if this db_patch was executed before or if previous db_patches have been executed.\n";
  65
  66         print STDOUT "\nExecuting the SQL commands.\n";
  67         my $schema = Bio::Chado::Schema->connect( sub { $self->dbh->clone } );
  68
  69         my $accession_type_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'accession', 'stock_type')->cvterm_id();
  70         my $seedlot_type_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'seedlot', 'stock_type')->cvterm_id();
  71         my $plot_of_type_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'plot_of', 'stock_relationship')->cvterm_id();
  72         my $exp_type_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'field_layout', 'experiment_type')->cvterm_id();
  73         my $bp_rel_type_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'breeding_program_trial_relationship', 'project_relationship')->cvterm_id();
  74         my $seedlot_rs = $schema->resultset("Stock::Stock")->search({
  75                 type_id=>$seedlot_type_id
  76         });
  77
  78         # If the patch is unable to determine to which breeding program the new seedlot belongs to, the new seedlot will be assigned to this default breeding program. Please change it here in the file to match your database.
  79         my $userdefined_default_breeding_program = 'test';
  80         my $default_breeding_program_id = $schema->resultset('Project::Project')->find({name=>$userdefined_default_breeding_program})->project_id();
  81
  82         # FIRST, ADDS current_count property to seedlots already in database.
  83         print STDOUT "Adding current_count to any existing seedlots in database\n";
  84
  85         my %existing_seedlots;
  86         while(my $r=$seedlot_rs->next){
  87                 $existing_seedlots{$r->uniquename}++;
  88
  89                 my $sl = CXGN::Stock::Seedlot->new(schema => $schema, seedlot_id=>$r->stock_id);
  90                 $sl->set_current_count_property();
  91         }
  92
  93         # SECOND, DETERMINES which breeding program an accession has been used most in. This will be used to assign the seedlot later on.
  94         print STDOUT "Determining which breeding program an accession has been used most in. This will be used to assign the seedlot later on.\n";
  95
  96         my $accession_rs = $schema->resultset("Stock::Stock")->search(
  97                 {
  98                         'me.type_id'=>$accession_type_id,
  99                         'stock_relationship_objects.type_id'=>$plot_of_type_id,
 100                         'nd_experiment.type_id'=>$exp_type_id,
 101                         'project_relationship_subject_projects.type_id'=>$bp_rel_type_id
 102                 },
 103                 {
 104                         join=>{'stock_relationship_objects'=>{'subject'=>{'nd_experiment_stocks'=>{'nd_experiment'=>{'nd_experiment_projects'=>{'project'=>{'project_relationship_subject_projects'=>'object_project'}}}}}}},
 105                         '+select'=>['object_project.project_id', 'object_project.name'],
 106                         '+as'=>['bp_id', 'bp_name']
 107                 }
 108         );
 109         my %accession_bp_hash;
 110         my %accession_hash;
 111         while(my $r=$accession_rs->next){
 112                 $accession_bp_hash{$r->uniquename}->{$r->get_column('bp_id')}++;
 113                 $accession_hash{$r->uniquename} = $r->stock_id;
 114         }
 115         my %highest_accession_bp_hash;
 116         while(my($k,$v) = each %accession_bp_hash){
 117                 my %v = %$v;
 118                 my @bp_ids = sort { $v{$a} <=> $v{$b} } keys %v;
 119                 my $most_used = $bp_ids[-1];
 120                 $highest_accession_bp_hash{$k} = $most_used;
 121         }
 122         #print STDERR Dumper \%highest_accession_bp_hash;
 123
 124         # THIRD, DETERMINES if an accession has an organization associated that is actually a breeding program. If so, this breeding program will be assigned to the new seedlot.
 125         print STDOUT "Determining if an accession has an organization associated that is actually a breeding program. If so, this breeding program will be assigned to the new seedlot.\n";
 126
 127         my $p = CXGN::BreedersToolbox::Projects->new({schema=>$schema});
 128         my $breeding_programs = $p->get_breeding_programs();
 129         my %available_breeding_program_names;
 130         foreach (@$breeding_programs){
 131                 $available_breeding_program_names{$_->[1]}++;
 132         }
 133
 134         my $organization_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'organization', 'stock_property')->cvterm_id();
 135         my $organization_accession_rs = $schema->resultset("Stock::Stock")->search(
 136                 {
 137                         'me.type_id'=>$accession_type_id,
 138                         'stockprops.type_id'=>$organization_cvterm_id
 139                 },
 140                 {
 141                         'join'=>{'stockprops'=>'type'},
 142                         '+select'=>['stockprops.value'],
 143                         '+as'=>['organization']
 144                 }
 145         );
 146         my %accession_organization_hash;
 147         while (my $r=$organization_accession_rs->next){
 148                 my $organization = $r->get_column('organization');
 149                 if (exists($available_breeding_program_names{$organization})){
 150                         $accession_organization_hash{$r->uniquename} = $organization;
 151                 }
 152         }
 153
 154
 155         # THIRD, CREATES a seedlot for every accession in the database. Attempts to assign breeding program to seedlot based on accession's usage or accession's organization. If neither of these are found, then USERDEFINED default is assigned.
 156         print STDOUT "Creating seedlots\n";
 157
 158         my $full_accession_rs = $schema->resultset("Stock::Stock")->search({
 159                 type_id=>$accession_type_id
 160         });
 161
 162         while (my $r = $full_accession_rs->next){
 163                 my $accession_uniquename = $r->uniquename;
 164                 my $accession_stock_id = $r->stock_id;
 165                 my $seedlot_uniquename = $accession_uniquename."_001";
 166
 167                 if(exists($existing_seedlots{$seedlot_uniquename})){
 168                         next;
 169                 }
 170
 171                 my $seedlot_bp_id;
 172                 if (exists($accession_organization_hash{$accession_uniquename})){
 173                         $seedlot_bp_id = $accession_organization_hash{$accession_uniquename};
 174                 } elsif (exists($highest_accession_bp_hash{$accession_uniquename})){
 175                         $seedlot_bp_id = $highest_accession_bp_hash{$accession_uniquename};
 176                 } else {
 177                         $seedlot_bp_id = $default_breeding_program_id;
 178                 }
 179
 180                 my $sl = CXGN::Stock::Seedlot->new(schema => $schema);
 181                 $sl->uniquename($seedlot_uniquename);
 182                 $sl->location_code("NA");
 183                 $sl->accession_stock_id($accession_stock_id);
 184                 #$sl->organization_name();
 185                 #$sl->population_name($population_name);
 186                 $sl->breeding_program_id($seedlot_bp_id);
 187                 $sl->check_name_exists(0);
 188                 #TO DO
 189                 #$sl->cross_id($cross_id);
 190                 my $return = $sl->store();
 191                 my $seedlot_id = $return->{seedlot_id};
 192
 193                 my $timestamp = localtime();
 194                 my $transaction = CXGN::Stock::Seedlot::Transaction->new(schema => $schema);
 195                 $transaction->factor(1);
 196                 $transaction->from_stock([$accession_stock_id, $accession_uniquename]);
 197                 $transaction->to_stock([$seedlot_id, $seedlot_uniquename]);
 198                 $transaction->amount("1");
 199                 $transaction->timestamp($timestamp);
 200                 $transaction->description("Auto generated seedlot from accession. DbPatch 00085");
 201                 $transaction->operator('nmorales');
 202                 $transaction->store();
 203                 $sl->set_current_count_property();
 204         }
 205
 206
 207         print "You're done!\n";
 208 }
 209
 210
 211 ####
 212 1; #
 213 ####