lib/CXGN/Stock/Seedlot.pm

   1
   2 =head1 NAME
   3
   4 CXGN::Stock::Seedlot - a class to represent seedlots in the database
   5
   6 =head1 DESCRIPTION
   7
   8 CXGN::Stock::Seedlot inherits from CXGN::Stock.
   9
  10 To create a new seedlot do:
  11 #Seedlot can either be from an accession or a cross, therefore, supply an accession_stock_id OR a cross_stock_id here
  12
  13 my $sl = CXGN::Stock::Seedlot->new(schema => $schema);
  14 $sl->uniquename($seedlot_uniquename);
  15 $sl->location_code($location_code);
  16 $sl->accession_stock_id($accession_id);
  17 $sl->cross_stock_id($cross_id);
  18 $sl->organization_name($organization);
  19 $sl->population_name($population_name);
  20 $sl->breeding_program_id($breeding_program_id);
  21 my $return = $sl->store();
  22 my $seedlot_id = $return->{seedlot_id};
  23
  24 #The first transaction is between the accession_stock_id OR cross_stock_id that you specified above and the new seedlot created.
  25 my $transaction = CXGN::Stock::Seedlot::Transaction->new(schema => $schema);
  26 $transaction->factor(1);
  27 $transaction->from_stock([$from_stock_id, $from_stock_uniquename]);
  28 $transaction->to_stock([$seedlot_id, $seedlot_uniquename]);
  29 $transaction->amount($amount);
  30 $transaction->timestamp($timestamp);
  31 $transaction->description($description);
  32 $transaction->operator($operator);
  33 $transaction->store();
  34
  35 $sl->set_current_count_property();
  36
  37 $phenome_schema->resultset("StockOwner")->find_or_create({
  38     stock_id     => $seedlot_id,
  39     sp_person_id =>  $user_id,
  40 });
  41
  42 -------------------------------------------------------------------------------
  43
  44 To Update or Edit a seedlot do:
  45
  46 my $seedlot = CXGN::Stock::Seedlot->new(
  47     schema => $schema,
  48     seedlot_id => $seedlot_id,
  49 );
  50 $seedlot->name($seedlot_name);
  51 $seedlot->uniquename($seedlot_name);
  52 $seedlot->breeding_program_id($breeding_program_id);
  53 $seedlot->organization_name($organization);
  54 $seedlot->location_code($location);
  55 $seedlot->accession_stock_id($accession_id);
  56 $seedlot->cross_stock_id($cross_id);
  57 $seedlot->population_name($population);
  58 my $return = $seedlot->store();
  59
  60 ------------------------------------------------------------------------------
  61
  62 To Search Across Seedlots do:
  63 # This is different from CXGN::Stock::Search in that is retrieves information pertinent to seedlots like location and current count
  64
  65 my ($list, $records_total) = CXGN::Stock::Seedlot->list_seedlots(
  66     $c->dbic_schema("Bio::Chado::Schema"),
  67     $offset,
  68     $limit,
  69     $seedlot_name,
  70     $breeding_program,
  71     $location,
  72     $minimum_count,
  73     $contents_accession,
  74     $contents_cross
  75 );
  76
  77 ------------------------------------------------------------------------------
  78
  79 To Retrieve a single seedlot do:
  80
  81 my $seedlot = CXGN::Stock::Seedlot->new(
  82     schema => $schema,
  83     seedlot_id => $seedlot_id,
  84 );
  85 # You can access all seedlot accessors from here such as (you can also access all CXGN::Stock accessors):
  86 my $uniquename => $seedlot->uniquename(),
  87 my $seedlot_id => $seedlot->seedlot_id(),
  88 my $current_count => $seedlot->current_count(),
  89 my $location_code => $seedlot->location_code(),
  90 my $breeding_program => $seedlot->breeding_program_name(),
  91 my $organization_name => $seedlot->organization_name(),
  92 my $population_name => $seedlot->population_name(),
  93 my $accession => $seedlot->accession(),
  94 my $cross => $seedlot->cross(),
  95
  96 ------------------------------------------------------------------------------
  97
  98 Seed transactions can be added using CXGN::Stock::Seedlot::Transaction.
  99
 100 =head1 AUTHOR
 101
 102 Lukas Mueller <lam87@cornell.edu>
 103 Nick MOrales <nm529@cornell.edu>
 104
 105 =head1 ACCESSORS & METHODS
 106
 107 =cut
 108
 109 package CXGN::Stock::Seedlot;
 110
 111 use Moose;
 112
 113 extends 'CXGN::Stock';
 114
 115 use Data::Dumper;
 116 use CXGN::Stock::Seedlot::Transaction;
 117 use CXGN::BreedersToolbox::Projects;
 118 use SGN::Model::Cvterm;
 119 use CXGN::List::Validate;
 120 use Try::Tiny;
 121 use CXGN::Stock::StockLookup;
 122 use CXGN::Stock::Search;
 123
 124 =head2 Accessor seedlot_id()
 125
 126 the database id of the seedlot. Is equivalent to stock_id.
 127
 128 =cut
 129
 130 has 'seedlot_id' => (
 131     isa => 'Maybe[Int]',
 132     is => 'rw',
 133 );
 134
 135 =head2 Accessor location_code()
 136
 137 A string specifiying where the seedlot is stored. On the backend,
 138 this is stored the nd_geolocation description field.
 139
 140 =cut
 141
 142 has 'location_code' => (
 143     isa => 'Str',
 144     is => 'rw',
 145     lazy     => 1,
 146     builder  => '_retrieve_location',
 147 );
 148
 149 has 'nd_geolocation_id' => (
 150     isa => 'Int',
 151     is => 'rw',
 152 );
 153
 154 =head2 Accessor box_name()
 155
 156 A string specifiying box where the seedlot is stored. On the backend,
 157 this is stored as a stockprop.
 158
 159 =cut
 160
 161 has 'box_name' => (
 162     isa => 'Str|Undef',
 163     is => 'rw',
 164     lazy     => 1,
 165     builder  => '_retrieve_box_name',
 166 );
 167
 168 =head2 Accessor cross()
 169
 170 The crosses this seedlot is a "collection_of". Returns an arrayref of [$cross_stock_id, $cross_uniquename]
 171 # for setter, use cross_stock_id
 172
 173 =cut
 174
 175 has 'cross' => (
 176     isa => 'ArrayRef|Undef',
 177     is => 'rw',
 178     lazy     => 1,
 179     builder  => '_retrieve_cross',
 180 );
 181
 182 has 'cross_stock_id' =>   (
 183     isa => 'Int|Undef',
 184     is => 'rw',
 185 );
 186
 187 =head2 Accessor accessions()
 188
 189 The accessions this seedlot is a "collection_of". Returns an arrayref of [$accession_stock_id, $accession_uniquename]
 190 # for setter, use accession_stock_id
 191
 192 =cut
 193
 194 has 'accession' => (
 195     isa => 'ArrayRef|Undef',
 196     is => 'rw',
 197     lazy     => 1,
 198     builder  => '_retrieve_accession',
 199 );
 200
 201 has 'accession_stock_id' => (
 202     isa => 'Int|Undef',
 203     is => 'rw',
 204 );
 205
 206 =head2 Accessor transactions()
 207
 208 a ArrayRef of CXGN::Stock::Seedlot::Transaction objects
 209
 210 =cut
 211
 212 has 'transactions' =>     (
 213     isa => 'ArrayRef',
 214     is => 'rw',
 215     lazy     => 1,
 216     builder  => '_build_transactions',
 217 );
 218
 219 =head2 Accessor breeding_program
 220
 221 The breeding program this seedlot is from. Useful for tracking movement of seedlots across breeding programs
 222 Use breeding_program_id as setter (to save and update seedlots).
 223
 224 =cut
 225
 226 has 'breeding_program_name' => (
 227     isa => 'Str',
 228     is => 'rw',
 229     lazy     => 1,
 230     builder  => '_retrieve_breeding_program',
 231 );
 232
 233 has 'breeding_program_id' => (
 234     isa => 'Int',
 235     is => 'rw',
 236 );
 237
 238
 239 after 'stock_id' => sub {
 240     my $self = shift;
 241     my $id = shift;
 242     return $self->seedlot_id($id);
 243 };
 244
 245 # class method
 246 =head2 Class method: list_seedlots()
 247
 248  Usage:        my $seedlots = CXGN::Stock::Seedlot->list_seedlots($schema);
 249  Desc:         Class method that returns information on all seedlots
 250                available in the system
 251  Ret:          ArrayRef of [ seedlot_id, seedlot name, location_code]
 252  Args:         $schema - Bio::Chado::Schema object
 253  Side Effects: accesses the database
 254
 255 =cut
 256
 257 sub list_seedlots {
 258     my $class = shift;
 259     my $schema = shift;
 260     my $people_schema = shift;
 261     my $phenome_schema = shift;
 262     my $offset = shift;
 263     my $limit = shift;
 264     my $seedlot_name = shift;
 265     my $breeding_program = shift;
 266     my $location = shift;
 267     my $minimum_count = shift;
 268     my $contents_accession = shift; #arrayref of uniquenames
 269     my $contents_cross = shift; #arrayref of uniquenames
 270     my $exact_match_uniquenames = shift;
 271
 272     print STDERR "SEARCHING SEEDLOTS\n";
 273     my %unique_seedlots;
 274
 275     my $type_id = SGN::Model::Cvterm->get_cvterm_row($schema, "seedlot", "stock_type")->cvterm_id();
 276     my $cross_type_id = SGN::Model::Cvterm->get_cvterm_row($schema, "cross", "stock_type")->cvterm_id();
 277     my $accession_type_id = SGN::Model::Cvterm->get_cvterm_row($schema, "accession", "stock_type")->cvterm_id();
 278     my $collection_of_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, "collection_of", "stock_relationship")->cvterm_id();
 279     my $current_count_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, "current_count", "stock_property")->cvterm_id();
 280     my $current_weight_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, "current_weight_gram", "stock_property")->cvterm_id();
 281     my $experiment_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, "seedlot_experiment", "experiment_type")->cvterm_id();
 282
 283     my %search_criteria;
 284     $search_criteria{'me.type_id'} = $type_id;
 285     $search_criteria{'stock_relationship_objects.type_id'} = $collection_of_cvterm_id;
 286     if ($seedlot_name) {
 287         $search_criteria{'me.uniquename'} = { 'ilike' => '%'.$seedlot_name.'%' };
 288     }
 289     if ($breeding_program) {
 290         $search_criteria{'project.name'} = { 'ilike' => '%'.$breeding_program.'%' };
 291     }
 292     if ($location) {
 293         $search_criteria{'nd_geolocation.description'} = { 'ilike' => '%'.$location.'%' };
 294     }
 295     if ($contents_accession && scalar(@$contents_accession)>0) {
 296         $search_criteria{'subject.type_id'} = $accession_type_id;
 297         if ($exact_match_uniquenames){
 298             $search_criteria{'subject.uniquename'} = { -in => $contents_accession };
 299         } else {
 300             foreach (@$contents_accession){
 301                 push @{$search_criteria{'subject.uniquename'}}, { 'ilike' => '%'.$_.'%' };
 302             }
 303         }
 304     }
 305     if ($contents_cross && scalar(@$contents_cross)>0) {
 306         $search_criteria{'subject.type_id'} = $cross_type_id;
 307         if ($exact_match_uniquenames){
 308             $search_criteria{'subject.uniquename'} = { -in => $contents_cross };
 309         } else {
 310             foreach (@$contents_cross){
 311                 push @{$search_criteria{'subject.uniquename'}}, { 'ilike' => '%'.$_.'%' };
 312             }
 313         }
 314     }
 315     if ($minimum_count) {
 316         $search_criteria{'stockprops.value' }  = { '>' => $minimum_count };
 317     }
 318     #print STDERR Dumper \%search_criteria;
 319     #$schema->storage->debug(1);
 320     my $rs = $schema->resultset("Stock::Stock")->search(
 321         \%search_criteria,
 322         {
 323             join => [
 324                 {'nd_experiment_stocks' => {'nd_experiment' => [ {'nd_experiment_projects' => 'project' }, 'nd_geolocation' ] }},
 325                 {'stock_relationship_objects' => 'subject'}
 326             ],
 327             '+select'=>['project.name', 'project.project_id', 'subject.stock_id', 'subject.uniquename', 'subject.type_id', 'nd_geolocation.description', 'nd_geolocation.nd_geolocation_id'],
 328             '+as'=>['breeding_program_name', 'breeding_program_id', 'source_stock_id', 'source_uniquename', 'source_type_id', 'location', 'location_id'],
 329             order_by => {-asc=>'project.name'},
 330             #distinct => 1
 331         }
 332     );
 333
 334     my %source_types_hash = ( $type_id => 'seedlot', $accession_type_id => 'accession', $cross_type_id => 'cross' );
 335     my $records_total = $rs->count();
 336     if (defined($limit) && defined($offset)){
 337         $rs = $rs->slice($offset, $limit);
 338     }
 339     my %seen_seedlot_ids;
 340     while (my $row = $rs->next()) {
 341         $seen_seedlot_ids{$row->stock_id}++;
 342         $unique_seedlots{$row->uniquename}->{seedlot_stock_id} = $row->stock_id;
 343         $unique_seedlots{$row->uniquename}->{seedlot_stock_uniquename} = $row->uniquename;
 344         $unique_seedlots{$row->uniquename}->{seedlot_stock_description} = $row->description;
 345         $unique_seedlots{$row->uniquename}->{breeding_program_name} = $row->get_column('breeding_program_name');
 346         $unique_seedlots{$row->uniquename}->{breeding_program_id} = $row->get_column('breeding_program_id');
 347         $unique_seedlots{$row->uniquename}->{location} = $row->get_column('location');
 348         $unique_seedlots{$row->uniquename}->{location_id} = $row->get_column('location_id');
 349         push @{$unique_seedlots{$row->uniquename}->{source_stocks}}, [$row->get_column('source_stock_id'), $row->get_column('source_uniquename'), $source_types_hash{$row->get_column('source_type_id')}];
 350     }
 351     #print STDERR Dumper \%unique_seedlots;
 352
 353     my @seen_seedlot_ids = keys %seen_seedlot_ids;
 354     my $stock_lookup = CXGN::Stock::StockLookup->new({ schema => $schema} );
 355     my $owners_hash = $stock_lookup->get_owner_hash_lookup(\@seen_seedlot_ids);
 356
 357     my $stock_search = CXGN::Stock::Search->new({
 358         bcs_schema=>$schema,
 359         people_schema=>$people_schema,
 360         phenome_schema=>$phenome_schema,
 361         stock_id_list=>\@seen_seedlot_ids,
 362         stock_type_id=>$type_id,
 363         stockprop_columns_view=>{'current_count'=>1, 'current_weight_gram'=>1, 'organization'=>1},
 364         minimal_info=>1,  #for only returning stock_id and uniquenames
 365         display_pedigree=>0 #to calculate and display pedigree
 366     });
 367     my ($stocksearch_result, $records_stock_total) = $stock_search->search();
 368     #print STDERR Dumper $result;
 369     my %stockprop_hash;
 370     foreach (@$stocksearch_result){
 371         $stockprop_hash{$_->{stock_id}} = $_;
 372     }
 373
 374     my @seedlots;
 375     foreach (sort keys %unique_seedlots){
 376         my $owners = $owners_hash->{$unique_seedlots{$_}->{seedlot_stock_id}};
 377         my @owners_html;
 378         foreach (@$owners){
 379             push @owners_html ,'<a href="/solpeople/personal-info.pl?sp_person_id='.$_->[0].'">'.$_->[2].' '.$_->[3].'</a>';
 380         }
 381         my $owners_string = join ', ', @owners_html;
 382         $unique_seedlots{$_}->{owners_string} = $owners_string;
 383         $unique_seedlots{$_}->{current_count} = $stockprop_hash{$unique_seedlots{$_}->{seedlot_stock_id}}->{current_count} ? $stockprop_hash{$unique_seedlots{$_}->{seedlot_stock_id}}->{current_count} : 'NA';
 384         $unique_seedlots{$_}->{current_weight_gram} = $stockprop_hash{$unique_seedlots{$_}->{seedlot_stock_id}}->{current_weight_gram} ? $stockprop_hash{$unique_seedlots{$_}->{seedlot_stock_id}}->{current_weight_gram} : 'NA';
 385         push @seedlots, $unique_seedlots{$_};
 386     }
 387     #print STDERR Dumper \@seedlots;
 388     return (\@seedlots, $records_total);
 389 }
 390
 391 # class method
 392 =head2 Class method: verify_seedlot_stock_lists()
 393
 394  Usage:        my $seedlots = CXGN::Stock::Seedlot->verify_seedlot_stock_lists($schema, $people_schema, $phenome_schema, \@stock_names, \@seedlot_names);
 395  Desc:         Class method that verifies if a given list of seedlots is valid for a given list of accessions
 396  Ret:          success or error
 397  Args:         $schema, $stock_names, $seedlot_names
 398  Side Effects: accesses the database
 399
 400 =cut
 401
 402 sub verify_seedlot_stock_lists {
 403     my $class = shift;
 404     my $schema = shift;
 405     my $people_schema = shift;
 406     my $phenome_schema = shift;
 407     my $stock_names = shift;
 408     my $seedlot_names = shift;
 409     my $error = '';
 410     my %return;
 411
 412     if (!$stock_names) {
 413         $error .= "No accession list selected!";
 414     }
 415     if (!$seedlot_names) {
 416         $error .= "No seedlot list supplied!";
 417     }
 418     if ($error){
 419         $return{error} = $error;
 420         return \%return;
 421     }
 422
 423     my @stock_names = @$stock_names;
 424     my @seedlot_names = @$seedlot_names;
 425     if (scalar(@stock_names)<1){
 426         $error .= "Your accession list is empty!";
 427     }
 428     if (scalar(@seedlot_names)<1){
 429         $error .= "Your seedlot list is empty!";
 430     }
 431     if ($error){
 432         $return{error} = $error;
 433         return \%return;
 434     }
 435
 436     my $lv = CXGN::List::Validate->new();
 437     my @accessions_missing = @{$lv->validate($schema,'accessions',\@stock_names)->{'missing'}};
 438     my $lv_seedlots = CXGN::List::Validate->new();
 439     my @seedlots_missing = @{$lv_seedlots->validate($schema,'seedlots',\@seedlot_names)->{'missing'}};
 440
 441     if (scalar(@accessions_missing) > 0){
 442         $error .= 'The following accessions are not valid in the database, so you must add them first: '.join ',', @accessions_missing;
 443     }
 444     if (scalar(@seedlots_missing) > 0){
 445         $error .= 'The following seedlots are not valid in the database, so you must add them first: '.join ',', @seedlots_missing;
 446     }
 447     if ($error){
 448         $return{error} = $error;
 449         return \%return;
 450     }
 451
 452     my %selected_seedlots = map {$_=>1} @seedlot_names;
 453     my %selected_accessions = map {$_=>1} @stock_names;
 454     my %seedlot_hash;
 455
 456     my $ac = CXGN::BreedersToolbox::Accessions->new({schema=>$schema, people_schema=>$people_schema, phenome_schema=>$phenome_schema});
 457     my $possible_seedlots = $ac->get_possible_seedlots(\@stock_names);
 458     my %allowed_seedlots;
 459     while (my($key,$val) = each %$possible_seedlots){
 460         foreach my $seedlot (@$val){
 461             my $seedlot_name = $seedlot->{seedlot}->[0];
 462             if (exists($selected_accessions{$key}) && exists($selected_seedlots{$seedlot_name})){
 463                 push @{$seedlot_hash{$key}}, $seedlot_name;
 464             }
 465         }
 466     }
 467     #if(scalar(keys %seedlot_hash) != scalar(@stock_names)){
 468     #    $error .= "Error: The seedlot list you select must include seedlots for all the accessions you have selected. ";
 469     #}
 470     if ($error){
 471         $return{error} = $error;
 472     } else {
 473         $return{success} = 1;
 474         $return{seedlot_hash} = \%seedlot_hash;
 475     }
 476     return \%return;
 477 }
 478
 479 # class method
 480 =head2 Class method: verify_seedlot_plot_compatibility()
 481
 482  Usage:        my $seedlots = CXGN::Stock::Seedlot->verify_seedlot_plot_compatibility($schema, [[$seedlot_name, $plot_name]]);
 483  Desc:         Class method that verifies if a given list of pairs of seedlot_name and plot_name have the same underlying accession.
 484  Ret:          success or error
 485  Args:         $schema, $stock_names, $seedlot_names
 486  Side Effects: accesses the database
 487
 488 =cut
 489
 490 sub verify_seedlot_plot_compatibility {
 491     my $class = shift;
 492     my $schema = shift;
 493     my $pairs = shift; #arrayref of [ [seedlot_name, plot_name] ]
 494     my $error = '';
 495     my %return;
 496
 497     if (!$pairs){
 498         $error .= "No pair array passed!";
 499     }
 500     if ($error){
 501         $return{error} = $error;
 502         return \%return;
 503     }
 504
 505     my @pairs = @$pairs;
 506     if (scalar(@pairs)<1){
 507         $error .= "Your pairs list is empty!";
 508     }
 509     if ($error){
 510         $return{error} = $error;
 511         return \%return;
 512     }
 513
 514     my $plot_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, "plot", "stock_type")->cvterm_id();
 515     my $seedlot_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, "seedlot", "stock_type")->cvterm_id();
 516     my $plot_of_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, "plot_of", "stock_relationship")->cvterm_id();
 517     my $collection_of_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, "collection_of", "stock_relationship")->cvterm_id();
 518     foreach (@pairs){
 519         my $seedlot_name = $_->[0];
 520         my $plot_name = $_->[1];
 521
 522         #The plot is linked to one accession via 'plot_of'. That accession is then linked to many seedlots via 'collection_of'. Here we can check if the provided seedlot is one of the seedlots linked to the plot's accession.
 523         my $seedlot_rs = $schema->resultset("Stock::Stock")->search({'me.uniquename'=>$plot_name, 'me.type_id'=>$plot_cvterm_id})->search_related('stock_relationship_subjects', {'stock_relationship_subjects.type_id'=>$plot_of_cvterm_id})->search_related('object')->search_related('stock_relationship_subjects', {'stock_relationship_subjects_2.type_id'=>$collection_of_cvterm_id})->search_related('object', {'object_2.uniquename'=>$seedlot_name, 'object_2.type_id'=>$seedlot_cvterm_id});
 524         if (!$seedlot_rs->first){
 525             $error .= "The seedlot: $seedlot_name is not linked to the same accession as the plot: $plot_name . ";
 526         }
 527     }
 528     if ($error){
 529         $return{error} = $error;
 530     } else {
 531         $return{success} = 1;
 532     }
 533     return \%return;
 534 }
 535
 536 # class method
 537 =head2 Class method: verify_seedlot_accessions()
 538
 539  Usage:        my $seedlots = CXGN::Stock::Seedlot->verify_seedlot_accessions($schema, [[$seedlot_name, $accession_name]]);
 540  Desc:         Class method that verifies if a given list of pairs of seedlot_name and accession_name have the same underlying accession.
 541  Ret:          success or error
 542  Args:         $schema, $stock_names, $seedlot_names
 543  Side Effects: accesses the database
 544
 545 =cut
 546
 547 sub verify_seedlot_accessions {
 548     my $class = shift;
 549     my $schema = shift;
 550     my $pairs = shift; #arrayref of [ [seedlot_name, accession_name] ]
 551     my $error = '';
 552     my %return;
 553
 554     if (!$pairs){
 555         $error .= "No pair array passed!";
 556     }
 557     if ($error){
 558         $return{error} = $error;
 559         return \%return;
 560     }
 561
 562     my @pairs = @$pairs;
 563     if (scalar(@pairs)<1){
 564         $error .= "Your pairs list is empty!";
 565     }
 566     if ($error){
 567         $return{error} = $error;
 568         return \%return;
 569     }
 570
 571     my $accession_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, "accession", "stock_type")->cvterm_id();
 572     my $seedlot_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, "seedlot", "stock_type")->cvterm_id();
 573     my $collection_of_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, "collection_of", "stock_relationship")->cvterm_id();
 574     foreach (@pairs){
 575         my $seedlot_name = $_->[0];
 576         my $accession_name = $_->[1];
 577
 578         my $seedlot_rs = $schema->resultset("Stock::Stock")->search({'me.uniquename'=>$seedlot_name, 'me.type_id'=>$seedlot_cvterm_id})->search_related('stock_relationship_objects', {'stock_relationship_objects.type_id'=>$collection_of_cvterm_id})->search_related('subject', {'subject.uniquename'=>$accession_name, 'subject.type_id'=>$accession_cvterm_id});
 579         if (!$seedlot_rs->first){
 580             $error .= "The seedlot: $seedlot_name is not linked to the accession: $accession_name.";
 581         }
 582     }
 583     if ($error){
 584         $return{error} = $error;
 585     } else {
 586         $return{success} = 1;
 587     }
 588     return \%return;
 589 }
 590
 591 sub BUILDARGS {
 592     my $orig = shift;
 593     my %args = @_;
 594     $args{stock_id} = $args{seedlot_id};
 595     return \%args;
 596 }
 597
 598 sub BUILD {
 599     my $self = shift;
 600     if ($self->stock_id()) {
 601         $self->seedlot_id($self->stock_id);
 602         $self->name($self->uniquename());
 603         $self->seedlot_id($self->stock_id());
 604     }
 605     #print STDERR Dumper $self->seedlot_id;
 606 }
 607
 608 sub _build_transactions {
 609     my $self = shift;
 610     my $transactions = CXGN::Stock::Seedlot::Transaction->get_transactions_by_seedlot_id($self->schema(), $self->seedlot_id());
 611     #print STDERR Dumper($transactions);
 612     $self->transactions($transactions);
 613 }
 614
 615 sub _store_seedlot_location {
 616     my $self = shift;
 617     my $nd_geolocation = $self->schema()->resultset("NaturalDiversity::NdGeolocation")->find_or_create({
 618         description => $self->location_code
 619     });
 620     $self->nd_geolocation_id($nd_geolocation->nd_geolocation_id);
 621 }
 622
 623 sub _retrieve_location {
 624     my $self = shift;
 625     my $experiment_type_id = SGN::Model::Cvterm->get_cvterm_row($self->schema(), "seedlot_experiment", "experiment_type")->cvterm_id();
 626     my $nd_geolocation_rs = $self->schema()->resultset('Stock::Stock')->search({'me.stock_id'=>$self->seedlot_id})->search_related('nd_experiment_stocks')->search_related('nd_experiment', {'nd_experiment.type_id'=>$experiment_type_id})->search_related('nd_geolocation');
 627     if ($nd_geolocation_rs->count != 1){
 628         die "Seedlot does not have 1 nd_geolocation associated!\n";
 629     }
 630     my $nd_geolocation_id = $nd_geolocation_rs->first()->nd_geolocation_id();
 631     my $location_code = $nd_geolocation_rs->first()->description();
 632     $self->nd_geolocation_id($nd_geolocation_id);
 633     $self->location_code($location_code);
 634 }
 635
 636 sub _retrieve_box_name {
 637     my $self = shift;
 638     $self->box_name($self->_retrieve_stockprop('location_code'));
 639 }
 640
 641 sub _retrieve_breeding_program {
 642     my $self = shift;
 643     my $experiment_type_id = SGN::Model::Cvterm->get_cvterm_row($self->schema(), "seedlot_experiment", "experiment_type")->cvterm_id();
 644     my $project_rs = $self->schema()->resultset('Stock::Stock')->search({'me.stock_id'=>$self->seedlot_id})->search_related('nd_experiment_stocks')->search_related('nd_experiment', {'nd_experiment.type_id'=>$experiment_type_id})->search_related('nd_experiment_projects')->search_related('project');
 645     if ($project_rs->count != 1){
 646         die "Seedlot does not have 1 breeding program project (".$project_rs->count.") associated!\n";
 647     }
 648     my $breeding_program_id = $project_rs->first()->project_id();
 649     my $breeding_program_name = $project_rs->first()->name();
 650     $self->breeding_program_id($breeding_program_id);
 651     $self->breeding_program_name($breeding_program_name);
 652 }
 653
 654 sub _store_seedlot_relationships {
 655     my $self = shift;
 656     my $error;
 657
 658     eval {
 659         if ($self->accession_stock_id){
 660             $error = $self->_store_seedlot_accession();
 661         }
 662         if ($self->cross_stock_id){
 663             $error = $self->_store_seedlot_cross();
 664         }
 665         if (!$error){
 666             my $experiment_type_id = SGN::Model::Cvterm->get_cvterm_row($self->schema(), "seedlot_experiment", "experiment_type")->cvterm_id();
 667             my $experiment = $self->schema->resultset('NaturalDiversity::NdExperiment')->create({
 668                 nd_geolocation_id => $self->nd_geolocation_id,
 669                 type_id => $experiment_type_id
 670             });
 671             $experiment->create_related('nd_experiment_stocks', { stock_id => $self->seedlot_id(), type_id => $experiment_type_id  });
 672             $experiment->create_related('nd_experiment_projects', { project_id => $self->breeding_program_id });
 673         }
 674     };
 675
 676     if ($@) {
 677         $error = $@;
 678     }
 679     return $error;
 680 }
 681
 682 sub _update_seedlot_breeding_program {
 683     my $self = shift;
 684     my $stock = $self->stock;
 685     my $seedlot_experiment_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($self->schema, 'seedlot_experiment', 'experiment_type')->cvterm_id();
 686     my $nd_exp_project = $stock->search_related('nd_experiment_stocks')->search_related('nd_experiment', {'nd_experiment.type_id'=>$seedlot_experiment_cvterm_id})->search_related('nd_experiment_projects');
 687     if($nd_exp_project->count != 1){
 688         die "There should be exactly one nd_experiment_project for any single seedlot!";
 689     }
 690     my $nd_exp_proj = $nd_exp_project->first();
 691     $nd_exp_proj->update({project_id=>$self->breeding_program_id});
 692 }
 693
 694 sub _update_seedlot_location {
 695     my $self = shift;
 696     my $stock = $self->stock;
 697     my $seedlot_experiment_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($self->schema, 'seedlot_experiment', 'experiment_type')->cvterm_id();
 698     my $nd_exp = $stock->search_related('nd_experiment_stocks')->search_related('nd_experiment', {'nd_experiment.type_id'=>$seedlot_experiment_cvterm_id});
 699     if($nd_exp->count != 1){
 700         die "There should be exactly one nd_experiment for any single seedlot!";
 701     }
 702     my $nd = $nd_exp->first();
 703     $nd->update({nd_geolocation_id=>$self->nd_geolocation_id});
 704 }
 705
 706 sub _store_seedlot_accession {
 707     my $self = shift;
 708     my $accession_stock_id = $self->accession_stock_id;
 709
 710     my $organism_id = $self->schema->resultset('Stock::Stock')->find({stock_id => $accession_stock_id})->organism_id();
 711     if ($self->organism_id){
 712         if ($self->organism_id != $organism_id){
 713             return "Accessions must all be the same organism, so that a population can group the seed lots.\n";
 714         }
 715     }
 716     $self->organism_id($organism_id);
 717
 718     my $type_id = SGN::Model::Cvterm->get_cvterm_row($self->schema(), "collection_of", "stock_relationship")->cvterm_id();
 719     my $already_exists = $self->schema()->resultset("Stock::StockRelationship")->find({ object_id => $self->seedlot_id(), type_id => $type_id, subject_id=>$accession_stock_id });
 720
 721     if ($already_exists) {
 722         print STDERR "Accession with id $accession_stock_id is already associated with seedlot id ".$self->seedlot_id()."\n";
 723         return "Accession with id $accession_stock_id is already associated with seedlot id ".$self->seedlot_id();
 724     }
 725     my $row = $self->schema()->resultset("Stock::StockRelationship")->create({
 726         object_id => $self->seedlot_id(),
 727         subject_id => $accession_stock_id,
 728         type_id => $type_id,
 729     });
 730     return;
 731 }
 732
 733 sub _update_content_stock_id {
 734     my $self = shift;
 735     my $type_id = SGN::Model::Cvterm->get_cvterm_row($self->schema(), "collection_of", "stock_relationship")->cvterm_id();
 736     my $accession_type_id = SGN::Model::Cvterm->get_cvterm_row($self->schema(), "accession", "stock_type")->cvterm_id();
 737     my $cross_type_id = SGN::Model::Cvterm->get_cvterm_row($self->schema(), "cross", "stock_type")->cvterm_id();
 738     my $acc_rs = $self->stock->search_related('stock_relationship_objects', {'me.type_id'=>$type_id, 'subject.type_id'=>[$accession_type_id,$cross_type_id]}, {'join'=>'subject'});
 739     while (my $r=$acc_rs->next){
 740         $r->delete();
 741     }
 742     my $error = $self->_store_seedlot_accession();
 743     $error = $self->_store_seedlot_cross();
 744     return $error;
 745 }
 746
 747 sub _retrieve_accession {
 748     my $self = shift;
 749     my $type_id = SGN::Model::Cvterm->get_cvterm_row($self->schema(), "collection_of", "stock_relationship")->cvterm_id();
 750     my $accession_type_id = SGN::Model::Cvterm->get_cvterm_row($self->schema(), "accession", "stock_type")->cvterm_id();
 751     my $rs = $self->schema()->resultset("Stock::StockRelationship")->search({ 'me.type_id' => $type_id, 'me.object_id' => $self->seedlot_id(), 'subject.type_id'=>$accession_type_id }, {'join'=>'subject'});
 752
 753     my $accession_id;
 754     if ($rs->count == 1){
 755         $accession_id = $rs->first->subject_id;
 756     }
 757
 758     if ($accession_id){
 759         $self->accession_stock_id($accession_id);
 760
 761         my $accession_rs = $self->schema()->resultset("Stock::Stock")->find({ stock_id => $accession_id });
 762         $self->accession([$accession_rs->stock_id(), $accession_rs->uniquename()]);
 763     }
 764 }
 765
 766 sub _remove_accession {
 767     my $self = shift;
 768 }
 769
 770
 771 sub _store_seedlot_cross {
 772     my $self = shift;
 773     my $cross_stock_id = $self->cross_stock_id;
 774     my $organism_id = $self->schema->resultset('Stock::Stock')->find({stock_id => $cross_stock_id})->organism_id();
 775     if ($self->organism_id){
 776         if ($self->organism_id != $organism_id){
 777             return "Crosses must all be the same organism to be in a seed lot.\n";
 778         }
 779     }
 780     $self->organism_id($organism_id);
 781
 782     my $type_id = SGN::Model::Cvterm->get_cvterm_row($self->schema(), "collection_of", "stock_relationship")->cvterm_id();
 783     my $already_exists = $self->schema()->resultset("Stock::StockRelationship")->find({ object_id => $self->seedlot_id(), type_id => $type_id, subject_id=>$cross_stock_id });
 784
 785     if ($already_exists) {
 786         print STDERR "Cross with id $cross_stock_id is already associated with seedlot id ".$self->seedlot_id()."\n";
 787         return "Cross with id $cross_stock_id is already associated with seedlot id ".$self->seedlot_id();
 788     }
 789     my $row = $self->schema()->resultset("Stock::StockRelationship")->create({
 790         object_id => $self->seedlot_id(),
 791         subject_id => $cross_stock_id,
 792         type_id => $type_id,
 793     });
 794     return;
 795 }
 796
 797 sub _retrieve_cross {
 798     my $self = shift;
 799     my $type_id = SGN::Model::Cvterm->get_cvterm_row($self->schema(), "collection_of", "stock_relationship")->cvterm_id();
 800     my $cross_type_id = SGN::Model::Cvterm->get_cvterm_row($self->schema(), "cross", "stock_type")->cvterm_id();
 801     my $rs = $self->schema()->resultset("Stock::StockRelationship")->search({ 'me.type_id' => $type_id, 'me.object_id' => $self->seedlot_id(), 'subject.type_id'=>$cross_type_id }, {'join'=>'subject'});
 802
 803     my $cross_id;
 804     if ($rs->count == 1){
 805         $cross_id = $rs->first->subject_id;
 806     }
 807
 808     if ($cross_id){
 809         $self->cross_stock_id($cross_id);
 810
 811         my $cross_rs = $self->schema()->resultset("Stock::Stock")->find({ stock_id => $cross_id });
 812         $self->cross([$cross_rs->stock_id(), $cross_rs->uniquename()]);
 813     }
 814 }
 815
 816
 817 =head2 Method current_count()
 818
 819  Usage:        my $current_count = $sl->current_count();
 820  Desc:         returns the current balance of seeds in the seedlot
 821  Ret:          a number
 822  Args:         none
 823  Side Effects: retrieves transactions from db and calculates count
 824  Example:
 825
 826 =cut
 827
 828 sub current_count {
 829     my $self = shift;
 830     my $transactions = $self->transactions();
 831
 832     my $count = 0;
 833     foreach my $t (@$transactions) {
 834         if ($t->amount() ne 'NA'){
 835             $count += $t->amount() * $t->factor();
 836         }
 837     }
 838     if ($count == 0 && scalar(@$transactions)>0){
 839         $count = 'NA';
 840     }
 841     return $count;
 842 }
 843
 844 # It is convenient and also much faster to retrieve a single value for the current_count, rather than calculating it from the transactions.
 845 sub set_current_count_property {
 846     my $self = shift;
 847     my $current_count = $self->current_count();
 848     my $current_count_cvterm = SGN::Model::Cvterm->get_cvterm_row($self->schema, 'current_count', 'stock_property');
 849     my $stock = $self->stock();
 850     my $recorded_current_count = $stock->find_related('stockprops', {'me.type_id'=>$current_count_cvterm->cvterm_id});
 851     if($recorded_current_count){
 852         $recorded_current_count->update({'value'=>$current_count});
 853     } else {
 854         $stock->create_stockprops({$current_count_cvterm->name() => $current_count});
 855     }
 856     return $current_count;
 857 }
 858
 859 # It is convenient and also much faster to retrieve a single value for the current_count, rather than calculating it from the transactions.
 860 sub get_current_count_property {
 861     my $self = shift;
 862     my $current_count_cvterm = SGN::Model::Cvterm->get_cvterm_row($self->schema, 'current_count', 'stock_property');
 863     my $recorded_current_count = $self->stock()->find_related('stockprops', {'me.type_id'=>$current_count_cvterm->cvterm_id});
 864     return $recorded_current_count ? $recorded_current_count->value() : '';
 865 }
 866
 867 =head2 Method current_weight()
 868
 869  Usage:        my $current_weight = $sl->current_weight();
 870  Desc:         returns the current weight of seeds in the seedlot
 871  Ret:          a number
 872  Args:         none
 873  Side Effects: retrieves transactions from db and calculates weight
 874  Example:
 875
 876 =cut
 877
 878 sub current_weight {
 879     my $self = shift;
 880     my $transactions = $self->transactions();
 881
 882     my $weight = 0;
 883     foreach my $t (@$transactions) {
 884         if ($t->weight_gram() ne 'NA'){
 885             $weight += $t->weight_gram() * $t->factor();
 886         }
 887     }
 888     if ($weight == 0 && scalar(@$transactions)>0){
 889         $weight = 'NA';
 890     }
 891     return $weight;
 892 }
 893
 894 # It is convenient and also much faster to retrieve a single value for the current_weight, rather than calculating it from the transactions.
 895 sub set_current_weight_property {
 896     my $self = shift;
 897     my $current_weight = $self->current_weight();
 898     my $current_weight_cvterm = SGN::Model::Cvterm->get_cvterm_row($self->schema, 'current_weight_gram', 'stock_property');
 899     my $stock = $self->stock();
 900     my $recorded_current_weight = $stock->find_related('stockprops', {'me.type_id'=>$current_weight_cvterm->cvterm_id});
 901     if ($recorded_current_weight){
 902         $recorded_current_weight->update({'value'=>$current_weight});
 903     } else {
 904         $stock->create_stockprops({$current_weight_cvterm->name() => $current_weight});
 905     }
 906     return $current_weight;
 907 }
 908
 909 # It is convenient and also much faster to retrieve a single value for the current_weight, rather than calculating it from the transactions.
 910 sub get_current_weight_property {
 911     my $self = shift;
 912     my $current_count_cvterm = SGN::Model::Cvterm->get_cvterm_row($self->schema, 'current_weight_gram', 'stock_property');
 913     my $recorded_current_count = $self->stock()->find_related('stockprops', {'me.type_id'=>$current_count_cvterm->cvterm_id});
 914     return $recorded_current_count ? $recorded_current_count->value() : '';
 915 }
 916
 917
 918 sub _add_transaction {
 919     my $self = shift;
 920     my $transaction = shift;
 921
 922     my $transactions = $self->transactions();
 923     push @$transactions, $transaction;
 924
 925     $self->transactions($transactions);
 926 }
 927
 928 =head2 store()
 929
 930  Usage:        my $seedlot_id = $sl->store();
 931  Desc:         stores the current state of the object to the db. uses CXGN::Stock store as well.
 932  Ret:          the seedlot id.
 933  Args:         none
 934  Side Effects: accesses the db. Creates a new seedlot ID if not
 935                already existing.
 936  Example:
 937
 938 =cut
 939
 940 sub store {
 941     my $self = shift;
 942     my $error;
 943
 944     my $coderef = sub {
 945         #Creating new seedlot
 946         if(!$self->stock){
 947             $self->name($self->uniquename());
 948             my $type_id = SGN::Model::Cvterm->get_cvterm_row($self->schema, 'seedlot', 'stock_type')->cvterm_id();
 949             $self->type_id($type_id);
 950             my $id = $self->SUPER::store();
 951             print STDERR "Saving seedlot returned ID $id.".localtime."\n";
 952             $self->seedlot_id($id);
 953             $self->_store_seedlot_location();
 954             $error = $self->_store_seedlot_relationships();
 955             if ($error){
 956                 die $error;
 957             }
 958             if ($self->box_name){
 959                 $self->_store_stockprop('location_code', $self->box_name);
 960             }
 961
 962         } else { #Updating seedlot
 963
 964             #Attempting to update seedlot's accession. Will not proceed if seedlot has already been used in transactions.
 965             if($self->accession_stock_id){
 966                 my $input_accession_id = $self->accession_stock_id;
 967                 my $transactions = $self->transactions();
 968                 my $stored_accession_id = $self->accession ? $self->accession->[0] : 0;
 969                 $self->accession_stock_id($input_accession_id);
 970                 my $accessions_have_changed = $input_accession_id == $stored_accession_id ? 0 : 1;
 971                 if ($accessions_have_changed && scalar(@$transactions)>1){
 972                     $error = "This seedlot ".$self->uniquename." has been used in transactions, so the contents (accessions) cannot be changed now!";
 973                 } elsif ($accessions_have_changed && scalar(@$transactions) <= 1) {
 974                     $error = $self->_update_content_stock_id();
 975                     my $update_first_transaction_id = $transactions->[0]->update_transaction_object_id($self->accession_stock_id);
 976                 }
 977                 if ($error){
 978                     die $error;
 979                 }
 980             }
 981
 982             #Attempting to update seedlot's cross. Will not proceed if seedlot has already been used in transactions.
 983             if($self->cross_stock_id){
 984                 my $input_cross_id = $self->cross_stock_id;
 985                 my $transactions = $self->transactions();
 986                 my $stored_cross_id = $self->cross ? $self->cross->[0] : 0;
 987                 $self->cross_stock_id($input_cross_id);
 988                 my $crosses_have_changed = $input_cross_id == $stored_cross_id ? 0 : 1;
 989                 if ($crosses_have_changed && scalar(@$transactions)>1){
 990                     $error = "This seedlot ".$self->uniquename." has been used in transactions, so the contents (crosses) cannot be changed now!";
 991                 } elsif ($crosses_have_changed && scalar(@$transactions) <= 1) {
 992                     $error = $self->_update_content_stock_id();
 993                     my $update_first_transaction_id = $transactions->[0]->update_transaction_object_id($self->cross_stock_id);
 994                 }
 995                 if ($error){
 996                     die $error;
 997                 }
 998             }
 999
1000             my $id = $self->SUPER::store();
1001             print STDERR "Updating seedlot returned ID $id.".localtime."\n";
1002             $self->seedlot_id($id);
1003             if($self->breeding_program_id){
1004                 $self->_update_seedlot_breeding_program();
1005             }
1006             if($self->location_code){
1007                 $self->_store_seedlot_location();
1008                 $self->_update_seedlot_location();
1009             }
1010             if($self->box_name){
1011                 $self->_update_stockprop('location_code', $self->box_name);
1012             }
1013         }
1014     };
1015
1016     my $transaction_error;
1017         try {
1018                 $self->schema->txn_do($coderef);
1019         } catch {
1020                 print STDERR "Transaction Error: $_\n";
1021                 $transaction_error =  $_;
1022         };
1023         if ($transaction_error){
1024         return { error=>$transaction_error };
1025     } else {
1026         return { success=>1, seedlot_id=>$self->stock_id() };
1027     }
1028 }
1029
1030 =head2 delete()
1031
1032  Usage:        my $error_message = $sl->delete();
1033  Desc:         delete the seedlot from the database. only possible to delete a seedlot that has not been used in any transactions other than the transaction that initiated it.
1034  Ret:          any error message. undef if no errors
1035  Args:         none
1036  Side Effects: accesses the db. Deletes seedlot
1037  Example:
1038
1039 =cut
1040
1041 sub delete {
1042     my $self = shift;
1043     my $error = '';
1044     my $transactions = $self->transactions();
1045     if (scalar(@$transactions)>1){
1046         $error = "This seedlot has been used in transactions and so cannot be deleted!";
1047     } else {
1048         my $stock = $self->stock();
1049         my $experiment_type_id = SGN::Model::Cvterm->get_cvterm_row($self->schema(), "seedlot_experiment", "experiment_type")->cvterm_id();
1050         my $nd_experiment_rs = $self->schema()->resultset('Stock::Stock')->search({'me.stock_id'=>$self->seedlot_id})->search_related('nd_experiment_stocks')->search_related('nd_experiment', {'nd_experiment.type_id'=>$experiment_type_id});
1051         if ($nd_experiment_rs->count != 1){
1052             $error = "Seedlot does not have 1 nd_experiment associated!";
1053         } else {
1054             my $nd_experiment = $nd_experiment_rs->first();
1055             $nd_experiment->delete();
1056             my $stock_owner_rs = $self->phenome_schema->resultset("StockOwner")->find({stock_id=>$self->stock_id});
1057             if ($stock_owner_rs){
1058                 $stock_owner_rs->delete();
1059             }
1060             $stock->delete();
1061         }
1062     }
1063
1064     return $error;
1065 }
1066
1067 1;
1068
1069 no Moose;
1070 __PACKAGE__->meta->make_immutable;