lib/CXGN/Stock.pm

   1 =head1 NAME
   2
   3 CXGN::Stock - a second-level object for Stock
   4
   5 Version: 2.0
   6
   7 =head1 DESCRIPTION
   8
   9 This object was re-factored from CXGN::Chado::Stock and moosified.
  10
  11 Functions such as 'get_obsolete' , 'store' , and 'exists_in_database' are required , and do not use standard DBIC syntax.
  12
  13 =head1 AUTHOR
  14
  15 Naama Menda <nm249@cornell.edu>
  16 Lukas Mueller <lam87@cornell.edu>
  17
  18 =cut
  19
  20 package CXGN::Stock ;
  21
  22 use Moose;
  23
  24 use Carp;
  25 use Data::Dumper;
  26 use Bio::Chado::Schema;
  27 use CXGN::Metadata::Schema;
  28 use SGN::Model::Cvterm;
  29 use Bio::GeneticRelationships::Pedigree;
  30 use Bio::GeneticRelationships::Individual;
  31 use base qw / CXGN::DB::Object / ;
  32 use CXGN::Stock::StockLookup;
  33 use Try::Tiny;
  34
  35 has 'schema' => (
  36     isa => 'Bio::Chado::Schema',
  37     is => 'rw',
  38     required => 1
  39 );
  40
  41 has 'phenome_schema' => (
  42     isa => 'CXGN::Phenome::Schema',
  43     is => 'rw',
  44 );
  45
  46 has 'check_name_exists' => (
  47     isa => 'Bool',
  48     is => 'rw',
  49     default => 1
  50 );
  51
  52 has 'stock' => (
  53     isa => 'Bio::Chado::Schema::Result::Stock::Stock',
  54     is => 'rw',
  55 );
  56
  57 has 'stock_id' => (
  58     isa => 'Maybe[Int]',
  59     is => 'rw',
  60 );
  61
  62 has 'is_saving' => (
  63     isa => 'Bool',
  64     is => 'rw',
  65     default => 0
  66 );
  67
  68 # Returns the stock_owners as [sp_person_id, sp_person_id2, ..]
  69 has 'owners' => (
  70     isa => 'Maybe[ArrayRef[Int]]',
  71     is => 'rw',
  72     lazy     => 1,
  73     builder  => '_retrieve_stock_owner',
  74 );
  75
  76 has 'organism' => (
  77     isa => 'Bio::Chado::Schema::Result::Organism::Organism',
  78     is => 'rw',
  79 );
  80
  81 has 'organism_id' => (
  82     isa => 'Maybe[Int]',
  83     is => 'rw',
  84 );
  85
  86 has 'species' => (
  87     isa => 'Maybe[Str]',
  88     is => 'rw',
  89 );
  90
  91 has 'genus' => (
  92     isa => 'Maybe[Str]',
  93     is => 'rw',
  94 );
  95
  96 has 'organism_common_name' => (
  97     isa => 'Maybe[Str]',
  98     is => 'rw',
  99 );
 100
 101 has 'organism_abbreviation' => (
 102     isa => 'Maybe[Str]',
 103     is => 'rw',
 104 );
 105
 106 has 'organism_comment' => (
 107     isa => 'Maybe[Str]',
 108     is => 'rw',
 109 );
 110
 111 has 'type' => (
 112     isa => 'Str',
 113     is => 'rw',
 114     default => 'accession',
 115 );
 116
 117 has 'type_id' => (
 118     isa => 'Int',
 119     is => 'rw',
 120 );
 121
 122 has 'name' => (
 123     isa => 'Str',
 124     is => 'rw',
 125 );
 126
 127 has 'uniquename' => (
 128     isa => 'Str',
 129     is => 'rw',
 130 );
 131
 132 has 'description' => (
 133     isa => 'Maybe[Str]',
 134     is => 'rw',
 135     default => '',
 136 );
 137
 138 has 'is_obsolete' => (
 139     isa => 'Bool',
 140     is => 'rw',
 141     default => 0,
 142 );
 143
 144 has 'organization_name' => (
 145     isa => 'Maybe[Str]',
 146     is => 'rw',
 147 );
 148
 149 has 'population_name' => (
 150     isa => 'Maybe[Str]',
 151     is => 'rw',
 152 );
 153
 154 has 'populations' => (
 155     isa => 'Maybe[ArrayRef[ArrayRef]]',
 156     is => 'rw'
 157 );
 158
 159 has 'sp_person_id' => (
 160     isa => 'Int',
 161     is => 'rw',
 162 );
 163
 164 has 'user_name' => (
 165     isa => 'Maybe[Str]',
 166     is => 'rw',
 167 );
 168
 169 has 'modification_note' => (
 170     isa => 'Maybe[Str]',
 171     is => 'rw',
 172 );
 173
 174 sub BUILD {
 175     my $self = shift;
 176
 177     #print STDERR "RUNNING BUILD FOR STOCK.PM...\n";
 178     my $stock;
 179     if ($self->stock_id){
 180         $stock = $self->schema()->resultset("Stock::Stock")->find({ stock_id => $self->stock_id() });
 181         $self->stock($stock);
 182         $self->stock_id($stock->stock_id);
 183     }
 184     if (defined $stock && !$self->is_saving) {
 185         $self->organism_id($stock->organism_id);
 186         $self->name($stock->name);
 187         $self->uniquename($stock->uniquename);
 188         $self->description($stock->description() || '');
 189         $self->type_id($stock->type_id);
 190         $self->type($self->schema()->resultset("Cv::Cvterm")->find({ cvterm_id=>$self->type_id() })->name());
 191         $self->is_obsolete($stock->is_obsolete);
 192         $self->organization_name($self->_retrieve_stockprop('organization'));
 193         $self->_retrieve_populations();
 194     }
 195
 196     return $self;
 197 }
 198
 199 sub _retrieve_stock_owner {
 200     my $self = shift;
 201     my $owner_rs = $self->phenome_schema->resultset("StockOwner")->search({
 202         stock_id => $self->stock_id,
 203     });
 204     my @owners;
 205     while (my $r = $owner_rs->next){
 206         push @owners, $r->sp_person_id;
 207     }
 208     $self->owners(\@owners);
 209 }
 210
 211 =head2 store
 212
 213  Usage: $self->store
 214  Desc:  store a new stock or update an existing stock
 215  Ret:   a database id
 216  Args:  none
 217  Side Effects: checks if the stock exists in the database (if a stock_id is provided), and if does, will attempt to update
 218  Example:
 219
 220 =cut
 221
 222 sub store {
 223     my $self = shift;
 224     my %return;
 225
 226     my $stock = $self->stock;
 227     my $schema = $self->schema();
 228
 229     #no stock id . Check first if the name  exists in te database
 230     my $exists;
 231     if ($self->check_name_exists){
 232         $exists= $self->exists_in_database();
 233     }
 234
 235     if (!$self->type_id) {
 236         my $type_id = SGN::Model::Cvterm->get_cvterm_row($self->schema(), $self->type(), 'stock_type')->cvterm_id();
 237         $self->type_id($type_id);
 238     }
 239
 240     if (!$self->organism_id){
 241         if ($self->species){
 242
 243             my $organism_rs = $self->schema->resultset("Organism::Organism")->search({ species=>$self->species });
 244             if ($organism_rs->count > 1){
 245                 return $return{error} = "More than one organism returned for species: ".$self->species;
 246             }
 247             if ($organism_rs->count == 0){
 248                 return $return{error} = "NO ORGANISM FOUND OF SPECIES: ".$self->species;
 249             }
 250             if ($organism_rs->count == 1){
 251                 my $organism = $organism_rs->first();
 252                 $self->organism($organism);
 253                 $self->organism_id($organism->organism_id);
 254                 $self->organism_abbreviation($organism->abbreviation);
 255                 $self->genus($organism->genus);
 256                 $self->species($organism->species);
 257                 $self->organism_common_name($organism->common_name);
 258                 $self->organism_comment($organism->comment);
 259             }
 260         }
 261     }
 262
 263     if (!$stock) { #Trying to create a new stock
 264         print STDERR "Storing Stock ".localtime."\n";
 265         if (!$exists) {
 266
 267             my $new_row = $self->schema()->resultset("Stock::Stock")->create({
 268                 name => $self->name(),
 269                 uniquename => $self->uniquename(),
 270                 description => $self->description(),
 271                 type_id => $self->type_id(),
 272                 organism_id => $self->organism_id(),
 273                 is_obsolete => $self->is_obsolete(),
 274             });
 275             $new_row->insert();
 276
 277             my $id = $new_row->stock_id();
 278             $self->stock_id($id);
 279             $self->stock($new_row);
 280
 281             if ($self->organization_name){
 282                 $self->_store_stockprop('organization', $self->organization_name());
 283             }
 284             if ($self->population_name){
 285                 $self->_store_population_relationship();
 286             }
 287
 288         }
 289         else {
 290             die "The entry ".$self->uniquename()." already exists in the database. Error: $exists\n";
 291         }
 292     }
 293     else {
 294         print STDERR "Updating Stock ".localtime."\n";
 295         if (!$self->name && $self->uniquename){
 296             $self->name($self->uniquename);
 297         }
 298         my $row = $self->schema()->resultset("Stock::Stock")->find({ stock_id => $self->stock_id() });
 299         if ($self->name){ $row->name($self->name()) };
 300         if ($self->uniquename){ $row->uniquename($self->uniquename()) };
 301         if ($self->description){ $row->description($self->description()) };
 302         if ($self->type_id){ $row->type_id($self->type_id()) };
 303         if ($self->organism_id){ $row->organism_id($self->organism_id()) };
 304         if ($self->is_obsolete){ $row->is_obsolete($self->is_obsolete()) };
 305         $row->update();
 306         if ($self->organization_name){
 307             $self->_update_stockprop('organization', $self->organization_name());
 308         }
 309         if ($self->population_name){
 310             $self->_update_population_relationship();
 311         }
 312     }
 313     $self->associate_owner($self->sp_person_id, $self->sp_person_id, $self->user_name, $self->modification_note);
 314
 315     return $self->stock_id();
 316 }
 317
 318 ########################
 319
 320
 321 =head2 exists_in_database
 322
 323  Usage: $self->exists_in_database()
 324  Desc:  check if the uniquename exists in the stock table
 325  Ret:
 326  Args:
 327  Side Effects:
 328  Example:
 329
 330 =cut
 331
 332 sub exists_in_database {
 333     my $self = shift;
 334     my $schema = $self->schema;
 335     my $stock = $self->stock;
 336     my $stock_id = $self->stock_id;
 337     my $uniquename = $self->uniquename || '' ;
 338     my $stock_lookup = CXGN::Stock::StockLookup->new({
 339         schema => $schema,
 340         stock_name => $uniquename
 341     });
 342     my $s = $stock_lookup->get_stock();
 343
 344     # loading new stock - $stock_id is undef
 345     #
 346     if (defined($s) && !$stock ) {
 347         return "Uniquename already exists in database with stock_id: ".$s->stock_id;
 348     }
 349
 350     # updating an existing stock
 351     #
 352     elsif ($stock && defined($s) ) {
 353         if ( ($s->stock_id == $stock_id) ) {
 354             return 0;
 355             #trying to update the uniquename
 356         }
 357         elsif ( $s->stock_id != $stock_id ) {
 358             return " Can't update an existing stock $stock_id uniquename:$uniquename.";
 359             # if the new name we're trying to update/insert does not exist
 360             # in the stock table..
 361             #
 362         }
 363         elsif ($stock && !$s->stock_id) {
 364             return 0;
 365         }
 366     }
 367     return undef;
 368 }
 369
 370 =head2 get_organism
 371
 372  Usage: $self->get_organism
 373  Desc:  find the organism object of this stock
 374  Ret:   L<Bio::Chado::Schema::Organism::Organism> object
 375  Args:  none
 376  Side Effects: none
 377  Example:
 378
 379 =cut
 380
 381 sub get_organism {
 382     my $self = shift;
 383     my $bcs_stock = $self->schema()->resultset("Stock::Stock")->find( { stock_id => $self->stock_id() });
 384     if ($bcs_stock) {
 385         return $bcs_stock->organism;
 386     }
 387     return undef;
 388 }
 389
 390
 391 =head2 get_species
 392
 393  Usage: $self->get_species
 394  Desc:  find the species name of this stock , if one exists
 395  Ret:   string
 396  Args:  none
 397  Side Effects: none
 398  Example:
 399
 400 =cut
 401
 402 sub get_species {
 403     my $self = shift;
 404     my $organism = $self->get_organism;
 405     if ($organism) {
 406         return $organism->species;
 407     }
 408     else {
 409         return undef;
 410     }
 411 }
 412
 413 =head2 get_genus
 414
 415  Usage: $self->get_genus
 416  Desc:  find the genus name of this stock , if one exists
 417  Ret:   string
 418  Args:  none
 419  Side Effects: none
 420  Example:
 421
 422 =cut
 423
 424 sub get_genus {
 425     my $self = shift;
 426     my $organism = $self->get_organism;
 427     if ($organism) {
 428         return $organism->genus;
 429     }
 430     else {
 431         return undef;
 432     }
 433 }
 434
 435 =head2 get_species_authority
 436
 437  Usage: $self->get_species_authority
 438  Desc:  find the species_authority of this stock , if one exists
 439  Ret:   string
 440  Args:  none
 441  Side Effects: none
 442  Example:
 443
 444 =cut
 445
 446 sub get_species_authority {
 447     my $self = shift;
 448     return $self->_retrieve_organismprop('species authority');
 449 }
 450
 451 =head2 get_subtaxa
 452
 453  Usage: $self->get_subtaxa
 454  Desc:  find the subtaxa of this stock , if one exists
 455  Ret:   string
 456  Args:  none
 457  Side Effects: none
 458  Example:
 459
 460 =cut
 461
 462 sub get_subtaxa {
 463     my $self = shift;
 464     return $self->_retrieve_organismprop('subtaxa');
 465 }
 466
 467 =head2 get_subtaxa_authority
 468
 469  Usage: $self->get_subtaxa_authority
 470  Desc:  find the subtaxa_authority of this stock , if one exists
 471  Ret:   string
 472  Args:  none
 473  Side Effects: none
 474  Example:
 475
 476 =cut
 477
 478 sub get_subtaxa_authority {
 479     my $self = shift;
 480     return $self->_retrieve_organismprop('subtaxa authority');
 481 }
 482
 483 =head2 set_species
 484
 485 Usage: $self->set_species
 486  Desc:  set organism_id for the stock using organism.species name
 487  Ret:   nothing
 488  Args:  species name (case insensitive)
 489  Side Effects: sets the organism_id for the stock
 490  Example:
 491
 492 =cut
 493
 494 sub set_species {
 495     my $self = shift;
 496     my $species_name = shift; # this has to be EXACTLY as stored in the organism table
 497     my $organism = $self->get_schema->resultset('Organism::Organism')->search(
 498         { 'lower(species)' => { like =>  lc($species_name) } } )->single ; #should be 1 result
 499     if ($organism) {
 500         $self->organism_id($organism->organism_id);
 501     }
 502     else {
 503         warn "NO organism found for species name $species_name!!\n";
 504     }
 505 }
 506
 507 =head2 function get_image_ids
 508
 509   Synopsis:     my @images = $self->get_image_ids()
 510   Arguments:    none
 511   Returns:      a list of image ids
 512   Side effects: none
 513   Description:  a method for fetching all images associated with a stock
 514
 515 =cut
 516
 517 sub get_image_ids {
 518     my $self = shift;
 519     my @ids;
 520     my $q = "select distinct image_id, cvterm.name, stock_image.display_order FROM phenome.stock_image JOIN stock USING(stock_id) JOIN cvterm ON(type_id=cvterm_id) WHERE stock_id = ? ORDER BY stock_image.display_order ASC";
 521     my $h = $self->schema->storage->dbh()->prepare($q);
 522     $h->execute($self->stock_id);
 523     while (my ($image_id, $stock_type, $display_order) = $h->fetchrow_array()){
 524         push @ids, [$image_id, $stock_type];
 525     }
 526     return @ids;
 527 }
 528
 529 =head2 associate_allele
 530
 531  Usage: $self->associate_allele($allele_id, $sp_person_id)
 532  Desc:  store a stock-allele link in phenome.stock_allele
 533  Ret:   a database id
 534  Args:  allele_id, sp_person_id
 535  Side Effects:  store a metadata row
 536  Example:
 537
 538 =cut
 539
 540 sub associate_allele {
 541     my $self = shift;
 542     my $allele_id = shift;
 543     my $sp_person_id = shift;
 544     if (!$allele_id || !$sp_person_id) {
 545         warn "Need both allele_id and person_id for linking the stock with an allele!";
 546         return
 547     }
 548     my $metadata_id = $self->_new_metadata_id($sp_person_id);
 549     #check if the allele is already linked
 550     my $ids =  $self->schema()->storage()->dbh()->selectcol_arrayref
 551         ( "SELECT stock_allele_id FROM phenome.stock_allele WHERE stock_id = ? AND allele_id = ?",
 552           undef,
 553           $self->stock_id,
 554           $allele_id
 555         );
 556     if ($ids) { warn "Allele $allele_id is already linked with stock " . $self->stock_id ; }
 557 #store the allele_id - stock_id link
 558     my $q = "INSERT INTO phenome.stock_allele (stock_id, allele_id, metadata_id) VALUES (?,?,?) RETURNING stock_allele_id";
 559     my $sth  = $self->schema()->storage()->dbh()->prepare($q);
 560     $sth->execute($self->stock_id, $allele_id, $metadata_id);
 561     my ($id) =  $sth->fetchrow_array;
 562     return $id;
 563 }
 564
 565 =head2 associate_owner
 566
 567  Usage: $self->associate_owner($owner_sp_person_id, $sp_person_id)
 568  Desc:  store a stock-owner link in phenome.stock_owner
 569  Ret:   a database id
 570  Args:  owner_id, sp_person_id
 571  Side Effects:  store a metadata row
 572  Example:
 573
 574 =cut
 575
 576 sub associate_owner {
 577     my $self = shift;
 578     my $owner_id = shift;
 579     my $sp_person_id = shift;
 580     my $user_name = shift;
 581     my $modification_note = shift;
 582     if (!$owner_id || !$sp_person_id) {
 583         warn "Need both owner_id and person_id for linking the stock with an owner!";
 584         return;
 585     }
 586     my $metadata_id = $self->_new_metadata_id($sp_person_id, $user_name, $modification_note);
 587     #check if the owner is already linked
 588     my $ids =  $self->schema()->storage()->dbh()->selectcol_arrayref
 589         ( "SELECT stock_owner_id FROM phenome.stock_owner WHERE stock_id = ? AND sp_person_id = ?",
 590           undef,
 591           $self->stock_id,
 592           $owner_id
 593         );
 594     if ($ids) { warn "Owner $owner_id is already linked with stock " . $self->stock_id ; }
 595 #store the owner_id - stock_id link
 596     my $q = "INSERT INTO phenome.stock_owner (stock_id, sp_person_id, metadata_id) VALUES (?,?,?) RETURNING stock_owner_id";
 597     my $sth  = $self->schema()->storage()->dbh()->prepare($q);
 598     $sth->execute($self->stock_id, $owner_id, $metadata_id);
 599     my ($id) =  $sth->fetchrow_array;
 600     return $id;
 601 }
 602
 603 =head2 get_trait_list
 604
 605  Usage:
 606  Desc:         gets the list of traits that have been measured
 607                on this stock
 608  Ret:          a list of lists  ( [ cvterm_id, cvterm_name] , ...)
 609  Args:
 610  Side Effects:
 611  Example:
 612
 613 =cut
 614
 615 sub get_trait_list {
 616     my $self = shift;
 617
 618     my $q = "select distinct(cvterm.cvterm_id), db.name || ':' || dbxref.accession, cvterm.name, avg(phenotype.value::Real), stddev(phenotype.value::Real) from stock as accession join stock_relationship on (accession.stock_id=stock_relationship.object_id) JOIN stock as plot on (plot.stock_id=stock_relationship.subject_id) JOIN nd_experiment_stock ON (plot.stock_id=nd_experiment_stock.stock_id) JOIN nd_experiment_phenotype USING(nd_experiment_id) JOIN phenotype USING (phenotype_id) JOIN cvterm ON (phenotype.cvalue_id = cvterm.cvterm_id) JOIN dbxref ON(cvterm.dbxref_id = dbxref.dbxref_id) JOIN db USING(db_id) where accession.stock_id=? and phenotype.value~? group by cvterm.cvterm_id, db.name || ':' || dbxref.accession, cvterm.name";
 619     my $h = $self->schema()->storage()->dbh()->prepare($q);
 620     my $numeric_regex = '^[0-9]+([,.][0-9]+)?$';
 621     $h->execute($self->stock_id(), $numeric_regex);
 622     my @traits;
 623     while (my ($cvterm_id, $cvterm_accession, $cvterm_name, $avg, $stddev) = $h->fetchrow_array()) {
 624         push @traits, [ $cvterm_id, $cvterm_accession, $cvterm_name, $avg, $stddev ];
 625     }
 626
 627     # get directly associated traits
 628     #
 629     $q = "select distinct(cvterm.cvterm_id), db.name || ':' || dbxref.accession, cvterm.name, avg(phenotype.value::Real), stddev(phenotype.value::Real) from stock JOIN nd_experiment_stock ON (stock.stock_id=nd_experiment_stock.stock_id) JOIN nd_experiment_phenotype USING(nd_experiment_id) JOIN phenotype USING (phenotype_id) JOIN cvterm ON (phenotype.cvalue_id = cvterm.cvterm_id) JOIN dbxref ON(cvterm.dbxref_id = dbxref.dbxref_id) JOIN db USING(db_id) where stock.stock_id=? and phenotype.value~? group by cvterm.cvterm_id, db.name || ':' || dbxref.accession, cvterm.name";
 630
 631     $h = $self->schema()->storage()->dbh()->prepare($q);
 632     $numeric_regex = '^[0-9]+([,.][0-9]+)?$';
 633     $h->execute($self->stock_id(), $numeric_regex);
 634
 635     while (my ($cvterm_id, $cvterm_accession, $cvterm_name, $avg, $stddev) = $h->fetchrow_array()) {
 636         push @traits, [ $cvterm_id, $cvterm_accession, $cvterm_name, $avg, $stddev ];
 637     }
 638
 639     return @traits;
 640 }
 641
 642 =head2 get_trials
 643
 644  Usage:
 645  Desc:          gets the list of trails this stock was used in
 646  Ret:
 647  Args:
 648  Side Effects:
 649  Example:
 650
 651 =cut
 652
 653 sub get_trials {
 654     my $self = shift;
 655     my $dbh = $self->schema()->storage()->dbh();
 656
 657     my $geolocation_q = "SELECT nd_geolocation_id, description FROM nd_geolocation;";
 658     my $geolocation_h = $dbh->prepare($geolocation_q);
 659     $geolocation_h->execute();
 660     my %geolocations;
 661
 662     while (my ($nd_geolocation_id, $description) = $geolocation_h->fetchrow_array()) {
 663         $geolocations{$nd_geolocation_id} = $description;
 664     }
 665
 666     my $geolocation_type_id = SGN::Model::Cvterm->get_cvterm_row($self->schema(), 'project location', 'project_property')->cvterm_id();
 667     my $q = "select distinct(project.project_id), project.name, projectprop.value from stock as accession join stock_relationship on (accession.stock_id=stock_relationship.object_id) JOIN stock as plot on (plot.stock_id=stock_relationship.subject_id) JOIN nd_experiment_stock ON (plot.stock_id=nd_experiment_stock.stock_id) JOIN nd_experiment_project USING(nd_experiment_id) JOIN project USING (project_id) LEFT JOIN projectprop ON (project.project_id=projectprop.project_id) where projectprop.type_id=$geolocation_type_id AND accession.stock_id=?;";
 668
 669     my $h = $dbh->prepare($q);
 670     $h->execute($self->stock_id());
 671
 672     my @trials;
 673     while (my ($project_id, $project_name, $nd_geolocation_id) = $h->fetchrow_array()) {
 674         push @trials, [ $project_id, $project_name, $nd_geolocation_id, $geolocations{$nd_geolocation_id} ];
 675     }
 676     return @trials;
 677 }
 678
 679 =head2 get_ancestor_hash
 680
 681  Usage:
 682  Desc:          gets a multi-dimensional hash of this stock's ancestors
 683  Ret:
 684  Args:
 685  Side Effects:
 686  Example:
 687
 688 =cut
 689
 690 sub get_ancestor_hash {
 691   my ($self, $stock_id, $direct_descendant_ids) = @_;
 692
 693   if (!$stock_id) { $stock_id = $self->stock_id(); }
 694   push @$direct_descendant_ids, $stock_id; #excluded in parent retrieval to prevent loops
 695
 696   my $stock = $self->schema->resultset("Stock::Stock")->find({stock_id => $stock_id});
 697   #print STDERR "Stock ".$stock->uniquename()." decendants are: ".Dumper($direct_descendant_ids)."\n";
 698   my %pedigree;
 699   $pedigree{'id'} = $stock_id;
 700   $pedigree{'name'} = $stock->uniquename();
 701   $pedigree{'female_parent'} = undef;
 702   $pedigree{'male_parent'} = undef;
 703   $pedigree{'link'} = "/stock/$stock_id/view";
 704
 705   #get cvterms for parent relationships
 706   my $cvterm_female_parent = SGN::Model::Cvterm->get_cvterm_row($self->schema, 'female_parent', 'stock_relationship');
 707   my $cvterm_male_parent = SGN::Model::Cvterm->get_cvterm_row($self->schema, 'male_parent', 'stock_relationship');
 708
 709   #get the stock relationships for the stock, find stock relationships for types "female_parent" and "male_parent", and get the corresponding subject stock IDs and stocks.
 710   my $stock_relationships = $stock->search_related("stock_relationship_objects",undef,{ prefetch => ['type','subject'] });
 711   my $female_parent_relationship = $stock_relationships->find({type_id => $cvterm_female_parent->cvterm_id(), subject_id => {'not_in' => $direct_descendant_ids}});
 712   if ($female_parent_relationship) {
 713     my $female_parent_stock_id = $female_parent_relationship->subject_id();
 714     $pedigree{'cross_type'} = $female_parent_relationship->value();
 715         $pedigree{'female_parent'} = get_ancestor_hash( $self, $female_parent_stock_id, $direct_descendant_ids );
 716   }
 717   my $male_parent_relationship = $stock_relationships->find({type_id => $cvterm_male_parent->cvterm_id(), subject_id => {'not_in' => $direct_descendant_ids}});
 718   if ($male_parent_relationship) {
 719     my $male_parent_stock_id = $male_parent_relationship->subject_id();
 720         $pedigree{'male_parent'} = get_ancestor_hash( $self, $male_parent_stock_id, $direct_descendant_ids );
 721   }
 722   pop @$direct_descendant_ids; # falling back a level while recursing pedigree tree
 723   return \%pedigree;
 724 }
 725
 726 =head2 get_descendant_hash
 727
 728  Usage:
 729  Desc:          gets a multi-dimensional hash of this stock's descendants
 730  Ret:
 731  Args:
 732  Side Effects:
 733  Example:
 734
 735 =cut
 736
 737 sub get_descendant_hash {
 738   my ($self, $stock_id, $direct_ancestor_ids) = @_;
 739
 740   if (!$stock_id) { $stock_id = $self->stock_id(); }
 741   push @$direct_ancestor_ids, $stock_id; #excluded in child retrieval to prevent loops
 742
 743   my $stock = $self->schema->resultset("Stock::Stock")->find({stock_id => $stock_id});
 744   #print STDERR "Stock ".$stock->uniquename()." ancestors are: ".Dumper($direct_ancestor_ids)."\n";
 745   my %descendants;
 746   my %progeny;
 747   $descendants{'id'} = $stock_id;
 748   $descendants{'name'} = $stock->uniquename();
 749   $descendants{'link'} = "/stock/$stock_id/view";
 750   #get cvterms for parent relationships
 751   my $cvterm_female_parent = SGN::Model::Cvterm->get_cvterm_row($self->schema, 'female_parent','stock_relationship');
 752   my $cvterm_male_parent = SGN::Model::Cvterm->get_cvterm_row($self->schema, 'male_parent', 'stock_relationship');
 753
 754   #get the stock relationships for the stock, find stock relationships for types "female_parent" and "male_parent", and get the corresponding subject stock IDs and stocks.
 755   my $descendant_relationships = $stock->search_related("stock_relationship_subjects",{ object_id => {'not_in' => $direct_ancestor_ids}},{ prefetch => ['type','object'] });
 756   if ($descendant_relationships) {
 757     while (my $descendant_relationship = $descendant_relationships->next) {
 758       my $descendant_stock_id = $descendant_relationship->object_id();
 759       if (($descendant_relationship->type_id() == $cvterm_female_parent->cvterm_id()) || ($descendant_relationship->type_id() == $cvterm_male_parent->cvterm_id())) {
 760           $progeny{$descendant_stock_id} = get_descendant_hash($self, $descendant_stock_id, $direct_ancestor_ids);
 761       }
 762     }
 763     $descendants{'descendants'} = \%progeny;
 764     pop @$direct_ancestor_ids; # falling back a level while recursing descendant tree
 765     return \%descendants;
 766   }
 767 }
 768
 769 =head2 get_pedigree_rows
 770
 771  Usage:
 772  Desc:          get an array of pedigree rows from an array of stock ids, conatining female parent, male parent, and cross type if defined
 773  Ret:
 774  Args: $accession_ids, $format (either 'parents_only' or 'full')
 775  Side Effects:
 776  Example:
 777
 778 =cut
 779
 780 sub get_pedigree_rows {
 781     my ($self, $accession_ids, $format) = @_;
 782     #print STDERR "Accession ids are: ".Dumper(@$accession_ids)."\n";
 783
 784     my $placeholders = join ( ',', ('?') x @$accession_ids );
 785     my ($query, $pedigree_rows);
 786
 787     if ($format eq 'parents_only') {
 788         $query = "
 789         SELECT child.uniquename AS Accession,
 790             mother.uniquename AS Female_Parent,
 791             father.uniquename AS Male_Parent,
 792             m_rel.value AS cross_type
 793         FROM stock child
 794         LEFT JOIN stock_relationship m_rel ON(child.stock_id = m_rel.object_id and m_rel.type_id = (SELECT cvterm_id FROM cvterm WHERE name = 'female_parent'))
 795         LEFT JOIN stock mother ON(m_rel.subject_id = mother.stock_id)
 796         LEFT JOIN stock_relationship f_rel ON(child.stock_id = f_rel.object_id and f_rel.type_id = (SELECT cvterm_id FROM cvterm WHERE name = 'male_parent'))
 797         LEFT JOIN stock father ON(f_rel.subject_id = father.stock_id)
 798         WHERE child.stock_id IN ($placeholders)
 799         GROUP BY 1,2,3,4
 800         ORDER BY 1";
 801     }
 802     elsif ($format eq 'full') {
 803         $query = "
 804         WITH RECURSIVE included_rows(child, child_id, mother, mother_id, father, father_id, type, depth, path, cycle) AS (
 805                 SELECT c.uniquename AS child,
 806                 c.stock_id AS child_id,
 807                 m.uniquename AS mother,
 808                 m.stock_id AS mother_id,
 809                 f.uniquename AS father,
 810                 f.stock_id AS father_id,
 811                 m_rel.value AS type,
 812                 1,
 813                 ARRAY[c.stock_id],
 814                 false
 815                 FROM stock c
 816                 LEFT JOIN stock_relationship m_rel ON(c.stock_id = m_rel.object_id and m_rel.type_id = (SELECT cvterm_id FROM cvterm WHERE name = 'female_parent'))
 817                 LEFT JOIN stock m ON(m_rel.subject_id = m.stock_id)
 818                 LEFT JOIN stock_relationship f_rel ON(c.stock_id = f_rel.object_id and f_rel.type_id = (SELECT cvterm_id FROM cvterm WHERE name = 'male_parent'))
 819                 LEFT JOIN stock f ON(f_rel.subject_id = f.stock_id)
 820                 WHERE c.stock_id IN ($placeholders)
 821                 GROUP BY 1,2,3,4,5,6,7,8,9,10
 822             UNION
 823                 SELECT c.uniquename AS child,
 824                 c.stock_id AS child_id,
 825                 m.uniquename AS mother,
 826                 m.stock_id AS mother_id,
 827                 f.uniquename AS father,
 828                 f.stock_id AS father_id,
 829                 m_rel.value AS type,
 830                 included_rows.depth + 1,
 831                 path || c.stock_id,
 832                 c.stock_id = ANY(path)
 833                 FROM included_rows, stock c
 834                 LEFT JOIN stock_relationship m_rel ON(c.stock_id = m_rel.object_id and m_rel.type_id = (SELECT cvterm_id FROM cvterm WHERE name = 'female_parent'))
 835                 LEFT JOIN stock m ON(m_rel.subject_id = m.stock_id)
 836                 LEFT JOIN stock_relationship f_rel ON(c.stock_id = f_rel.object_id and f_rel.type_id = (SELECT cvterm_id FROM cvterm WHERE name = 'male_parent'))
 837                 LEFT JOIN stock f ON(f_rel.subject_id = f.stock_id)
 838                 WHERE c.stock_id IN (included_rows.mother_id, included_rows.father_id) AND NOT cycle
 839                 GROUP BY 1,2,3,4,5,6,7,8,9,10
 840         )
 841         SELECT child, mother, father, type, depth
 842         FROM included_rows
 843         GROUP BY 1,2,3,4,5
 844         ORDER BY 5,1;";
 845     }
 846
 847     my $sth = $self->schema()->storage()->dbh()->prepare($query);
 848     $sth->execute(@$accession_ids);
 849
 850     no warnings 'uninitialized';
 851     while (my ($name, $mother, $father, $cross_type, $depth) = $sth->fetchrow_array()) {
 852         #print STDERR "For child $name:\n\tMother:$mother\n\tFather:$father\n\tCross Type:$cross_type\n\tDepth:$depth\n\n";
 853             push @$pedigree_rows, "$name\t$mother\t$father\t$cross_type\n";
 854     }
 855     return $pedigree_rows;
 856 }
 857
 858 =head2 get_pedigree_string
 859
 860  Usage:
 861  Desc:          get the properly formatted pedigree string of the given level (Parents, Grandparents, or Great-Grandparents) for this stock
 862  Ret:
 863  Args:
 864  Side Effects:
 865  Example:
 866
 867 =cut
 868
 869 sub get_pedigree_string {
 870     my ($self, $level) = @_;
 871
 872     my $pedigree_hashref = $self->get_ancestor_hash();
 873
 874     #print STDERR "Getting string of level $level from pedigree hashref ".Dumper($pedigree_hashref)."\n";
 875     if ($level eq "Parents") {
 876         return $self->_get_parent_string($pedigree_hashref);
 877     }
 878     elsif ($level eq "Grandparents") {
 879         my $maternal_parent_string = $self->_get_parent_string($pedigree_hashref->{'female_parent'});
 880         my $paternal_parent_string = $self->_get_parent_string($pedigree_hashref->{'male_parent'});
 881         return "$maternal_parent_string//$paternal_parent_string";
 882     }
 883     elsif ($level eq "Great-Grandparents") {
 884         my $mm_parent_string = $self->_get_parent_string($pedigree_hashref->{'female_parent'}->{'female_parent'});
 885         my $mf_parent_string = $self->_get_parent_string($pedigree_hashref->{'female_parent'}->{'male_parent'});
 886         my $pm_parent_string = $self->_get_parent_string($pedigree_hashref->{'male_parent'}->{'female_parent'});
 887         my $pf_parent_string = $self->_get_parent_string($pedigree_hashref->{'male_parent'}->{'male_parent'});
 888         return "$mm_parent_string//$mf_parent_string///$pm_parent_string//$pf_parent_string";
 889     }
 890 }
 891
 892 sub _get_parent_string {
 893     my ($self, $pedigree_hashref) = @_;
 894     my $mother = $pedigree_hashref->{'female_parent'}->{'name'} || 'NA';
 895     my $father = $pedigree_hashref->{'male_parent'}->{'name'} || 'NA';
 896     return "$mother/$father";
 897 }
 898
 899 sub get_parents {
 900     my $self =  shift;
 901     my $pedigree_hashref = $self->get_ancestor_hash();
 902     my %parents;
 903     $parents{'mother'} = $pedigree_hashref->{'female_parent'}->{'name'};
 904     $parents{'mother_id'} = $pedigree_hashref->{'female_parent'}->{'id'};
 905     $parents{'father'} = $pedigree_hashref->{'male_parent'}->{'name'};
 906     $parents{'father_id'} = $pedigree_hashref->{'male_parent'}->{'id'};
 907     return \%parents;
 908 }
 909
 910 sub _store_stockprop {
 911     my $self = shift;
 912     my $type = shift;
 913     my $value = shift;
 914     #print STDERR Dumper $type;
 915     my $stockprop = SGN::Model::Cvterm->get_cvterm_row($self->schema, $type, 'stock_property')->name();
 916     my @arr = split ',', $value;
 917     foreach (@arr){
 918         my $stored_stockprop = $self->stock->create_stockprops({ $stockprop => $_});
 919     }
 920 }
 921
 922 sub _update_stockprop {
 923     my $self = shift;
 924     my $type = shift;
 925     my $value = shift;
 926     my $stockprop_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($self->schema, $type, 'stock_property')->cvterm_id();
 927     my $rs = $self->stock->search_related('stockprops', {'type_id'=>$stockprop_cvterm_id});
 928     while(my $r=$rs->next){
 929         $r->delete();
 930     }
 931     $self->_store_stockprop($type,$value);
 932 }
 933
 934 sub _retrieve_stockprop {
 935     my $self = shift;
 936     my $type = shift;
 937     my @results;
 938
 939     try {
 940         my $stockprop_type_id = SGN::Model::Cvterm->get_cvterm_row($self->schema, $type, 'stock_property')->cvterm_id();
 941         my $rs = $self->schema()->resultset("Stock::Stockprop")->search({ stock_id => $self->stock_id(), type_id => $stockprop_type_id }, { order_by => {-asc => 'stockprop_id'} });
 942
 943         while (my $r = $rs->next()){
 944             push @results, $r->value;
 945         }
 946     } catch {
 947         #print STDERR "Cvterm $type does not exist in this database\n";
 948     };
 949
 950     my $res = join ',', @results;
 951     return $res;
 952 }
 953
 954 sub _remove_stockprop {
 955     my $self = shift;
 956     my $type = shift;
 957     my $value = shift;
 958     my $type_id = SGN::Model::Cvterm->get_cvterm_row($self->schema, $type, 'stock_property')->cvterm_id();
 959     my $rs = $self->schema()->resultset("Stock::Stockprop")->search( { type_id=>$type_id, stock_id => $self->stock_id(), value=>$value } );
 960
 961     if ($rs->count() == 1) {
 962         $rs->first->delete();
 963         return 1;
 964     }
 965     elsif ($rs->count() == 0) {
 966         return 0;
 967     }
 968     else {
 969         print STDERR "Error removing stockprop from stock ".$self->stock_id().". Please check this manually.\n";
 970         return 0;
 971     }
 972
 973 }
 974
 975 sub _retrieve_organismprop {
 976     my $self = shift;
 977     my $type = shift;
 978     my @results;
 979
 980     try {
 981         my $organismprop_type_id = SGN::Model::Cvterm->get_cvterm_row($self->schema, $type, 'organism_property')->cvterm_id();
 982         my $rs = $self->schema()->resultset("Organism::Organismprop")->search({ organism_id => $self->stock->organism_id, type_id => $organismprop_type_id }, { order_by => {-asc => 'organismprop_id'} });
 983
 984         while (my $r = $rs->next()){
 985             push @results, $r->value;
 986         }
 987     } catch {
 988         #print STDERR "Cvterm $type does not exist in this database\n";
 989     };
 990
 991     my $res = join ',', @results;
 992     return $res;
 993 }
 994
 995 sub _store_population_relationship {
 996     my $self = shift;
 997     my $schema = $self->schema;
 998     my $population_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'population','stock_type')->cvterm_id();
 999     my $population_member_cvterm_id =  SGN::Model::Cvterm->get_cvterm_row($schema, 'member_of','stock_relationship')->cvterm_id();
