lib/CXGN/Chado/Stock.pm

   1 =head1 NAME
   2
   3 CXGN::Chado::Stock - a second-level DBIC Bio::Chado::Schema::Stock::Stock object
   4
   5 Version:1.0
   6
   7 =head1 DESCRIPTION
   8
   9 Created to work with  CXGN::Page::Form::AjaxFormPage
  10 for eliminating the need to refactor the  AjaxFormPage and Editable  to work with DBIC objects.
  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
  17 =cut
  18
  19 package CXGN::Chado::Stock ;
  20 use strict;
  21 use warnings;
  22 use Carp;
  23 use Bio::Chado::Schema;
  24 use CXGN::Metadata::Schema;
  25
  26 use base qw / CXGN::DB::Object / ;
  27
  28 =head2 new
  29
  30   Usage: my $stock = CXGN::Chado::Stock->new($schema, $stock_id);
  31   Desc:
  32   Ret: a CXGN::Chado::Stock object
  33   Args: a $schema a schema object,
  34         $stock_id, if omitted, an empty stock object is created.
  35   Side_Effects: accesses the database, check if exists the database columns that this object use. die if the id is not an integer.
  36
  37 =cut
  38
  39 sub new {
  40     my $class = shift;
  41     my $schema = shift;
  42     my $id = shift;
  43
  44      ### First, bless the class to create the object and set the schema into the object.
  45     #my $self = $class->SUPER::new($schema);
  46     my $self = bless {}, $class;
  47     $self->set_schema($schema);
  48     my $stock;
  49     if (defined $id) {
  50         $stock = $self->get_resultset('Stock::Stock')->find({ stock_id => $id });
  51     } else {
  52         ### Create an empty resultset object;
  53         $stock = $self->get_resultset('Stock::Stock')->new( {} );
  54     }
  55     ###It's important to set the object row for using the accesor in other class functions
  56     $self->set_object_row($stock);
  57     return $self;
  58 }
  59
  60
  61
  62 =head2 store
  63
  64  Usage: $self->store
  65  Desc:  store a new stock
  66  Ret:   a database id
  67  Args:  none
  68  Side Effects: checks if the stock exists in the database, and if does, will attempt to update
  69  Example:
  70
  71 =cut
  72
  73 sub store {
  74     my $self=shift;
  75     my $id = $self->get_stock_id();
  76     my $schema=$self->get_schema();
  77     #no stock id . Check first if the name  exists in te database
  78     if (!$id) {
  79         my $exists= $self->exists_in_database();
  80         if (!$exists) {
  81             my $new_row = $self->get_object_row();
  82             $new_row->insert();
  83
  84             $id=$new_row->stock_id();
  85         }else {
  86             my $existing_stock=$self->get_resultset('Stock::Stock')->find($exists);
  87             #don't update here if stock already exist. User should call from the code exist_in_database
  88             #and instantiate a new stock object with the database id
  89             #updating here is not a good idea, since it might not be what the user intended to do
  90             #and it can mess up the database.
  91         }
  92     }else { # id exists
  93         $self->get_object_row()->update();
  94     }
  95     return $id
  96 }
  97
  98 ########################
  99
 100
 101 =head2 exists_in_database
 102
 103  Usage: $self->exists_in_database()
 104  Desc:  check if the uniquename exists in the stock table
 105  Ret:
 106  Args:
 107  Side Effects:
 108  Example:
 109
 110 =cut
 111
 112 sub exists_in_database {
 113     my $self=shift;
 114     my $stock_id = $self->get_stock_id();
 115     my $uniquename = $self->get_uniquename || '' ;
 116     my ($s) = $self->get_resultset('Stock::Stock')->search(
 117         {
 118             uniquename  => { 'ilike' => $uniquename },
 119         });
 120     #loading new stock - $stock_id is undef
 121     if (defined($s) && !$stock_id ) {  return $s->stock_id ; }
 122
 123     #updating an existing stock
 124     elsif ($stock_id && defined($s) ) {
 125         if ( ($s->stock_id == $stock_id) ) {
 126             return 0;
 127             #trying to update the uniquename
 128         } elsif ( $s->stock_id != $stock_id ) {
 129             return " Can't update an existing stock $stock_id uniquename:$uniquename.";
 130             # if the new name we're trying to update/insert does not exist in the stock table..
 131         } elsif ($stock_id && !$s->stock_id) {
 132             return 0;
 133         }
 134     }
 135     return undef;
 136 }
 137
 138 =head2 get_organism
 139
 140  Usage: $self->get_organism
 141  Desc:  find the organism object of this stock
 142  Ret:   L<Bio::Chado::Schema::Organism::Organism> object
 143  Args:  none
 144  Side Effects: none
 145  Example:
 146
 147 =cut
 148
 149 sub get_organism {
 150     my $self = shift;
 151     if (my $bcs_stock = $self->get_object_row) {
 152         return $bcs_stock->organism;
 153     }
 154     return undef;
 155 }
 156
 157
 158 =head2 get_species
 159
 160  Usage: $self->get_species
 161  Desc:  find the species name of this stock , if one exists
 162  Ret:   string
 163  Args:  none
 164  Side Effects: none
 165  Example:
 166
 167 =cut
 168
 169 sub get_species {
 170     my $self = shift;
 171     my $organism = $self->get_organism;
 172     if ($organism) {
 173         return $organism->species;
 174     }else { return undef; }
 175 }
 176
 177 =head2 set_species
 178
 179 Usage: $self->set_species
 180  Desc:  set organism_id for the stock using organism.species name
 181  Ret:   nothing
 182  Args:  species name (case insensitive)
 183  Side Effects: sets the organism_id for the stock
 184  Example:
 185
 186 =cut
 187
 188 sub set_species {
 189     my $self = shift;
 190     my $species_name = shift; # this has to be EXACTLY as stored in the organism table
 191     my $organism = $self->get_schema->resultset('Organism::Organism')->search(
 192         { 'lower(species)' => { like =>  lc($species_name) } } )->single ; #should be 1 result
 193     if ($organism) {
 194         $self->get_object_row->set_column(organism_id => $organism->organism_id );
 195     }
 196     else {
 197         warn "NO organism found for species name $species_name!!\n";
 198     }
 199 }
 200
 201 =head2 get_type
 202
 203  Usage: $self->get_type
 204  Desc:  find the cvterm type of this stock
 205  Ret:   L<Bio::Chado::Schema::Cv::Cvterm> object
 206  Args:   none
 207  Side Effects: none
 208  Example:
 209
 210 =cut
 211
 212 sub get_type {
 213     my $self = shift;
 214
 215     if (my $bcs_stock = $self->get_object_row ) {
 216         return  $bcs_stock->type;
 217     }
 218     return undef;
 219
 220 }
 221
 222
 223
 224 sub get_object_row {
 225     my $self = shift;
 226     return $self->{object_row};
 227 }
 228
 229 sub set_object_row {
 230   my $self = shift;
 231   $self->{object_row} = shift;
 232 }
 233
 234 =head2 get_resultset
 235
 236  Usage: $self->get_resultset(ModuleName::TableName)
 237  Desc:  Get a ResultSet object for source_name
 238  Ret:   a ResultSet object
 239  Args:  a source name
 240  Side Effects: none
 241  Example:
 242
 243 =cut
 244
 245 sub get_resultset {
 246     my $self=shift;
 247     my $source = shift;
 248     return $self->get_schema()->resultset("$source");
 249 }
 250
 251 =head2 accessors get_schema, set_schema
 252
 253  Usage:
 254  Desc:
 255  Property
 256  Side Effects:
 257  Example:
 258
 259 =cut
 260
 261 sub get_schema {
 262   my $self = shift;
 263   return $self->{schema};
 264 }
 265
 266 sub set_schema {
 267   my $self = shift;
 268   $self->{schema} = shift;
 269 }
 270
 271
 272 ###mapping accessors to DBIC
 273
 274 =head2 accessors get_name, set_name
 275
 276  Usage:
 277  Desc:
 278  Property
 279  Side Effects:
 280  Example:
 281
 282 =cut
 283
 284 sub get_name {
 285     my $self = shift;
 286     return $self->get_object_row()->get_column("name");
 287 }
 288
 289 sub set_name {
 290     my $self = shift;
 291     $self->get_object_row()->set_column(name => shift);
 292 }
 293
 294 =head2 accessors get_uniquename, set_uniquename
 295
 296  Usage:
 297  Desc:
 298  Property
 299  Side Effects:
 300  Example:
 301
 302 =cut
 303
 304 sub get_uniquename {
 305     my $self = shift;
 306     return $self->get_object_row()->get_column("uniquename");
 307 }
 308
 309 sub set_uniquename {
 310     my $self = shift;
 311     $self->get_object_row()->set_column(uniquename => shift);
 312 }
 313
 314 =head2 accessors get_organism_id, set_organism_id
 315
 316  Usage:
 317  Desc:
 318  Property
 319  Side Effects:
 320  Example:
 321
 322 =cut
 323
 324 sub get_organism_id {
 325     my $self = shift;
 326     if (my $bcs_stock =  $self->get_object_row ) {
 327         return $bcs_stock->get_column("organism_id");
 328     }
 329     return undef;
 330 }
 331
 332 sub set_organism_id {
 333     my $self = shift;
 334     $self->get_object_row()->set_column(organism_id => shift);
 335 }
 336
 337 =head2 accessors get_type_id, set_type_id
 338
 339  Usage:
 340  Desc:
 341  Property
 342  Side Effects:
 343  Example:
 344
 345 =cut
 346
 347 sub get_type_id {
 348     my $self = shift;
 349     if (my $bcs_stock = $self->get_object_row ) {
 350         return $bcs_stock->get_column("type_id");
 351     }
 352 }
 353
 354 sub set_type_id {
 355     my $self = shift;
 356     $self->get_object_row()->set_column(type_id => shift);
 357 }
 358
 359 =head2 accessors get_description, set_description
 360
 361  Usage:
 362  Desc:
 363  Property
 364  Side Effects:
 365  Example:
 366
 367 =cut
 368
 369 sub get_description {
 370     my $self = shift;
 371     return $self->get_object_row()->get_column("description");
 372 }
 373
 374 sub set_description {
 375     my $self = shift;
 376     $self->get_object_row()->set_column(description => shift);
 377 }
 378
 379 =head2 accessors get_stock_id, set_stock_id
 380
 381  Usage:
 382  Desc:
 383  Property
 384  Side Effects:
 385  Example:
 386
 387 =cut
 388
 389 sub get_stock_id {
 390     my $self = shift;
 391     if ( my $bcs_stock = $self->get_object_row ) {
 392         return $bcs_stock->get_column("stock_id");
 393     }
 394     return undef;
 395 }
 396
 397 sub set_stock_id {
 398     my $self = shift;
 399     $self->get_object_row()->set_column(stock_id => shift);
 400 }
 401
 402 =head2 accessors get_is_obsolete, set_is_obsolete
 403
 404  Usage:
 405  Desc:
 406  Property
 407  Side Effects:
 408  Example:
 409
 410 =cut
 411
 412 sub get_is_obsolete {
 413     my $self = shift;
 414     my $stock = $self->get_object_row();
 415     return $stock->get_column("is_obsolete") if $stock;
 416 }
 417
 418 sub set_is_obsolete {
 419     my $self = shift;
 420     $self->get_object_row()->set_column(is_obsolete => shift);
 421 }
 422
 423 =head2 function get_image_ids
 424
 425   Synopsis:     my @images = $self->get_image_ids()
 426   Arguments:    none
 427   Returns:      a list of image ids
 428   Side effects: none
 429   Description:  a method for fetching all images associated with a stock
 430
 431 =cut
 432
 433 sub get_image_ids {
 434     my $self = shift;
 435     my $ids = $self->get_schema->storage->dbh->selectcol_arrayref
 436         ( "SELECT image_id FROM phenome.stock_image WHERE stock_id=? ",
 437           undef,
 438           $self->get_stock_id
 439         );
 440     return @$ids;
 441 }
 442
 443 =head2 associate_allele
 444
 445  Usage: $self->associate_allele($allele_id, $sp_person_id)
 446  Desc:  store a stock-allele link in phenome.stock_allele
 447  Ret:   a database id
 448  Args:  allele_id, sp_person_id
 449  Side Effects:  store a metadata row
 450  Example:
 451
 452 =cut
 453
 454 sub associate_allele {
 455     my $self = shift;
 456     my $allele_id = shift;
 457     my $sp_person_id = shift;
 458     if (!$allele_id || !$sp_person_id) {
 459         warn "Need both allele_id and person_id for linking the stock with an allele!";
 460         return
 461     }
 462     my $metadata_id = $self->_new_metadata_id($sp_person_id);
 463     #check if the allele is already linked
 464     my $ids =  $self->get_schema->storage->dbh->selectcol_arrayref
 465         ( "SELECT stock_allele_id FROM phenome.stock_allele WHERE stock_id = ? AND allele_id = ?",
 466           undef,
 467           $self->get_stock_id,
 468           $allele_id
 469         );
 470     if ($ids) { warn "Allele $allele_id is already linked with stock " . $self->get_stock_id ; }
 471 #store the allele_id - stock_id link
 472     my $q = "INSERT INTO phenome.stock_allele (stock_id, allele_id, metadata_id) VALUES (?,?,?) RETURNING stock_allele_id";
 473     my $sth  = $self->get_schema->storage->dbh->prepare($q);
 474     $sth->execute($self->get_stock_id, $allele_id, $metadata_id);
 475     my ($id) =  $sth->fetchrow_array;
 476     return $id;
 477 }
 478
 479 =head2 associate_owner
 480
 481  Usage: $self->associate_owner($owner_sp_person_id, $sp_person_id)
 482  Desc:  store a stock-owner link in phenome.stock_owner
 483  Ret:   a database id
 484  Args:  owner_id, sp_person_id
 485  Side Effects:  store a metadata row
 486  Example:
 487
 488 =cut
 489
 490 sub associate_owner {
 491     my $self = shift;
 492     my $owner_id = shift;
 493     my $sp_person_id = shift;
 494     if (!$owner_id || !$sp_person_id) {
 495         warn "Need both owner_id and person_id for linking the stock with an owner!";
 496         return
 497     }
 498     my $metadata_id = $self->_new_metadata_id($sp_person_id);
 499     #check if the owner is already linked
 500     my $ids =  $self->get_schema->storage->dbh->selectcol_arrayref
 501         ( "SELECT stock_owner_id FROM phenome.stock_owner WHERE stock_id = ? AND owner_id = ?",
 502           undef,
 503           $self->get_stock_id,
 504           $owner_id
 505         );
 506     if ($ids) { warn "Owner $owner_id is already linked with stock " . $self->get_stock_id ; }
 507 #store the owner_id - stock_id link
 508     my $q = "INSERT INTO phenome.stock_owner (stock_id, owner_id, metadata_id) VALUES (?,?,?) RETURNING stock_owner_id";
 509     my $sth  = $self->get_schema->storage->dbh->prepare($q);
 510     $sth->execute($self->get_stock_id, $owner_id, $metadata_id);
 511     my ($id) =  $sth->fetchrow_array;
 512     return $id;
 513 }
 514
 515 =head2 get_trait_list
 516
 517  Usage:
 518  Desc:         gets the list of traits that have been measured
 519                on this stock
 520  Ret:          a list of lists  ( [ cvterm_id, cvterm_name] , ...)
 521  Args:
 522  Side Effects:
 523  Example:
 524
 525 =cut
 526
 527 sub get_trait_list {
 528     my $self = shift;
 529
 530     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=? group by cvterm.cvterm_id, db.name || ':' || dbxref.accession, cvterm.name";
 531     my $h = $self->get_schema()->storage->dbh()->prepare($q);
 532     $h->execute($self->get_stock_id());
 533     my @traits;
 534     while (my ($cvterm_id, $cvterm_accession, $cvterm_name, $avg, $stddev) = $h->fetchrow_array()) {
 535         push @traits, [ $cvterm_id, $cvterm_accession, $cvterm_name, $avg, $stddev ];
 536     }
 537
 538     # get directly associated traits
 539     #
 540     $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=? group by cvterm.cvterm_id, db.name || ':' || dbxref.accession, cvterm.name";
 541     $h = $self->get_schema()->storage()->dbh()->prepare($q);
 542     $h->execute($self->get_stock_id());
 543     while (my ($cvterm_id, $cvterm_accession, $cvterm_name, $avg, $stddev) = $h->fetchrow_array()) {
 544         push @traits, [ $cvterm_id, $cvterm_accession, $cvterm_name, $avg, $stddev ];
 545     }
 546
 547     return @traits;
 548
 549 }
 550
 551 =head2 get_trials
 552
 553  Usage:
 554  Desc:          gets the list of trails this stock was used in
 555  Ret:
 556  Args:
 557  Side Effects:
 558  Example:
 559
 560 =cut
 561
 562 sub get_trials {
 563     my $self = shift;
 564     my $q = "select distinct(project.project_id), project.name, nd_geolocation_id, nd_geolocation.description 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) JOIN cvterm AS geolocation_type ON (projectprop.type_id=geolocation_type.cvterm_id) LEFT JOIN nd_geolocation ON (projectprop.value::INT = nd_geolocation_id) where accession.stock_id=? AND (geolocation_type.name='project location' OR geolocation_type.name IS NULL) ";
 565     my $h = $self->get_schema()->storage()->dbh()->prepare($q);
 566     $h->execute($self->get_stock_id());
 567     my @trials;
 568     while (my ($project_id, $project_name, $nd_geolocation_id, $nd_geolocation) = $h->fetchrow_array()) {
 569         push @trials, [ $project_id, $project_name, $nd_geolocation_id, $nd_geolocation ];
 570     }
 571
 572     return @trials;
 573 }
 574
 575
 576
 577
 578 =head2 _new_metadata_id
 579
 580 Usage: my $md_id = $self->_new_metatada_id($sp_person_id)
 581 Desc:  Store a new md_metadata row with a $sp_person_id
 582 Ret:   a database id
 583 Args:  sp_person_id
 584
 585 =cut
 586
 587 sub _new_metadata_id {
 588     my $self = shift;
 589     my $sp_person_id = shift;
 590     my $metadata_schema = CXGN::Metadata::Schema->connect(
 591         sub { $self->get_schema->storage->dbh },
 592         );
 593     my $metadata = CXGN::Metadata::Metadbdata->new($metadata_schema);
 594     $metadata->set_create_person_id($sp_person_id);
 595     my $metadata_id = $metadata->store()->get_metadata_id();
 596     return $metadata_id;
 597 }
 598
 599 sub merge {
 600     my $self = shift;
 601     my $other_stock_id = shift;
 602
 603     if ($other_stock_id == $self->get_stock_id()) {
 604         print STDERR "Trying to merge stock into itself ($other_stock_id) Skipping...\n";
 605         return;
 606     }
 607
 608
 609     my $stockprop_count;
 610     my $subject_rel_count;
 611     my $object_rel_count;
 612     my $stock_allele_count;
 613     my $image_count;
 614     my $experiment_stock_count;
 615     my $stock_dbxref_count;
 616     my $stock_owner_count;
 617     my $parent_1_count;
 618     my $parent_2_count;
 619
 620     my $schema = $self->get_schema();
 621
 622     # move stockprops
 623     #
 624     my $sprs = $schema->resultset("Stock::Stockprop")->search( { stock_id => $other_stock_id });
 625     while (my $row = $sprs->next()) {
 626
 627         # check if this stockprop already exists for this stock; save only if not
 628         #
 629         my $thissprs = $schema->resultset("Stock::Stockprop")->search(
 630             {
 631                 stock_id => $self->get_stock_id(),
 632                 type_id => $row->type_id(),
 633                 value => $row->value()
 634             });
 635
 636         if ($thissprs->count() == 0) {
 637             my $value = $row->value();
 638             my $type_id = $row->type_id();
 639
 640             my $rank_rs = $schema->resultset("Stock::Stockprop")->search( { stock_id => $self->get_stock_id(), type_id => $type_id });
 641
 642             my $rank;
 643             if ($rank_rs->count() > 0) {
 644                 $rank = $rank_rs->rank->max();
 645             }
 646
 647             $rank++;
 648             $row->rank($rank);
 649             $row->stock_id($self->get_stock_id());
 650
 651             $row->update();
 652
 653             print STDERR "MERGED stockprop_id ".$row->stockprop_id." for stock $other_stock_id type_id $type_id value $value into stock ".$self->get_stock_id()."\n";
 654             $stockprop_count++;
 655         }
 656     }
 657
 658     # move subject relationships
 659     #
 660     my $ssrs = $schema->resultset("Stock::StockRelationship")->search( { subject_id => $other_stock_id });
 661
 662     while (my $row = $ssrs->next()) {
 663
 664         my $this_subject_rel_rs = $schema->resultset("Stock::StockRelationship")->search( { subject_id => $self->get_stock_id(), object_id => $row->object_id, type_id => $row->type_id() });
 665
 666         if ($this_subject_rel_rs->count() == 0) { # this stock does not have the relationship
 667             # get the max rank
 668             my $rank_rs = $schema->resultset("Stock::StockRelationship")->search( { subject_id => $self->get_stock_id(), type_id => $row->type_id() });
 669             my $rank = 0;
 670             if ($rank_rs->count() > 0) {
 671                 $rank = $rank_rs->rank()->max();
 672             }
 673             $rank++;
 674             $row->rank($rank);
 675             $row->subject_id($self->get_stock_id());
 676             $row->update();
 677             print STDERR "Moving subject relationships from stock $other_stock_id to stock ".$self->get_stock_id()."\n";
 678             $subject_rel_count++;
 679         }
 680     }
 681
 682     # move object relationships
 683     #
 684     my $osrs = $schema->resultset("Stock::StockRelationship")->search( { object_id => $other_stock_id });
 685     while (my $row = $osrs->next()) {
 686         my $this_object_rel_rs = $schema->resultset("Stock::StockRelationship")->search( { object_id => $self->get_stock_id, subject_id => $row->subject_id(), type_id => $row->type_id() });
 687
 688         if ($this_object_rel_rs->count() == 0) {
 689             my $rank_rs = $schema->resultset("Stock::StockRelationship")->search( { object_id => $self->get_stock_id(), type_id => $row->type_id() });
 690             my $rank = 0;
 691             if ($rank_rs->count() > 0) {
 692                 $rank = $rank_rs->get_column("rank")->max();
 693             }
 694             $rank++;
 695             $row->rank($rank);
 696             $row->object_id($self->get_stock_id());
 697             $row->update();
 698             print STDERR "Moving object relationships from stock $other_stock_id to stock ".$self->get_stock_id()."\n";
 699             $object_rel_count++;
 700         }
 701     }
 702
 703     # move experiment_stock
 704     #
 705     my $esrs = $schema->resultset("NaturalDiversity::NdExperimentStock")->search( { stock_id => $other_stock_id });
 706     while (my $row = $esrs->next()) {
 707         $row->stock_id($self->get_stock_id());
 708         $row->update();
 709         print STDERR "Moving experiments for stock $other_stock_id to stock ".$self->get_stock_id()."\n";
 710         $experiment_stock_count++;
 711     }
 712
 713     # move stock_cvterm relationships
 714     #
 715
 716
 717     # move stock_dbxref
 718     #
 719     my $sdrs = $schema->resultset("Stock::StockDbxref")->search( { stock_id => $other_stock_id });
 720     while (my $row = $sdrs->next()) {
 721         $row->stock_id($self->get_stock_id());
 722         $row->update();
 723         $stock_dbxref_count++;
 724     }
 725
 726     # move sgn.pcr_exp_accession relationships
 727     #
 728
 729
 730     # move sgn.pcr_experiment relationships
 731     #
 732
 733
 734
 735     # move stock_genotype relationships
 736     #
 737
 738
 739     my $phenome_schema = CXGN::Phenome::Schema->connect(
 740         sub { $self->get_schema->storage->dbh() }, { on_connect_do => [ 'SET search_path TO phenome, public, sgn'] }
 741         );
 742
 743     # move phenome.stock_allele relationships
 744     #
 745     my $sars = $phenome_schema->resultset("StockAllele")->search( { stock_id => $other_stock_id });
 746     while (my $row = $sars->next()) {
 747         $row->stock_id($self->get_stock_id());
 748         $row->udate();
 749         print STDERR "Moving stock alleles from stock $other_stock_id to stock ".$self->get_stock_id()."\n";
 750         $stock_allele_count++;
 751     }
 752
 753 # move image relationships
 754     #
 755
 756     my $irs = $phenome_schema->resultset("StockImage")->search( { stock_id => $other_stock_id });
 757     while (my $row = $irs->next()) {
 758
 759         my $this_rs = $phenome_schema->resultset("StockImage")->search( { stock_id => $self->get_stock_id(), image_id => $row->image_id() } );
 760         if ($this_rs->count() == 0) {
 761             $row->stock_id($self->get_stock_id());
 762             $row->update();
 763             print STDERR "Moving image ".$row->image_id()." from stock $other_stock_id to stock ".$self->get_stock_id()."\n";
 764             $image_count++;
 765         }
 766         else {
 767             print STDERR "Removing stock_image entry...\n";
 768             $row->delete(); # there is no cascade delete on image relationships, so we need to remove dangling relationships.
 769         }
 770     }
 771
 772     # move stock owners
 773     #
 774     my $sors = $phenome_schema->resultset("StockOwner")->search( { stock_id => $other_stock_id });
 775     while (my $row = $sors->next()) {
 776
 777         my $this_rs = $phenome_schema->resultset("StockOwner")->search( { stock_id => $self->get_stock_id(), sp_person_id => $row->sp_person_id() });
 778         if ($this_rs->count() == 0) {
 779             $row->stock_id($self->get_stock_id());
 780             $row->update();
 781             print STDERR "Moved stock_owner ".$row->sp_person_id()." of stock $other_stock_id to stock ".$self->get_stock_id()."\n";
 782             $stock_owner_count++;
 783         }
 784         else {
 785             print STDERR "(Deleting stock owner entry for stock $other_stock_id, owner ".$row->sp_person_id()."\n";
 786             $row->delete(); # see comment for move image relationships
 787         }
 788     }
 789
 790     # move map parents
 791     #
 792     my $sgn_schema = SGN::Schema->connect(
 793         sub { $self->get_schema->storage->dbh() },
 794         );
 795
 796     my $mrs1 = $sgn_schema->resultset("Map")->search( { parent_1 => $other_stock_id });
 797     while (my $row = $mrs1->next()) {
 798         $row->parent_1($self->get_stock_id());
 799         $row->update();
 800         print STDERR "Move map parent_1 $other_stock_id to ".$self->get_stock_id()."\n";
 801         $parent_1_count++;
 802     }
 803
 804     my $mrs2 = $sgn_schema->resultset("Map")->search( { parent_2 => $other_stock_id });
 805     while (my $row = $mrs2->next()) {
 806         $row->parent_2($self->get_stock_id());
 807         $row->update();
 808         print STDERR "Move map parent_2 $other_stock_id to ".$self->get_stock_id()."\n";
 809         $parent_2_count++;
 810     }
 811
 812     print STDERR "Done with merge of stock_id $other_stock_id into ".$self->get_stock_id()."\n";
 813     print STDERR "Relationships moved: \n";
 814     print STDERR <<COUNTS;
 815     Stock props: $stockprop_count
 816     Subject rels: $subject_rel_count
 817     Object rels: $object_rel_count
 818     Alleles: $stock_allele_count
 819     Images: $image_count
 820     Experiments: $experiment_stock_count
 821     Dbxrefs: $stock_dbxref_count
 822     Stock owners: $stock_owner_count
 823     Map parents: $parent_1_count
 824     Map parents: $parent_2_count
 825 COUNTS
 826
 827 }
 828
 829 ##########
 830 1;########
 831 ##########