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, 'location_code'=>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{$_}->{organization} = $stockprop_hash{$unique_seedlots{$_}->{seedlot_stock_id}}->{organization} ? $stockprop_hash{$unique_seedlots{$_}->{seedlot_stock_id}}->{organization} : 'NA';
 384         $unique_seedlots{$_}->{box} = $stockprop_hash{$unique_seedlots{$_}->{seedlot_stock_id}}->{location_code} ? $stockprop_hash{$unique_seedlots{$_}->{seedlot_stock_id}}->{location_code} : 'NA';
 385         $unique_seedlots{$_}->{current_count} = $stockprop_hash{$unique_seedlots{$_}->{seedlot_stock_id}}->{current_count} ? $stockprop_hash{$unique_seedlots{$_}->{seedlot_stock_id}}->{current_count} : 'NA';
 386         $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';
 387         push @seedlots, $unique_seedlots{$_};
 388     }
 389     #print STDERR Dumper \@seedlots;
 390     return (\@seedlots, $records_total);
 391 }
 392
 393 # class method
 394 =head2 Class method: verify_seedlot_stock_lists()
 395
 396  Usage:        my $seedlots = CXGN::Stock::Seedlot->verify_seedlot_stock_lists($schema, $people_schema, $phenome_schema, \@stock_names, \@seedlot_names);
 397  Desc:         Class method that verifies if a given list of seedlots is valid for a given list of accessions
 398  Ret:          success or error
 399  Args:         $schema, $stock_names, $seedlot_names
 400  Side Effects: accesses the database
 401
 402 =cut
 403
 404 sub verify_seedlot_stock_lists {
 405     my $class = shift;
 406     my $schema = shift;
 407     my $people_schema = shift;
 408     my $phenome_schema = shift;
 409     my $stock_names = shift;
 410     my $seedlot_names = shift;
 411     my $error = '';
 412     my %return;
 413
 414     if (!$stock_names) {
 415         $error .= "No accession list selected!";
 416     }
 417     if (!$seedlot_names) {
 418         $error .= "No seedlot list supplied!";
 419     }
 420     if ($error){
 421         $return{error} = $error;
 422         return \%return;
 423     }
 424
 425     my @stock_names = @$stock_names;
 426     my @seedlot_names = @$seedlot_names;
 427     if (scalar(@stock_names)<1){
 428         $error .= "Your accession list is empty!";
 429     }
 430     if (scalar(@seedlot_names)<1){
 431         $error .= "Your seedlot list is empty!";
 432     }
 433     if ($error){
 434         $return{error} = $error;
 435         return \%return;
 436     }
 437
 438     my $lv = CXGN::List::Validate->new();
 439     my @accessions_missing = @{$lv->validate($schema,'accessions',\@stock_names)->{'missing'}};
 440     my $lv_seedlots = CXGN::List::Validate->new();
 441     my @seedlots_missing = @{$lv_seedlots->validate($schema,'seedlots',\@seedlot_names)->{'missing'}};
 442
 443     if (scalar(@accessions_missing) > 0){
 444         $error .= 'The following accessions are not valid in the database, so you must add them first: '.join ',', @accessions_missing;
 445     }
 446     if (scalar(@seedlots_missing) > 0){
 447         $error .= 'The following seedlots are not valid in the database, so you must add them first: '.join ',', @seedlots_missing;
 448     }
 449     if ($error){
 450         $return{error} = $error;
 451         return \%return;
 452     }
 453
 454     my %selected_seedlots = map {$_=>1} @seedlot_names;
 455     my %selected_accessions = map {$_=>1} @stock_names;
 456     my %seedlot_hash;
 457
 458     my $ac = CXGN::BreedersToolbox::Accessions->new({schema=>$schema, people_schema=>$people_schema, phenome_schema=>$phenome_schema});
 459     my $possible_seedlots = $ac->get_possible_seedlots(\@stock_names);
 460     my %allowed_seedlots;
 461     while (my($key,$val) = each %$possible_seedlots){
 462         foreach my $seedlot (@$val){
 463             my $seedlot_name = $seedlot->{seedlot}->[0];
 464             if (exists($selected_accessions{$key}) && exists($selected_seedlots{$seedlot_name})){
 465                 push @{$seedlot_hash{$key}}, $seedlot_name;
 466             }
 467         }
 468     }
 469     #if(scalar(keys %seedlot_hash) != scalar(@stock_names)){
 470     #    $error .= "Error: The seedlot list you select must include seedlots for all the accessions you have selected. ";
 471     #}
 472     if ($error){
 473         $return{error} = $error;
 474     } else {
 475         $return{success} = 1;
 476         $return{seedlot_hash} = \%seedlot_hash;
 477     }
 478     return \%return;
 479 }
 480
 481 # class method
 482 =head2 Class method: verify_seedlot_plot_compatibility()
 483
 484  Usage:        my $seedlots = CXGN::Stock::Seedlot->verify_seedlot_plot_compatibility($schema, [[$seedlot_name, $plot_name]]);
 485  Desc:         Class method that verifies if a given list of pairs of seedlot_name and plot_name have the same underlying accession.
 486  Ret:          success or error
 487  Args:         $schema, $stock_names, $seedlot_names
 488  Side Effects: accesses the database
 489
 490 =cut
 491
 492 sub verify_seedlot_plot_compatibility {
 493     my $class = shift;
 494     my $schema = shift;
 495     my $pairs = shift; #arrayref of [ [seedlot_name, plot_name] ]
 496     my $error = '';
 497     my %return;
 498
 499     if (!$pairs){
 500         $error .= "No pair array passed!";
 501     }
 502     if ($error){
 503         $return{error} = $error;
 504         return \%return;
 505     }
 506
 507     my @pairs = @$pairs;
 508     if (scalar(@pairs)<1){
 509         $error .= "Your pairs list is empty!";
 510     }
 511     if ($error){
 512         $return{error} = $error;
 513         return \%return;
 514     }
 515
 516     my $plot_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, "plot", "stock_type")->cvterm_id();
 517     my $seedlot_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, "seedlot", "stock_type")->cvterm_id();
 518     my $plot_of_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, "plot_of", "stock_relationship")->cvterm_id();
 519     my $collection_of_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, "collection_of", "stock_relationship")->cvterm_id();
 520     foreach (@pairs){
 521         my $seedlot_name = $_->[0];
 522         my $plot_name = $_->[1];
 523
 524         #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.
 525         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});
 526         if (!$seedlot_rs->first){
 527             $error .= "The seedlot: $seedlot_name is not linked to the same accession as the plot: $plot_name . ";
 528         }
 529     }
 530     if ($error){
 531         $return{error} = $error;
 532     } else {
 533         $return{success} = 1;
 534     }
 535     return \%return;
 536 }
 537
 538 # class method
 539 =head2 Class method: verify_seedlot_accessions()
 540
 541  Usage:        my $seedlots = CXGN::Stock::Seedlot->verify_seedlot_accessions($schema, [[$seedlot_name, $accession_name]]);
 542  Desc:         Class method that verifies if a given list of pairs of seedlot_name and accession_name have the same underlying accession.
 543  Ret:          success or error
 544  Args:         $schema, $stock_names, $seedlot_names
 545  Side Effects: accesses the database
 546
 547 =cut
 548
 549 sub verify_seedlot_accessions {
 550     my $class = shift;
 551     my $schema = shift;
 552     my $pairs = shift; #arrayref of [ [seedlot_name, accession_name] ]
 553     my $error = '';
 554     my %return;
 555
 556     if (!$pairs){
 557         $error .= "No pair array passed!";
 558     }
 559     if ($error){
 560         $return{error} = $error;
 561         return \%return;
 562     }
 563
 564     my @pairs = @$pairs;
 565     if (scalar(@pairs)<1){
 566         $error .= "Your pairs list is empty!";
 567     }
 568     if ($error){
 569         $return{error} = $error;
 570         return \%return;
 571     }
 572
 573     my %seen_accession_names;
 574     foreach (@pairs){
 575         $seen_accession_names{$_->[1]}++;
 576     }
 577     my $accession_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'accession', 'stock_type')->cvterm_id();
 578     my $synonym_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'stock_synonym', 'stock_property')->cvterm_id();
 579     my $seedlot_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, "seedlot", "stock_type")->cvterm_id();
 580     my $collection_of_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, "collection_of", "stock_relationship")->cvterm_id();
 581
 582     my @accessions = keys %seen_accession_names;
 583     my $acc_synonym_rs = $schema->resultset("Stock::Stock")->search({
 584         'me.is_obsolete' => { '!=' => 't' },
 585         'stockprops.value' => { -in => \@accessions},
 586         'me.type_id' => $accession_cvterm_id,
 587         'stockprops.type_id' => $synonym_cvterm_id
 588     },{join => 'stockprops', '+select'=>['stockprops.value'], '+as'=>['synonym']});
 589     my %acc_synonyms_lookup;
 590     while (my $r=$acc_synonym_rs->next){
 591         $acc_synonyms_lookup{$r->get_column('synonym')}->{$r->uniquename} = $r->stock_id;
 592     }
 593
 594     foreach (@pairs){
 595         my $seedlot_name = $_->[0];
 596         my $accession_name = $_->[1];
 597
 598         if ($acc_synonyms_lookup{$accession_name}){
 599             my @accession_names = keys %{$acc_synonyms_lookup{$accession_name}};
 600             if (scalar(@accession_names)>1){
 601                 print STDERR "There is more than one uniquename for this synonym $accession_name. this should not happen!\n";
 602             }
 603             $accession_name = $accession_names[0];
 604         }
 605
 606         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});
 607         if (!$seedlot_rs->first){
 608             $error .= "The seedlot: $seedlot_name is not linked to the accession: $accession_name.";
 609         }
 610     }
 611     if ($error){
 612         $return{error} = $error;
 613     } else {
 614         $return{success} = 1;
 615     }
 616     return \%return;
 617 }
 618
 619 sub BUILDARGS {
 620     my $orig = shift;
 621     my %args = @_;
 622     $args{stock_id} = $args{seedlot_id};
 623     return \%args;
 624 }
 625
 626 sub BUILD {
 627     my $self = shift;
 628     if ($self->stock_id()) {
 629         $self->seedlot_id($self->stock_id);
 630         $self->name($self->uniquename());
 631         $self->seedlot_id($self->stock_id());
 632     }
 633     #print STDERR Dumper $self->seedlot_id;
 634 }
 635
 636 sub _build_transactions {
 637     my $self = shift;
 638     my $transactions = CXGN::Stock::Seedlot::Transaction->get_transactions_by_seedlot_id($self->schema(), $self->seedlot_id());
 639     #print STDERR Dumper($transactions);
 640     $self->transactions($transactions);
 641 }
 642
 643 sub _store_seedlot_location {
 644     my $self = shift;
 645     my $nd_geolocation = $self->schema()->resultset("NaturalDiversity::NdGeolocation")->find_or_create({
 646         description => $self->location_code
 647     });
 648     $self->nd_geolocation_id($nd_geolocation->nd_geolocation_id);
 649 }
 650
 651 sub _retrieve_location {
 652     my $self = shift;
 653     my $experiment_type_id = SGN::Model::Cvterm->get_cvterm_row($self->schema(), "seedlot_experiment", "experiment_type")->cvterm_id();
 654     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');
 655     if ($nd_geolocation_rs->count != 1){
 656         die "Seedlot does not have 1 nd_geolocation associated!\n";
 657     }
 658     my $nd_geolocation_id = $nd_geolocation_rs->first()->nd_geolocation_id();
 659     my $location_code = $nd_geolocation_rs->first()->description();
 660     $self->nd_geolocation_id($nd_geolocation_id);
 661     $self->location_code($location_code);
 662 }
 663
 664 sub _retrieve_box_name {
 665     my $self = shift;
 666     $self->box_name($self->_retrieve_stockprop('location_code'));
 667 }
 668
 669 sub _retrieve_breeding_program {
 670     my $self = shift;
 671     my $experiment_type_id = SGN::Model::Cvterm->get_cvterm_row($self->schema(), "seedlot_experiment", "experiment_type")->cvterm_id();
 672     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');
 673     if ($project_rs->count != 1){
 674         die "Seedlot does not have 1 breeding program project (".$project_rs->count.") associated!\n";
 675     }
 676     my $breeding_program_id = $project_rs->first()->project_id();
 677     my $breeding_program_name = $project_rs->first()->name();
 678     $self->breeding_program_id($breeding_program_id);
 679     $self->breeding_program_name($breeding_program_name);
 680 }
 681
 682 sub _store_seedlot_relationships {
 683     my $self = shift;
 684     my $error;
 685
 686     eval {
 687         if ($self->accession_stock_id){
 688             $error = $self->_store_seedlot_accession();
 689         }
 690         if ($self->cross_stock_id){
 691             $error = $self->_store_seedlot_cross();
 692         }
 693         if (!$error){
 694             my $experiment_type_id = SGN::Model::Cvterm->get_cvterm_row($self->schema(), "seedlot_experiment", "experiment_type")->cvterm_id();
 695             my $experiment = $self->schema->resultset('NaturalDiversity::NdExperiment')->create({
 696                 nd_geolocation_id => $self->nd_geolocation_id,
 697                 type_id => $experiment_type_id
 698             });
 699             $experiment->create_related('nd_experiment_stocks', { stock_id => $self->seedlot_id(), type_id => $experiment_type_id  });
 700             $experiment->create_related('nd_experiment_projects', { project_id => $self->breeding_program_id });
 701         }
 702     };
 703
 704     if ($@) {
 705         $error = $@;
 706     }
 707     return $error;
 708 }
 709
 710 sub _update_seedlot_breeding_program {
 711     my $self = shift;
 712     my $stock = $self->stock;
 713     my $seedlot_experiment_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($self->schema, 'seedlot_experiment', 'experiment_type')->cvterm_id();
 714     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');
 715     if($nd_exp_project->count != 1){
 716         die "There should be exactly one nd_experiment_project for any single seedlot!";
 717     }
 718     my $nd_exp_proj = $nd_exp_project->first();
 719     $nd_exp_proj->update({project_id=>$self->breeding_program_id});
 720 }
 721
 722 sub _update_seedlot_location {
 723     my $self = shift;
 724     my $stock = $self->stock;
 725     my $seedlot_experiment_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($self->schema, 'seedlot_experiment', 'experiment_type')->cvterm_id();
 726     my $nd_exp = $stock->search_related('nd_experiment_stocks')->search_related('nd_experiment', {'nd_experiment.type_id'=>$seedlot_experiment_cvterm_id});
 727     if($nd_exp->count != 1){
 728         die "There should be exactly one nd_experiment for any single seedlot!";
 729     }
 730     my $nd = $nd_exp->first();
 731     $nd->update({nd_geolocation_id=>$self->nd_geolocation_id});
 732 }
 733
 734 sub _store_seedlot_accession {
 735     my $self = shift;
 736     my $accession_stock_id = $self->accession_stock_id;
 737
 738     my $organism_id = $self->schema->resultset('Stock::Stock')->find({stock_id => $accession_stock_id})->organism_id();
 739     if ($self->organism_id){
 740         if ($self->organism_id != $organism_id){
 741             return "Accessions must all be the same organism, so that a population can group the seed lots.\n";
 742         }
 743     }
 744     $self->organism_id($organism_id);
 745
 746     my $type_id = SGN::Model::Cvterm->get_cvterm_row($self->schema(), "collection_of", "stock_relationship")->cvterm_id();
 747     my $already_exists = $self->schema()->resultset("Stock::StockRelationship")->find({ object_id => $self->seedlot_id(), type_id => $type_id, subject_id=>$accession_stock_id });
 748
 749     if ($already_exists) {
 750         print STDERR "Accession with id $accession_stock_id is already associated with seedlot id ".$self->seedlot_id()."\n";
 751         return "Accession with id $accession_stock_id is already associated with seedlot id ".$self->seedlot_id();
 752     }
 753     my $row = $self->schema()->resultset("Stock::StockRelationship")->create({
 754         object_id => $self->seedlot_id(),
 755         subject_id => $accession_stock_id,
 756         type_id => $type_id,
 757     });
 758     return;
 759 }
 760
 761 sub _update_content_stock_id {
 762     my $self = shift;
 763     my $type_id = SGN::Model::Cvterm->get_cvterm_row($self->schema(), "collection_of", "stock_relationship")->cvterm_id();
 764     my $accession_type_id = SGN::Model::Cvterm->get_cvterm_row($self->schema(), "accession", "stock_type")->cvterm_id();
 765     my $cross_type_id = SGN::Model::Cvterm->get_cvterm_row($self->schema(), "cross", "stock_type")->cvterm_id();
 766     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'});
 767     while (my $r=$acc_rs->next){
 768         $r->delete();
 769     }
 770     my $error;
 771     if ($self->accession_stock_id){
 772         $error = $self->_store_seedlot_accession();
 773     }
 774     if ($self->cross_stock_id){
 775         $error = $self->_store_seedlot_cross();
 776     }
 777     return $error;
 778 }
 779
 780 sub _retrieve_accession {
 781     my $self = shift;
 782     my $type_id = SGN::Model::Cvterm->get_cvterm_row($self->schema(), "collection_of", "stock_relationship")->cvterm_id();
 783     my $accession_type_id = SGN::Model::Cvterm->get_cvterm_row($self->schema(), "accession", "stock_type")->cvterm_id();
 784     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'});
 785
 786     my $accession_id;
 787     if ($rs->count == 1){
 788         $accession_id = $rs->first->subject_id;
 789     }
 790
 791     if ($accession_id){
 792         $self->accession_stock_id($accession_id);
 793
 794         my $accession_rs = $self->schema()->resultset("Stock::Stock")->find({ stock_id => $accession_id });
 795         $self->accession([$accession_rs->stock_id(), $accession_rs->uniquename()]);
 796     }
 797 }
 798
 799 sub _remove_accession {
 800     my $self = shift;
 801 }
 802
 803
 804 sub _store_seedlot_cross {
 805     my $self = shift;
 806     my $cross_stock_id = $self->cross_stock_id;
 807     my $organism_id = $self->schema->resultset('Stock::Stock')->find({stock_id => $cross_stock_id})->organism_id();
 808     if ($self->organism_id){
 809         if ($self->organism_id != $organism_id){
 810             return "Crosses must all be the same organism to be in a seed lot.\n";
 811         }
 812     }
 813     $self->organism_id($organism_id);
 814
 815     my $type_id = SGN::Model::Cvterm->get_cvterm_row($self->schema(), "collection_of", "stock_relationship")->cvterm_id();
 816     my $already_exists = $self->schema()->resultset("Stock::StockRelationship")->find({ object_id => $self->seedlot_id(), type_id => $type_id, subject_id=>$cross_stock_id });
 817
 818     if ($already_exists) {
 819         print STDERR "Cross with id $cross_stock_id is already associated with seedlot id ".$self->seedlot_id()."\n";
 820         return "Cross with id $cross_stock_id is already associated with seedlot id ".$self->seedlot_id();
 821     }
 822     my $row = $self->schema()->resultset("Stock::StockRelationship")->create({
 823         object_id => $self->seedlot_id(),
 824         subject_id => $cross_stock_id,
 825         type_id => $type_id,
 826     });
 827     return;
 828 }
 829
 830 sub _retrieve_cross {
 831     my $self = shift;
 832     my $type_id = SGN::Model::Cvterm->get_cvterm_row($self->schema(), "collection_of", "stock_relationship")->cvterm_id();
 833     my $cross_type_id = SGN::Model::Cvterm->get_cvterm_row($self->schema(), "cross", "stock_type")->cvterm_id();
 834     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'});
 835
 836     my $cross_id;
 837     if ($rs->count == 1){
 838         $cross_id = $rs->first->subject_id;
 839     }
 840
 841     if ($cross_id){
 842         $self->cross_stock_id($cross_id);
 843
 844         my $cross_rs = $self->schema()->resultset("Stock::Stock")->find({ stock_id => $cross_id });
 845         $self->cross([$cross_rs->stock_id(), $cross_rs->uniquename()]);
 846     }
 847 }
 848
 849
 850 =head2 Method current_count()
 851
 852  Usage:        my $current_count = $sl->current_count();
 853  Desc:         returns the current balance of seeds in the seedlot
 854  Ret:          a number
 855  Args:         none
 856  Side Effects: retrieves transactions from db and calculates count
 857  Example:
 858
 859 =cut
 860
 861 sub current_count {
 862     my $self = shift;
 863     my $transactions = $self->transactions();
 864
 865     my $count = 0;
 866     foreach my $t (@$transactions) {
 867         if ($t->amount() ne 'NA'){
 868             $count += $t->amount() * $t->factor();
 869         }
 870     }
 871     if ($count == 0 && scalar(@$transactions)>0){
 872         $count = 'NA';
 873     }
 874     return $count;
 875 }
 876
 877 # It is convenient and also much faster to retrieve a single value for the current_count, rather than calculating it from the transactions.
 878 sub set_current_count_property {
 879     my $self = shift;
 880     my $current_count = $self->current_count();
 881     my $current_count_cvterm = SGN::Model::Cvterm->get_cvterm_row($self->schema, 'current_count', 'stock_property');
 882     my $stock = $self->stock();
 883     my $recorded_current_count = $stock->find_related('stockprops', {'me.type_id'=>$current_count_cvterm->cvterm_id});
 884     if($recorded_current_count){
 885         $recorded_current_count->update({'value'=>$current_count});
 886     } else {
 887         $stock->create_stockprops({$current_count_cvterm->name() => $current_count});
 888     }
 889     return $current_count;
 890 }
 891
 892 # It is convenient and also much faster to retrieve a single value for the current_count, rather than calculating it from the transactions.
 893 sub get_current_count_property {
 894     my $self = shift;
 895     my $current_count_cvterm = SGN::Model::Cvterm->get_cvterm_row($self->schema, 'current_count', 'stock_property');
 896     my $recorded_current_count = $self->stock()->find_related('stockprops', {'me.type_id'=>$current_count_cvterm->cvterm_id});
 897     return $recorded_current_count ? $recorded_current_count->value() : '';
 898 }
 899
 900 =head2 Method current_weight()
 901
 902  Usage:        my $current_weight = $sl->current_weight();
 903  Desc:         returns the current weight of seeds in the seedlot
 904  Ret:          a number
 905  Args:         none
 906  Side Effects: retrieves transactions from db and calculates weight
 907  Example:
 908
 909 =cut
 910
 911 sub current_weight {
 912     my $self = shift;
 913     my $transactions = $self->transactions();
 914
 915     my $weight = 0;
 916     foreach my $t (@$transactions) {
 917         if ($t->weight_gram() ne 'NA'){
 918             $weight += $t->weight_gram() * $t->factor();
 919         }
 920     }
 921     if ($weight == 0 && scalar(@$transactions)>0){
 922         $weight = 'NA';
 923     }
 924     return $weight;
 925 }
 926
 927 # It is convenient and also much faster to retrieve a single value for the current_weight, rather than calculating it from the transactions.
 928 sub set_current_weight_property {
 929     my $self = shift;
 930     my $current_weight = $self->current_weight();
 931     my $current_weight_cvterm = SGN::Model::Cvterm->get_cvterm_row($self->schema, 'current_weight_gram', 'stock_property');
 932     my $stock = $self->stock();
 933     my $recorded_current_weight = $stock->find_related('stockprops', {'me.type_id'=>$current_weight_cvterm->cvterm_id});
 934     if ($recorded_current_weight){
 935         $recorded_current_weight->update({'value'=>$current_weight});
 936     } else {
 937         $stock->create_stockprops({$current_weight_cvterm->name() => $current_weight});
 938     }
 939     return $current_weight;
 940 }
 941
 942 # It is convenient and also much faster to retrieve a single value for the current_weight, rather than calculating it from the transactions.
 943 sub get_current_weight_property {
 944     my $self = shift;
 945     my $current_count_cvterm = SGN::Model::Cvterm->get_cvterm_row($self->schema, 'current_weight_gram', 'stock_property');
 946     my $recorded_current_count = $self->stock()->find_related('stockprops', {'me.type_id'=>$current_count_cvterm->cvterm_id});
 947     return $recorded_current_count ? $recorded_current_count->value() : '';
 948 }
 949
 950
 951 sub _add_transaction {
 952     my $self = shift;
 953     my $transaction = shift;
 954
 955     my $transactions = $self->transactions();
 956     push @$transactions, $transaction;
 957
 958     $self->transactions($transactions);
 959 }
 960
 961 =head2 store()
 962
 963  Usage:        my $seedlot_id = $sl->store();
 964  Desc:         stores the current state of the object to the db. uses CXGN::Stock store as well.
 965  Ret:          the seedlot id.
 966  Args:         none
 967  Side Effects: accesses the db. Creates a new seedlot ID if not
 968                already existing.
 969  Example:
 970
 971 =cut
 972
 973 sub store {
 974     my $self = shift;
 975     my $error;
 976
 977     my $coderef = sub {
 978         #Creating new seedlot
 979         if(!$self->stock){
 980             $self->name($self->uniquename());
 981             my $type_id = SGN::Model::Cvterm->get_cvterm_row($self->schema, 'seedlot', 'stock_type')->cvterm_id();
 982             $self->type_id($type_id);
 983             my $id = $self->SUPER::store();
 984             print STDERR "Saving seedlot returned ID $id.".localtime."\n";
 985             $self->seedlot_id($id);
 986             $self->_store_seedlot_location();
 987             $error = $self->_store_seedlot_relationships();
 988             if ($error){
 989                 die $error;
 990             }
 991             if ($self->box_name){
 992                 $self->_store_stockprop('location_code', $self->box_name);
 993             }
 994
 995         } else { #Updating seedlot
 996
 997             #Attempting to update seedlot's accession. Will not proceed if seedlot has already been used in transactions.
 998             if($self->accession_stock_id){
 999                 my $input_accession_id = $self->accession_stock_id;
1000                 my $transactions = $self->transactions();
1001                 my $stored_accession_id = $self->accession ? $self->accession->[0] : 0;
1002                 $self->accession_stock_id($input_accession_id);
1003                 my $accessions_have_changed = $input_accession_id == $stored_accession_id ? 0 : 1;
1004                 if ($accessions_have_changed && scalar(@$transactions)>1){
1005                     $error = "This seedlot ".$self->uniquename." has been used in transactions, so the contents (accessions) cannot be changed now!";
1006                 } elsif ($accessions_have_changed && scalar(@$transactions) <= 1) {
1007                     $error = $self->_update_content_stock_id();
1008                     my $update_first_transaction_id = $transactions->[0]->update_transaction_object_id($self->accession_stock_id);
1009                 }
1010                 if ($error){
1011                     die $error;
1012                 }
1013             }
1014
1015             #Attempting to update seedlot's cross. Will not proceed if seedlot has already been used in transactions.
1016             if($self->cross_stock_id){
1017                 my $input_cross_id = $self->cross_stock_id;
1018                 my $transactions = $self->transactions();
1019                 my $stored_cross_id = $self->cross ? $self->cross->[0] : 0;
1020                 $self->cross_stock_id($input_cross_id);
1021                 my $crosses_have_changed = $input_cross_id == $stored_cross_id ? 0 : 1;
1022                 if ($crosses_have_changed && scalar(@$transactions)>1){
1023                     $error = "This seedlot ".$self->uniquename." has been used in transactions, so the contents (crosses) cannot be changed now!";
1024                 } elsif ($crosses_have_changed && scalar(@$transactions) <= 1) {
1025                     $error = $self->_update_content_stock_id();
1026                     my $update_first_transaction_id = $transactions->[0]->update_transaction_object_id($self->cross_stock_id);
1027                 }
1028                 if ($error){
1029                     die $error;
1030                 }
1031             }
1032
1033             my $id = $self->SUPER::store();
1034             print STDERR "Updating seedlot returned ID $id.".localtime."\n";
1035             $self->seedlot_id($id);
1036             if($self->breeding_program_id){
1037                 $self->_update_seedlot_breeding_program();
1038             }
1039             if($self->location_code){
1040                 $self->_store_seedlot_location();
1041                 $self->_update_seedlot_location();
1042             }
1043             if($self->box_name){
1044                 $self->_update_stockprop('location_code', $self->box_name);
1045             }
1046         }
1047     };
1048
1049     my $transaction_error;
1050         try {
1051                 $self->schema->txn_do($coderef);
1052         } catch {
1053                 print STDERR "Transaction Error: $_\n";
1054                 $transaction_error =  $_;
1055         };
1056         if ($transaction_error){
1057         return { error=>$transaction_error };
1058     } else {
1059         return { success=>1, seedlot_id=>$self->stock_id() };
1060     }
1061 }
1062
1063 =head2 delete()
1064
1065  Usage:        my $error_message = $sl->delete();
1066  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.
1067  Ret:          any error message. undef if no errors
1068  Args:         none
1069  Side Effects: accesses the db. Deletes seedlot
1070  Example:
1071
1072 =cut
1073
1074 sub delete {
1075     my $self = shift;
1076     my $error = '';
1077     my $transactions = $self->transactions();
1078     if (scalar(@$transactions)>1){
1079         $error = "This seedlot has been used in transactions and so cannot be deleted!";
1080     } else {
1081         my $stock = $self->stock();
1082         my $experiment_type_id = SGN::Model::Cvterm->get_cvterm_row($self->schema(), "seedlot_experiment", "experiment_type")->cvterm_id();
1083         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});
1084         if ($nd_experiment_rs->count != 1){
1085             $error = "Seedlot does not have 1 nd_experiment associated!";
1086         } else {
1087             my $nd_experiment = $nd_experiment_rs->first();
1088             $nd_experiment->delete();
1089             my $stock_owner_rs = $self->phenome_schema->resultset("StockOwner")->find({stock_id=>$self->stock_id});
1090             if ($stock_owner_rs){
1091                 $stock_owner_rs->delete();
1092             }
1093             $stock->delete();
1094         }
1095     }
1096
1097     return $error;
1098 }
1099
1100 1;
1101
1102 no Moose;
1103 __PACKAGE__->meta->make_immutable;