1000
1001     my $population = $schema->resultset("Stock::Stock")->find_or_create({
1002         uniquename => $self->population_name(),
1003         name => $self->population_name(),
1004         organism_id => $self->organism_id(),
1005         type_id => $population_cvterm_id,
1006     });
1007     $self->stock->find_or_create_related('stock_relationship_subjects', {
1008         type_id => $population_member_cvterm_id,
1009         object_id => $population->stock_id(),
1010         subject_id => $self->stock_id(),
1011     });
1012 }
1013
1014 sub _update_population_relationship {
1015     my $self = shift;
1016     my $population_member_cvterm_id =  SGN::Model::Cvterm->get_cvterm_row($self->schema, 'member_of','stock_relationship')->cvterm_id();
1017     my $pop_rs = $self->stock->search_related('stock_relationship_subjects', {'type_id'=>$population_member_cvterm_id});
1018     while (my $r=$pop_rs->next){
1019         $r->delete();
1020     }
1021     $self->_store_population_relationship();
1022 }
1023
1024 sub _retrieve_populations {
1025     my $self = shift;
1026     my $schema = $self->schema;
1027     my $population_member_cvterm_id =  SGN::Model::Cvterm->get_cvterm_row($schema, 'member_of','stock_relationship')->cvterm_id();
1028
1029     my $rs = $schema->resultset("Stock::StockRelationship")->search({
1030         type_id => $population_member_cvterm_id,
1031         subject_id => $self->stock_id(),
1032     });
1033     if ($rs->count == 0) {
1034         #print STDERR "No population saved for this stock!\n";
1035     }
1036     else {
1037         my @population_names;
1038         my @population_name;
1039         while (my $row = $rs->next) {
1040             my $population = $row->object;
1041             push @population_name, $population->uniquename();
1042             push @population_names, [$population->stock_id(), $population->uniquename()];
1043         }
1044         my $pop_string = join ',', @population_name;
1045         $self->populations(\@population_names);
1046         $self->population_name($pop_string);
1047     }
1048 }
1049
1050 =head2 _new_metadata_id
1051
1052 Usage: my $md_id = $self->_new_metatada_id($sp_person_id)
1053 Desc:  Store a new md_metadata row with a $sp_person_id
1054 Ret:   a database id
1055 Args:  sp_person_id
1056
1057 =cut
1058
1059 sub _new_metadata_id {
1060     my $self = shift;
1061     my $sp_person_id = shift;
1062     my $user_name = shift;
1063     my $modification_note = shift;
1064     my $metadata_schema = CXGN::Metadata::Schema->connect(
1065         sub { $self->schema()->storage()->dbh() },
1066         );
1067     $metadata_schema->storage->dbh->do('SET search_path TO metadata');
1068     my $metadata = CXGN::Metadata::Metadbdata->new($metadata_schema);
1069     $metadata->set_create_person_id($sp_person_id);
1070     my $metadata_id = $metadata->store()->get_metadata_id();
1071     if ($modification_note){
1072         my $metadata = CXGN::Metadata::Metadbdata->new($metadata_schema, $user_name, $metadata_id);
1073         $metadata->set_modification_note($modification_note);
1074         $metadata_id = $metadata->store()->get_metadata_id();
1075     }
1076     $metadata_schema->storage->dbh->do('SET search_path TO public,sgn');
1077     return $metadata_id;
1078 }
1079
1080 =head2 merge
1081
1082  Usage:         $s->merge(221, 1);
1083  Desc:          merges stock $s with stock_id 221. Optional delete boolean
1084                 parameter indicates whether other stock should be deleted.
1085  Ret:
1086  Args:
1087  Side Effects:
1088  Example:
1089
1090 =cut
1091
1092 sub merge {
1093     my $self = shift;
1094     my $other_stock_id = shift;
1095     my $delete_other_stock = shift;
1096
1097     if ($other_stock_id == $self->stock_id()) {
1098         print STDERR "Trying to merge stock into itself ($other_stock_id) Skipping...\n";
1099         return;
1100     }
1101
1102
1103
1104     my $stockprop_count=0;
1105     my $subject_rel_count=0;
1106     my $object_rel_count=0;
1107     my $stock_allele_count=0;
1108     my $image_count=0;
1109     my $experiment_stock_count=0;
1110     my $stock_dbxref_count=0;
1111     my $stock_owner_count=0;
1112     my $parent_1_count=0;
1113     my $parent_2_count=0;
1114     my $other_stock_deleted = 'NO';
1115
1116
1117     my $schema = $self->schema();
1118
1119     # move stockprops
1120     #
1121     my $sprs = $schema->resultset("Stock::Stockprop")->search( { stock_id => $other_stock_id });
1122     while (my $row = $sprs->next()) {
1123
1124         # check if this stockprop already exists for this stock; save only if not
1125         #
1126         my $thissprs = $schema->resultset("Stock::Stockprop")->search(
1127             {
1128                 stock_id => $self->stock_id(),
1129                 type_id => $row->type_id(),
1130                 value => $row->value()
1131             });
1132
1133         if ($thissprs->count() == 0) {
1134             my $value = $row->value();
1135             my $type_id = $row->type_id();
1136
1137             my $rank_rs = $schema->resultset("Stock::Stockprop")->search( { stock_id => $self->stock_id(), type_id => $type_id });
1138
1139             my $rank;
1140             if ($rank_rs->count() > 0) {
1141                 $rank = $rank_rs->get_column("rank")->max();
1142             }
1143
1144             $rank++;
1145             $row->rank($rank);
1146             $row->stock_id($self->stock_id());
1147
1148             $row->update();
1149
1150             print STDERR "MERGED stockprop_id ".$row->stockprop_id." for stock $other_stock_id type_id $type_id value $value into stock ".$self->stock_id()."\n";
1151             $stockprop_count++;
1152         }
1153     }
1154
1155     # move subject relationships
1156     #
1157     my $ssrs = $schema->resultset("Stock::StockRelationship")->search( { subject_id => $other_stock_id });
1158
1159     while (my $row = $ssrs->next()) {
1160
1161         my $this_subject_rel_rs = $schema->resultset("Stock::StockRelationship")->search( { subject_id => $self->stock_id(), object_id => $row->object_id, type_id => $row->type_id() });
1162
1163         if ($this_subject_rel_rs->count() == 0) { # this stock does not have the relationship
1164             # get the max rank
1165             my $rank_rs = $schema->resultset("Stock::StockRelationship")->search( { subject_id => $self->stock_id(), type_id => $row->type_id() });
1166             my $rank = 0;
1167             if ($rank_rs->count() > 0) {
1168                 $rank = $rank_rs->get_column("rank")->max();
1169             }
1170             $rank++;
1171             $row->rank($rank);
1172             $row->subject_id($self->stock_id());
1173             $row->update();
1174             print STDERR "Moving subject relationships from stock $other_stock_id to stock ".$self->stock_id()."\n";
1175             $subject_rel_count++;
1176         }
1177     }
1178
1179     # move object relationships
1180     #
1181     my $osrs = $schema->resultset("Stock::StockRelationship")->search( { object_id => $other_stock_id });
1182     while (my $row = $osrs->next()) {
1183         my $this_object_rel_rs = $schema->resultset("Stock::StockRelationship")->search( { object_id => $self->stock_id, subject_id => $row->subject_id(), type_id => $row->type_id() });
1184
1185         if ($this_object_rel_rs->count() == 0) {
1186             my $rank_rs = $schema->resultset("Stock::StockRelationship")->search( { object_id => $self->stock_id(), type_id => $row->type_id() });
1187             my $rank = 0;
1188             if ($rank_rs->count() > 0) {
1189                 $rank = $rank_rs->get_column("rank")->max();
1190             }
1191             $rank++;
1192             $row->rank($rank);
1193             $row->object_id($self->stock_id());
1194             $row->update();
1195             print STDERR "Moving object relationships from stock $other_stock_id to stock ".$self->stock_id()."\n";
1196             $object_rel_count++;
1197         }
1198     }
1199
1200     # move experiment_stock
1201     #
1202     my $esrs = $schema->resultset("NaturalDiversity::NdExperimentStock")->search( { stock_id => $other_stock_id });
1203     while (my $row = $esrs->next()) {
1204         $row->stock_id($self->stock_id());
1205         $row->update();
1206         print STDERR "Moving experiments for stock $other_stock_id to stock ".$self->stock_id()."\n";
1207         $experiment_stock_count++;
1208     }
1209
1210     # move stock_cvterm relationships
1211     #
1212
1213
1214     # move stock_dbxref
1215     #
1216     my $sdrs = $schema->resultset("Stock::StockDbxref")->search( { stock_id => $other_stock_id });
1217     while (my $row = $sdrs->next()) {
1218         $row->stock_id($self->stock_id());
1219         $row->update();
1220         $stock_dbxref_count++;
1221     }
1222
1223     # move sgn.pcr_exp_accession relationships
1224     #
1225
1226
1227     # move sgn.pcr_experiment relationships
1228     #
1229
1230
1231
1232     # move stock_genotype relationships
1233     #
1234
1235
1236     my $phenome_schema = CXGN::Phenome::Schema->connect(
1237         sub { $self->schema()->storage()->dbh() }, { on_connect_do => [ 'SET search_path TO phenome, public, sgn'], limit_dialect => 'LimitOffset' }
1238         );
1239
1240     # move phenome.stock_allele relationships
1241     #
1242     my $sars = $phenome_schema->resultset("StockAllele")->search( { stock_id => $other_stock_id });
1243     while (my $row = $sars->next()) {
1244         $row->stock_id($self->stock_id());
1245         $row->udate();
1246         print STDERR "Moving stock alleles from stock $other_stock_id to stock ".$self->stock_id()."\n";
1247         $stock_allele_count++;
1248     }
1249
1250     # move image relationships
1251     #
1252     my $irs = $phenome_schema->resultset("StockImage")->search( { stock_id => $other_stock_id });
1253     while (my $row = $irs->next()) {
1254
1255         my $this_rs = $phenome_schema->resultset("StockImage")->search( { stock_id => $self->stock_id(), image_id => $row->image_id() } );
1256         if ($this_rs->count() == 0) {
1257             $row->stock_id($self->stock_id());
1258             $row->update();
1259             print STDERR "Moving image ".$row->image_id()." from stock $other_stock_id to stock ".$self->stock_id()."\n";
1260             $image_count++;
1261         }
1262         else {
1263             print STDERR "Removing stock_image entry...\n";
1264             $row->delete(); # there is no cascade delete on image relationships, so we need to remove dangling relationships.
1265         }
1266     }
1267
1268     # move stock owners
1269     #
1270     my $sors = $phenome_schema->resultset("StockOwner")->search( { stock_id => $other_stock_id });
1271     while (my $row = $sors->next()) {
1272
1273         my $this_rs = $phenome_schema->resultset("StockOwner")->search( { stock_id => $self->stock_id(), sp_person_id => $row->sp_person_id() });
1274         if ($this_rs->count() == 0) {
1275             $row->stock_id($self->stock_id());
1276             $row->update();
1277             print STDERR "Moved stock_owner ".$row->sp_person_id()." of stock $other_stock_id to stock ".$self->stock_id()."\n";
1278             $stock_owner_count++;
1279         }
1280         else {
1281             print STDERR "(Deleting stock owner entry for stock $other_stock_id, owner ".$row->sp_person_id()."\n";
1282             $row->delete(); # see comment for move image relationships
1283         }
1284     }
1285
1286     # move map parents
1287     #
1288     my $sgn_schema = SGN::Schema->connect(
1289         sub { $self->schema()->storage()->dbh() }, { limit_dialect => 'LimitOffset' }
1290         );
1291
1292     my $mrs1 = $sgn_schema->resultset("Map")->search( { parent_1 => $other_stock_id });
1293     while (my $row = $mrs1->next()) {
1294         $row->parent_1($self->stock_id());
1295         $row->update();
1296         print STDERR "Move map parent_1 $other_stock_id to ".$self->stock_id()."\n";
1297         $parent_1_count++;
1298     }
1299
1300     my $mrs2 = $sgn_schema->resultset("Map")->search( { parent_2 => $other_stock_id });
1301     while (my $row = $mrs2->next()) {
1302         $row->parent_2($self->stock_id());
1303         $row->update();
1304         print STDERR "Move map parent_2 $other_stock_id to ".$self->stock_id()."\n";
1305         $parent_2_count++;
1306     }
1307
1308     if ($delete_other_stock) {
1309         my $row = $self->schema()->resultset("Stock::Stock")->find( { stock_id => $other_stock_id });
1310         $row->delete();
1311         $other_stock_deleted = 'YES';
1312     }
1313
1314
1315     print STDERR "Done with merge of stock_id $other_stock_id into ".$self->stock_id()."\n";
1316     print STDERR "Relationships moved: \n";
1317     print STDERR <<COUNTS;
1318     Stock props: $stockprop_count
1319     Subject rels: $subject_rel_count
1320     Object rels: $object_rel_count
1321     Alleles: $stock_allele_count
1322     Images: $image_count
1323     Experiments: $experiment_stock_count
1324     Dbxrefs: $stock_dbxref_count
1325     Stock owners: $stock_owner_count
1326     Map parents: $parent_1_count
1327     Map parents: $parent_2_count
1328     Other stock deleted: $other_stock_deleted.
1329 COUNTS
1330
1331 }
1332
1333 __PACKAGE__->meta->make_immutable;
1334
1335 ##########
1336 1;########
1337 ##########