lib/CXGN/Phenome/Locus.pm

   1 package CXGN::Phenome::Locus;
   2
   3 =head1 NAME
   4
   5 CXGN::Phenome::Locus
   6
   7 SGN Locus object
   8
   9
  10 =head1 SYNOPSIS
  11
  12 Access the phenome.locus table, find, add, and delete associated data
  13 (images, alleles, dbxrefs, owners, cvterms, publications, etc.)
  14
  15 =head1 AUTHOR
  16
  17 Naama Menda <nm249@cornell.edu>
  18
  19 =cut
  20
  21 use strict;
  22 use warnings;
  23
  24 use CXGN::Phenome::Allele;
  25 use CXGN::Phenome::LocusSynonym;
  26 use CXGN::Phenome::LocusMarker;
  27 use CXGN::Phenome::Locus::LocusHistory;
  28
  29 use CXGN::Phenome::LocusDbxref;
  30 use CXGN::Phenome::Locus::LocusRanking;
  31 use CXGN::Transcript::Unigene;
  32 use CXGN::Phenome::Schema;
  33 use CXGN::Phenome::LocusGroup;
  34 use CXGN::DB::Object;
  35 use CXGN::Chado::Dbxref;
  36 use CXGN::Image;
  37 use Bio::Chado::Schema;
  38
  39 use base qw /  CXGN::DB::ModifiableI CXGN::Phenome::Locus::LocusRanking /;
  40
  41 =head2 new
  42
  43  Usage: my $gene = CXGN::Phenome::Locus->new($dbh,$locus_id);
  44  Desc:
  45  Ret:
  46  Args: $gene_id
  47  Side Effects:
  48  Example:
  49
  50 =cut
  51
  52 sub new {
  53     my $class = shift;
  54     my $dbh = shift;
  55     my $id= shift; # the primary key in the databaes of this object
  56
  57     unless( $dbh->can('selectall_arrayref') ) {
  58         die "First argument to CXGN::Phenome::Locus constructor needs to be a database handle.";
  59     }
  60     my $self=$class->SUPER::new($dbh);
  61
  62     $self->set_locus_id($id);
  63
  64     if ($id) {
  65         $self->fetch($id); #get the locus details
  66
  67         #associated markers
  68         my $locus_marker_query=$self->get_dbh()->prepare(
  69             "SELECT distinct locus_marker_id from phenome.locus_marker
  70             JOIN sgn.marker_alias USING (marker_id)
  71             JOIN sgn.marker_experiment USING (marker_id)
  72             JOIN sgn.marker_location USING (location_id)
  73             JOIN sgn.map_version USING (map_version_id)
  74             WHERE current_version = 't' AND locus_id=?");
  75         my @locus_marker;
  76         $locus_marker_query->execute($id);
  77         while (my ($lm) = $locus_marker_query->fetchrow_array() ) {
  78             push @locus_marker, $lm;
  79         }
  80         for my $lm_id (@locus_marker) {
  81
  82             my $locus_marker_obj = CXGN::Phenome::LocusMarker->new($dbh, $lm_id);
  83             $self->add_locus_marker($locus_marker_obj);
  84         }
  85         #dbxrefs
  86         my @dbxrefs= $self->get_dbxrefs();
  87         foreach my $d(@dbxrefs) { $self->add_dbxref(); }
  88     }
  89     return $self;
  90 }
  91
  92 =head2 new_with_symbol_and_species
  93
  94  Usage: CXGN::Phenome::Locus->new_with_symbol_and_species($dbh, $symbol,$species)
  95  Desc:  instanciate a new locus object using a symbol and a common_name
  96  Ret:  a locus object
  97  Args: dbh, symbol, and common_name
  98  Side Effects:
  99  Example:
 100
 101 =cut
 102
 103 sub new_with_symbol_and_species {
 104     my $class = shift;
 105     my $dbh = shift;
 106     my $symbol = shift;
 107     my $species = shift;
 108     my $query = "SELECT locus_id FROM phenome.locus JOIN sgn.common_name using(common_name_id) WHERE locus_symbol=? AND common_name ilike ?";
 109     my $sth = $dbh->prepare($query);
 110     $sth->execute($symbol, $species);
 111     my ($id) = $sth->fetchrow_array();
 112     return $class->new($dbh, $id);
 113 }
 114
 115 =head2 new_with_locusname
 116
 117  Usage: CXGN::Phenome::Locus->new_locusname($dbh, $genome_locus_name)
 118  Desc:  instanciate a new locus object using  the locus field
 119  Ret:  a locus object
 120  Args: dbh, locus genome identifier (e.g. Solyc01g0000010)
 121  Side Effects:
 122  Example:
 123 =cut
 124
 125 sub new_with_locusname {
 126     my $class = shift;
 127     my $dbh = shift;
 128     my $locusname = shift;
 129     my $query = "SELECT locus_id FROM phenome.locus WHERE locus ilike ? and obsolete = ? ";
 130     my $sth = $dbh->prepare($query);
 131     $sth->execute($locusname, 'f');
 132     my ($id) = $sth->fetchrow_array();
 133     return $class->new($dbh, $id);
 134 }
 135
 136
 137
 138
 139 =head2 get_locus_ids_by_editor
 140
 141  Usage:        my @loci = CXGN::Phenome::Locus::get_loci_by_editor($dbh, 239)
 142  Desc:         returns a list of locus ids that belong to the given
 143                editor. Class function.
 144  Args:         a database handle and a sp_person_id of the editor
 145  Side Effects: accesses the database
 146  Example:
 147
 148 =cut
 149
 150 sub get_locus_ids_by_editor {
 151     my $dbh = shift;
 152     my $sp_person_id = shift;
 153     my $query = "SELECT locus_id FROM phenome.locus JOIN phenome.locus_owner USING(locus_id)
 154                   WHERE locus_owner.sp_person_id=? AND locus.obsolete = 'f' ORDER BY locus.modified_date desc, locus.create_date desc";
 155     my $sth = $dbh->prepare($query);
 156     $sth->execute($sp_person_id);
 157     my @loci = ();
 158     while (my($locus_id) = $sth->fetchrow_array()) {
 159         push @loci, $locus_id;
 160     }
 161     return @loci;
 162 }
 163
 164
 165 =head2 get_locus_ids_by_annotator
 166
 167  Usage: my @loci=CXGN::Phenome::Locus::get_loci_by_annotator($dbh, $sp_person_id)
 168  Desc:         returns a list of locus ids that belong to the given
 169                contributing annotator. Class function.
 170  Args:         a database handle and a sp_person_id of the submitter
 171  Side Effects: accesses the database
 172  Example:
 173
 174 =cut
 175
 176 sub get_locus_ids_by_annotator {
 177     my $dbh = shift;
 178     my $sp_person_id = shift;
 179
 180     my $query= "SELECT  distinct locus.locus_id, locus.modified_date FROM phenome.locus
 181                            LEFT JOIN phenome.locus_dbxref USING (locus_id)
 182                            LEFT JOIN phenome.locus_unigene using (locus_id)
 183                            LEFT JOIN phenome.locus_marker using (locus_id)
 184                            LEFT JOIN phenome.locus_alias using (locus_id)
 185                            LEFT JOIN phenome.locus2locus ON (phenome.locus.locus_id = locus2locus.subject_id
 186                            OR phenome.locus.locus_id = locus2locus.subject_id )
 187                             JOIN phenome.allele USING (locus_id)
 188                             LEFT JOIN phenome.individual_allele USING (allele_id)
 189                             LEFT JOIN phenome.individual USING (individual_id)
 190                             LEFT JOIN phenome.individual_image USING (individual_id)
 191                             LEFT JOIN metadata.md_image USING (image_id)
 192
 193                             WHERE locus.updated_by=? OR locus_dbxref.sp_person_id=? OR locus_unigene.sp_person_id=?
 194                             OR locus_marker.sp_person_id=? OR allele.sp_person_id=? OR locus_alias.sp_person_id=?
 195                             OR individual_allele.sp_person_id=? OR metadata.md_image.sp_person_id=? OR locus2locus.sp_person_id =?
 196                             ORDER BY locus.modified_date DESC";
 197
 198
 199     my $sth = $dbh->prepare($query);
 200     $sth->execute($sp_person_id, $sp_person_id, $sp_person_id, $sp_person_id, $sp_person_id, $sp_person_id, $sp_person_id, $sp_person_id, $sp_person_id);
 201     my @loci = ();
 202     while (my($locus_id, $modified_date) = $sth->fetchrow_array()) {
 203         push @loci, $locus_id;
 204     }
 205     return @loci;
 206 }
 207
 208
 209
 210 sub fetch {
 211     my $self=shift;
 212     my $dbh=$self->get_dbh();
 213     my $locus_query = "SELECT locus_id,locus,locus_name, locus_symbol, original_symbol, gene_activity, description,  locus.sp_person_id, locus.create_date, locus.modified_date, linkage_group, lg_arm, common_name, common_name_id,  updated_by, locus.obsolete
 214                     FROM phenome.locus
 215                     JOIN sgn.common_name USING(common_name_id)
 216                     WHERE locus_id=?";
 217     my $sth=$dbh->prepare($locus_query);
 218     $sth->execute($self->get_locus_id());
 219
 220     my ($locus_id,$genome_locus, $locus_name,$locus_symbol,$original_symbol, $gene_activity, $description, $sp_person_id, $create_date, $modified_date, $chromosome, $arm, $common_name, $common_name_id, $updated_by, $obsolete)=$sth->fetchrow_array();
 221     $self->set_locus_id($locus_id);
 222     $self->set_genome_locus($genome_locus);
 223     $self->set_locus_name($locus_name);
 224     $self->set_locus_symbol($locus_symbol);
 225     $self->set_original_symbol($original_symbol);
 226     $self->set_gene_activity($gene_activity);
 227     $self->set_description($description);
 228
 229     $self->set_sp_person_id($sp_person_id);
 230     $self->set_create_date($create_date);
 231     $self->set_modification_date($modified_date);
 232     $self->set_linkage_group($chromosome);
 233     $self->set_lg_arm($arm);
 234     $self->set_common_name($common_name);
 235     $self->set_common_name_id($common_name_id);
 236     $self->set_updated_by($updated_by);
 237     $self->set_obsolete($obsolete);
 238 }
 239
 240 =head2 exists_in_database
 241
 242  Usage: my $existing_locus_id = CXGN::Phenome::Locus::exists_in_database();
 243  Desc:  check if a locus symbol or name for a given organism exists in the database
 244  Ret:   an error message for the given symbol, name, and common_name_id
 245  Args:
 246  Side Effects: none
 247  Example:
 248
 249 =cut
 250
 251
 252 sub exists_in_database {
 253     my $self = shift;
 254     my $locus_name=shift;
 255     my $locus_symbol=shift;
 256
 257     my $locus_id= $self->get_locus_id();
 258     my $common_name_id= $self->get_common_name_id();
 259     if (!$locus_name) { $locus_name=$self->get_locus_name(); }
 260     if (!$locus_symbol) { $locus_symbol=$self->get_locus_symbol(); }
 261     $self->d("Locus.pm: exists_in _database--**$locus_name, $locus_symbol \n");
 262
 263     my $name_query = "SELECT locus_id, obsolete
 264                         FROM phenome.locus
 265                         WHERE locus_name ILIKE ? and common_name_id = ? ";
 266     my $name_sth = $self->get_dbh()->prepare($name_query);
 267     $name_sth->execute($locus_name, $common_name_id );
 268     my ($name_id, $name_obsolete)= $name_sth->fetchrow_array();
 269
 270     my $symbol_query = "SELECT locus_id, obsolete
 271                          FROM phenome.locus
 272                          WHERE locus_symbol ILIKE ? and common_name_id = ? ";
 273     my $symbol_sth = $self->get_dbh()->prepare($symbol_query);
 274     $symbol_sth->execute($locus_symbol, $common_name_id );
 275     my ($symbol_id, $symbol_obsolete)  = $symbol_sth->fetchrow_array();
 276
 277     #loading new locus- $locus_id is undef
 278     if (!$locus_id && ($name_id || $symbol_id) ) {
 279         my $message = 1;
 280         if($name_id){
 281             $message = "Existing name $name_id";
 282         }
 283         elsif($symbol_id){
 284             $message = "Existing symbol $symbol_id";
 285         }
 286         $self->d("***$message\n");
 287         return ( $message ) ;
 288     }
 289     #trying to update a locus.. if both the name and symbol remain- it's probably an update of
 290     #the other fields in the form
 291     if ($locus_id && $symbol_id) {
 292         if ( ($name_id==$locus_id) && ($symbol_id==$locus_id) ) {
 293             $self->d("--locus.pm exists_in_database returned 0.......\n");
 294             return 0;
 295             #trying to update the name and/or the symbol
 296         } elsif ( ($name_id!=$locus_id && $name_id) || ($symbol_id!=$locus_id && $symbol_id)) {
 297             my $message = " Can't update an existing locus $locus_id name:$name_id symbol:$symbol_id.";
 298             $self->d("++++Locus.pm exists_in_database:  $message\n");
 299             return ( $message );
 300             # if the new name or symbol we're trying to update/insert do not exist in the locus table..
 301         } else {
 302             $self->d("--locus.pm exists_in_database returned 0.......\n");
 303             return 0;
 304         }
 305     }
 306 }
 307
 308 sub store {
 309     my $self = shift;
 310
 311     #add another check here with a die/error message for loading scripts
 312     my $exists=  $self->exists_in_database();
 313     die "Locus exists in database! Cannot insert or update! \n $exists \n " if $exists;
 314     my $locus_id=$self->get_locus_id();
 315
 316     if ($locus_id) {
 317         $self->store_history();
 318
 319         my $query = "UPDATE phenome.locus SET
 320                        locus = ?,
 321                        locus_name = ?,
 322                        locus_symbol = ?,
 323                        original_symbol = ?,
 324                        gene_activity = ?,
 325                        description= ?,
 326                        linkage_group= ?,
 327                        lg_arm = ?,
 328                        updated_by = ?,
 329                        modified_date = now(),
 330                        obsolete=?
 331                        where locus_id= ?";
 332         my $sth= $self->get_dbh()->prepare($query);
 333         $sth->execute($self->get_genome_locus,$self->get_locus_name, $self->get_locus_symbol,  $self->get_original_symbol, $self->get_gene_activity, $self->get_description, $self->get_linkage_group(), $self->get_lg_arm(), $self->get_updated_by(), $self->get_obsolete(), $locus_id );
 334
 335         foreach my $dbxref ( @{$self->{locus_dbxrefs}} )   {
 336             my $locus_dbxref_obj= CXGN::Phenome::LocusDbxref->new($self->get_dbh());
 337             #$locus_dbxref_obj->store(); # what do I want to store here?
 338         }
 339         $self->d("Locus.pm store: Updated locus $locus_id ......+\n");
 340         #Update locus_alias 'preferred' field
 341         $self->update_locus_alias();
 342     }
 343     else {
 344         eval {
 345             my $query = "INSERT INTO phenome.locus (locus,locus_name, locus_symbol, original_symbol, gene_activity, description, linkage_group, lg_arm,  common_name_id, create_date) VALUES(?,?,?,?,?,?,?,?,?, now()) RETURNING locus_id";
 346             my $sth= $self->get_dbh()->prepare($query);
 347             $sth->execute($self->get_genome_locus, $self->get_locus_name, $self->get_locus_symbol, $self->get_original_symbol, $self->get_gene_activity, $self->get_description, $self->get_linkage_group(), $self->get_lg_arm(), $self->get_common_name_id);
 348
 349             ($locus_id) = $sth->fetchrow_array;
 350             $self->set_locus_id($locus_id);
 351
 352             my $locus_owner_query="INSERT INTO phenome.locus_owner (locus_id, sp_person_id) VALUES (?,?)";
 353             my $locus_owner_sth=$self->get_dbh()->prepare($locus_owner_query);
 354             $locus_owner_sth->execute($locus_id, $self->get_sp_person_id());
 355
 356             my $alias_query= "INSERT INTO phenome.locus_alias(locus_id, alias, preferred) VALUES (?, ?,'t')";
 357             my $alias_sth= $self->get_dbh()->prepare($alias_query);
 358             $alias_sth->execute($self->get_locus_id(), $self->get_locus_symbol());
 359
 360             #the following query will insert a 'dummy' default allele. Each locus must have a default allele.
 361             # This is important for associating individuals with loci. The locus_display code masks the dummy alleles.
 362             my $allele= CXGN::Phenome::Allele->new($self->get_dbh());
 363             $allele->set_locus_id($locus_id);
 364             $allele->set_allele_symbol( uc($self->get_locus_symbol) );
 365             $allele->set_is_default('t');
 366             $allele->store();
 367
 368             $self->d("***#####Locus.pm store: inserting new locus $locus_id....\n");
 369         };
 370     }
 371     if ($@) { warn "locus.pm store failed! \n $@ \n" }
 372     return $locus_id;
 373 }
 374
 375 =head2 delete
 376
 377  Usage: $self->delete()
 378  Desc:  set the locus to obsolete=t
 379  Ret:   nothing
 380  Args:  none
 381  Side Effects: sets locus name and symbol to 'ob$locus_id-$locus_name'
 382 obsoletes the associated alleles (see Allele.pm: delete() )
 383  Example:
 384 =cut
 385
 386 sub delete {
 387     my $self = shift;
 388     my ($symbol, $name);
 389     my $locus_id = $self->get_locus_id();
 390     $self->set_locus_symbol("ob". $self->get_locus_id() . "-" .$self->get_locus_symbol() );
 391     $self->set_locus_name("ob" . $self->get_locus_id() . "-" . $self->get_locus_name() );
 392     my $ob=$self->get_obsolete();
 393     if ($ob eq 'f' && $locus_id)  {
 394         $self->d("Locus.pm is obsoleting locus  " . $self->get_locus_id() . "(obsolete=$ob)!!!!\n");
 395         $self->set_obsolete('t');
 396         $self->store();
 397     }else {
 398         $self->d("trying to delete a locus that has not yet been stored to db.\n");
 399     }
 400 }
 401
 402 =head2 remove_allele
 403
 404  Usage:  $self->remove_allele($allele_id)
 405  Desc:   set an allele of this locus to obsolete
 406  Ret:    nothing
 407  Args: $allele_id
 408  Side Effects: updates the obsolete field in the allele table to 't'
 409  Example:
 410 =cut
 411
 412 sub remove_allele {
 413     my $self = shift;
 414     my $allele_id = shift;
 415     my $query = "UPDATE phenome.allele
 416                         SET obsolete= 't'
 417                         WHERE locus_id=? AND allele_id=?";
 418     my $sth = $self->get_dbh()->prepare($query);
 419     $sth->execute($self->get_locus_id(), $allele_id);
 420 }
 421
 422 =head2 remove_locus_alias
 423
 424  Usage: $self->remove_locus_alias($locus_alias_id)
 425  Desc:  delete a locus alias from the locus_alias table
 426  Ret:   nothing
 427  Args: $locus_alias_id
 428  Side Effects: deletes a row from the locus_alias table
 429  Example:
 430
 431
 432 =cut
 433 sub remove_locus_alias {
 434     my $self = shift;
 435     my $locus_synonym_id = shift;
 436     my $query = "DELETE FROM phenome.locus_alias WHERE locus_id=? AND locus_alias_id=?";
 437     my $sth = $self->get_dbh()->prepare($query);
 438     $sth->execute($self->get_locus_id(), $locus_synonym_id);
 439 }
 440
 441 =head2 update_locus_alias
 442
 443  Usage: $self->update_locus_alias()
 444  Desc:  after updating the locus synonym field, we need to make that synonym the
 445         'preferred' alias, and set the currently preferred one to 'f'
 446  Ret:   nothing
 447  Args:  none
 448  Side Effects: updating rows in the locus_alias table
 449  Example:
 450
 451 =cut
 452
 453 sub update_locus_alias {
 454     my $self=shift;
 455     my $symbol= $self->get_locus_symbol();
 456     my @aliases= $self->get_locus_aliases();
 457
 458     foreach my $a ( @aliases) {
 459         my $alias=$a->get_locus_alias();
 460         if ($alias eq $symbol) {
 461             $self->d("alias = $alias , symbol =$symbol, preferred=" . $a->get_preferred() . " Setting prefrred = 't'\n");
 462             $a->set_preferred('t');
 463             $a->store();
 464         }
 465         elsif ($a->get_preferred() ==1) {
 466             $self->d( "alias = $alias , symbol =$symbol, preferred=" . $a->get_preferred() . " Setting prefrred = 'f'\n");
 467             $a->set_preferred('f');
 468             $a->store();
 469         }
 470     }
 471 }
 472
 473
 474
 475 =head2 get_unigenes
 476
 477  Usage: $self->get_unigenes({full=>1, current=>1})
 478  Desc:  find unigenes associated with the locus
 479  Ret:   list of (lite) unigene objects (without the sequences- much faster)
 480  Args:  optional hashref with the following keys:
 481     full (1) - get a list of full unigene objects
 482         (much slower, but important if you want to access the sequences of the unigens)
 483     current(1) - fetch only current unigenes
 484  Side Effects: none
 485  Example:
 486
 487 =cut
 488
 489 sub get_unigenes {
 490     my $self=shift;
 491     my $opts = shift;
 492     my $full = $opts->{full};
 493     my $current = $opts->{current};
 494     my $query = "SELECT unigene_id FROM phenome.locus_unigene";
 495     $query .= " JOIN sgn.unigene USING (unigene_id) JOIN sgn.unigene_build USING (unigene_build_id) ";
 496     $query .= " WHERE locus_id=? AND obsolete = 'f' ";
 497     $query .= " AND status = 'C' " if $current;
 498
 499     my $sth = $self->get_dbh()->prepare($query);
 500     $sth->execute($self->get_locus_id());
 501     my $unigene;
 502     my @unigenes=();
 503     while (my ($unigene_id) = $sth->fetchrow_array()) {
 504         if ($full)  { $unigene = CXGN::Transcript::Unigene->new($self->get_dbh(), $unigene_id); }
 505         else { $unigene = CXGN::Transcript::Unigene->new_lite_unigene($self->get_dbh(), $unigene_id); }
 506         push @unigenes, $unigene;
 507     }
 508     return @unigenes;
 509 }
 510
 511 =head2 get_locus_unigene_id
 512
 513  Usage: my $locus_unigene_id= $locus->get_locus_unigene_id($unigene_id)
 514  Desc:  find the locus_unigene database id for a given unigene id
 515         useful for manipulating locus_unigene table (like obsoleting a locus-unigene association)
 516         since we do not have a LocusUnigene object (not sure an object is necessary if all is done from the Locus object)
 517
 518  Ret: a database id from the table phenome.locus_unigene
 519  Args: $unigene_id
 520  Side Effects:
 521  Example:
 522
 523 =cut
 524
 525 sub get_locus_unigene_id {
 526     my $self=shift;
 527     my $unigene_id=shift;
 528     my $query= "SELECT locus_unigene_id FROM phenome.locus_unigene
 529                 WHERE locus_id=? AND unigene_id=?";
 530     my $sth=$self->get_dbh()->prepare($query);
 531     $sth->execute($self->get_locus_id(), $unigene_id);
 532     my ($locus_unigene_id) = $sth->fetchrow_array();
 533     return $locus_unigene_id;
 534 }
 535
 536 =head2 add_unigene
 537
 538  Usage: $self->add_unigene($unigene_id, $sp_person_id)
 539  Desc:  store a unigene-locus association in the database. If the link exists the function will set obsolete=f
 540  Ret:   database id
 541  Args:  unigene_id, sp_person_id
 542  Side Effects: access the database. Adds a locus_dbxref for SolCyc reactions which are linked to $unigene_id
 543                (see table unigene_dbxref)
 544  Example:
 545
 546 =cut
 547
 548 sub add_unigene {
 549     my $self=shift;
 550     my $unigene_id=shift;
 551     my $sp_person_id=shift;
 552     my $existing_id= $self->get_locus_unigene_id($unigene_id);
 553
 554     if ($existing_id) {
 555         $self->d("Locus::add_unigene is updating locus_unigene_id $existing_id!!!!!!");
 556         my $u_query="UPDATE phenome.locus_unigene SET obsolete='f' WHERE locus_unigene_id=?";
 557         my $u_sth=$self->get_dbh()->prepare($u_query);
 558         $u_sth->execute($existing_id);
 559         return $existing_id;
 560     }else {
 561         $self->d( "Locus:add_unigene is inserting a new unigene $unigene_id for locus " . $self->get_locus_id() . " (by person $sp_person_id) !!!");
 562         my $query="Insert INTO phenome.locus_unigene (locus_id, unigene_id,sp_person_id) VALUES (?,?,?) RETURNING locus_unigene_id " ;
 563         my $sth=$self->get_dbh->prepare($query);
 564         $sth->execute($self->get_locus_id(), $unigene_id, $sp_person_id);
 565         my ($id) = $sth->fetchrow_array;
 566         return $id;
 567     }
 568     #see if the unigene has solcyc links
 569
 570     my $dbh=$self->get_dbh;
 571     my $unigene= CXGN::Transcript::Unigene->new($dbh, $unigene_id);
 572     my @u_dbxrefs= $unigene->get_dbxrefs();
 573     foreach my $d(@u_dbxrefs) {
 574         $self->add_locus_dbxref($d, undef, $sp_person_id) if $d->get_db_name() eq 'solcyc_images';
 575     }
 576 }
 577
 578 =head2 obsolete_unigene
 579
 580  Usage: $self->obsolete_unigene
 581  Desc:  set locus_unigene to obsolete
 582  Ret:   nothing
 583  Args:  locus_unigene_id
 584  Side Effects: none
 585  Example:
 586
 587 =cut
 588
 589 sub obsolete_unigene {
 590     my $self=shift;
 591     my $lu_id= shift;
 592     my $u_query="UPDATE phenome.locus_unigene SET obsolete='t' WHERE locus_unigene_id=?";
 593     my $u_sth=$self->get_dbh()->prepare($u_query);
 594     $u_sth->execute($lu_id);
 595 }
 596
 597
 598 =head2 get_associated_loci  DEPRECATED. SEE get_locusgroups
 599
 600
 601  Usage:        my @locus_ids = $locus->get_associated_loci()
 602  Desc:         return the loci that are associated to this
 603                locus from the locus2locus table
 604  Ret:          a list of locus ids
 605  Args:        none
 606  Side Effects: none
 607  Example:
 608
 609 =cut
 610
 611
 612 sub get_associated_loci {
 613     warn("DEPRECATED. SEE get_locusgroups() !!!!!!!\n");
 614
 615     my $self = shift;
 616     my $query = "SELECT object_id FROM phenome.locus2locus WHERE obsolete = 'f' AND subject_id=?";
 617     my $sth = $self->get_dbh()->prepare($query);
 618     $sth->execute($self->get_locus_id());
 619     my @associated_loci;
 620     while (my ($associated_locus) = $sth->fetchrow_array()) {
 621         push @associated_loci, $associated_locus;
 622     }
 623     return @associated_loci;
 624
 625 }
 626
 627
 628 =head2 get_reciprocal_loci DEPRECATED - SEE get_locusgroups()
 629  Usage:         my $locus_ids = $locus->get_reciprocal_loci()
 630  Desc:          returns the loci that this locus is associated to
 631                 in the locus2locus table
 632  Ret:
 633  Args:
 634  Side Effects:
 635  Example:
 636
 637 =cut
 638
 639
 640 sub get_reciprocal_loci {
 641     warn("DEPRECATED. SEE get_locusgroups() !!!!!!!\n");
 642     my $self = shift;
 643     my $query = "SELECT DISTINCT subject_id FROM phenome.locus2locus WHERE obsolete = 'f' AND object_id=?";
 644     my $sth = $self->get_dbh()->prepare($query);
 645     $sth->execute($self->get_locus_id());
 646     my @reciprocal_loci;
 647     while (my ($reciprocal_locus) = $sth->fetchrow_array()) {
 648         push @reciprocal_loci, $reciprocal_locus;
 649     }
 650     return @reciprocal_loci;
 651
 652
 653 }
 654
 655 =head2 get_subject_locus2locus_objects   DEPRECATED. SEE get_locusgroups()
 656
 657
 658  Usage:        @l2l = $locus->get_subject_locus2locus_objects()
 659  Desc:         returns all associated locus2locus objects, including
 660                object and subject id based ones.
 661  Ret:          a list of CXGN::Phenome::Locus2Locus objects
 662  Args:
 663  Side Effects:
 664  Example:
 665
 666 =cut
 667
 668 sub get_subject_locus2locus_objects {
 669     warn("DEPRECATED. SEE get_locusgroups() !!!!!!!\n");
 670
 671     my $self = shift;
 672     my @l2l = ();
 673     my $q = "SELECT DISTINCT locus2locus_id FROM phenome.locus2locus WHERE (subject_id=?) and obsolete='f'";
 674     my $sth = $self->get_dbh()->prepare($q);
 675     $sth->execute($self->get_locus_id());
 676
 677     while( my ($l2l) =  $sth->fetchrow_array()) {
 678         push @l2l, CXGN::Phenome::Locus2Locus->new($self->get_dbh(), $l2l);
 679     }
 680     return @l2l;
 681
 682 }
 683
 684
 685 =head2 get_object_locus2locus_objects     DEPRECATED. SEE get_locusgroups()
 686
 687
 688  Usage:        @l2l = $locus->get_object_locus2locus_objects()
 689  Desc:         returns all associated locus2locus objects, including
 690                based ones.
 691  Ret:          a list of CXGN::Phenome::Locus2Locus objects
 692  Args:
 693  Side Effects:
 694  Example:
 695
 696 =cut
 697
 698 sub get_object_locus2locus_objects {
 699     warn("DEPRECATED. SEE get_locusgroups() !!!!!!!\n");
 700
 701     my $self = shift;
 702     my @l2l = ();
 703     my $q = "SELECT DISTINCT locus2locus_id FROM phenome.locus2locus WHERE object_id=? and obsolete='f'";
 704     my $sth = $self->get_dbh()->prepare($q);
 705     $sth->execute($self->get_locus_id());
 706
 707     while( my ($l2l) =  $sth->fetchrow_array()) {
 708         push @l2l, CXGN::Phenome::Locus2Locus->new($self->get_dbh(), $l2l);
 709     }
 710     return @l2l;
 711
 712 }
 713
 714 =head2 add_related_locus
 715
 716  Usage: $self->add_related_locus($locus_id)
 717  Desc:  an accessor for building an associated locus list for the locus
 718  Ret:   nothing
 719  Args:  locus symbol
 720  Side Effects:
 721  Example:
 722
 723 =cut
 724
 725 sub add_related_locus {
 726     my $self=shift;
 727     my $locus=shift;
 728     push @{ $self->{related_loci} }, $locus;
 729 }
 730
 731
 732 =head2 accessors available (get/set)
 733
 734     locus_id
 735     locus_name
 736     locus_symbol
 737     original_symbol
 738     gene_activity
 739     description
 740     linkage_group
 741     lg_arm
 742     common_name
 743     common_name_id
 744     genome_locus
 745 =cut
 746
 747 sub get_locus_id {
 748   my $self=shift;
 749   return $self->{locus_id};
 750
 751 }
 752
 753 sub set_locus_id {
 754   my $self=shift;
 755   $self->{locus_id}=shift;
 756
 757 }
 758
 759 sub get_locus_name {
 760   my $self=shift;
 761   return $self->{locus_name};
 762
 763 }
 764
 765 sub set_locus_name {
 766   my $self=shift;
 767   $self->{locus_name}=shift;
 768 }
 769
 770 sub get_locus_symbol {
 771   my $self=shift;
 772   return $self->{locus_symbol};
 773
 774 }
 775
 776 sub set_locus_symbol {
 777   my $self=shift;
 778   $self->{locus_symbol}=shift;
 779 }
 780
 781
 782 sub get_original_symbol {
 783   my $self=shift;
 784   return $self->{original_symbol};
 785
 786 }
 787
 788 sub set_original_symbol {
 789   my $self=shift;
 790   $self->{original_symbol}=shift;
 791 }
 792
 793 sub get_gene_activity {
 794   my $self=shift;
 795   return $self->{gene_activity};
 796
 797 }
 798
 799 sub set_gene_activity {
 800   my $self=shift;
 801   $self->{gene_activity}=shift;
 802 }
 803
 804
 805 sub get_description {
 806   my $self=shift;
 807   return $self->{description};
 808
 809 }
 810
 811 sub set_description {
 812   my $self=shift;
 813   $self->{description}=shift;
 814 }
 815
 816
 817 sub get_linkage_group {
 818   my $self=shift;
 819   return $self->{linkage_group};
 820
 821 }
 822
 823 sub set_linkage_group {
 824   my $self=shift;
 825   $self->{linkage_group}=shift;
 826 }
 827
 828
 829 sub get_lg_arm {
 830   my $self=shift;
 831   return $self->{lg_arm};
 832
 833 }
 834
 835 sub set_lg_arm {
 836   my $self=shift;
 837   $self->{lg_arm}=shift;
 838 }
 839
 840
 841 sub get_common_name {
 842   my $self=shift;
 843   return $self->{common_name};
 844
 845 }
 846
 847 sub set_common_name {
 848   my $self=shift;
 849   $self->{common_name}=shift;
 850 }
 851
 852
 853 sub get_common_name_id {
 854   my $self=shift;
 855   return $self->{common_name_id};
 856
 857 }
 858
 859 sub set_common_name_id {
 860   my $self=shift;
 861   $self->{common_name_id}=shift;
 862 }
 863
 864 sub get_genome_locus {
 865   my $self = shift;
 866   return $self->{genome_locus};
 867 }
 868
 869 sub set_genome_locus {
 870   my $self = shift;
 871   $self->{genome_locus} = shift;
 872 }
 873
 874
 875 =head2 add_locus_alias
 876
 877  Usage: $self->add_locus_alias($locus_synonym_object)
 878  Desc:  add an alias to the locus
 879  Ret:   a locus_alias id
 880  Args:  LocusSynonym object
 881  Side Effects: accesses the database
 882  Example:
 883
 884 =cut
 885
 886 sub add_locus_alias {
 887     my $self=shift;
 888     my $locus_alias = shift; #LocusSynonym object!!
 889     $locus_alias->set_locus_alias_id(); #set the id to undef in case of the function was called from the merge_locus function
 890     $locus_alias->set_locus_id($self->get_locus_id());
 891     my $symbol = $self->get_locus_symbol();
 892     #if the locus symbol and the alias are the same, then set the new alias to preferred = 't'
 893     if ($symbol eq $locus_alias->get_locus_alias()) {
 894         $locus_alias->set_preferred('t');
 895     }
 896     my $id=$locus_alias->store();
 897     return $id;
 898 }
 899
 900
 901 =head2 get_locus_aliases
 902
 903  Usage: $self->get_locus_aliases()
 904  Desc:  find the aliases of a locus
 905  Ret:    list of LocusSynonym objects
 906  Args:   optional : preffered and obsolete booleans
 907  Side Effects: none
 908  Example:
 909
 910 =cut
 911
 912 sub get_locus_aliases {
 913     my $self=shift;
 914     my ($preferred, $obsolete) = @_;
 915     my $query="SELECT locus_alias_id from phenome.locus_alias WHERE locus_id=? ";
 916     $query .= " AND preferred = '$preferred' " if $preferred;
 917     $query .= " AND obsolete =  '$obsolete' " if $obsolete;
 918     my $sth=$self->get_dbh()->prepare($query);
 919     my @locus_synonyms;
 920     $sth->execute($self->get_locus_id());
 921     while (my ($ls_id) = $sth->fetchrow_array()) {
 922         my $lso=CXGN::Phenome::LocusSynonym->new($self->get_dbh(), $ls_id);
 923         push @locus_synonyms, $lso;
 924     }
 925     return @locus_synonyms;
 926 }
 927
 928 =head2 add_allele
 929
 930  Usage: $self->add_allele($allele)
 931  Desc:  add an allele to the locus
 932  Ret:   the new allele_id
 933  Args:  allele object
 934  Side Effects: accessed the database, Calls Allele->store().
 935  Example:
 936
 937 =cut
 938
 939 sub add_allele {
 940     my $self=shift;
 941     my $allele=shift; #allele object
 942     $allele->set_locus_id($self->get_locus_id() );
 943     my $id = $allele->store();
 944     return $id;
 945 }
 946
 947 =head2 add_allele_symbol
 948
 949   Usage: $self->add_allele_symbol($allele_symbol)
 950  Desc:  an accessor for building an allele list for the locus
 951  Ret:   nothing
 952  Args:  allele symbol
 953  Side Effects:
 954  Example:
 955
 956 =cut
 957
 958 sub add_allele_symbol {
 959     my $self=shift;
 960     my $allele=shift; #allele symbol
 961     push @{ $self->{allele_symbols} }, $allele;
 962 }
 963
 964 =head2 get_alleles
 965
 966  Usage: my @alleles=$self->get_alleles()
 967  Desc:   find the alleles associated with the locus
 968  Ret:    a list of allele objects
 969  Args:   none
 970  Side Effects: none
 971  Example:
 972
 973 =cut
 974
 975 sub get_alleles {
 976     my $self=shift;
 977     $self->d("Getting alleles....   \n\n");
 978     my $allele_query=("SELECT allele_id FROM phenome.allele WHERE locus_id=? AND obsolete='f' AND is_default='f'");
 979     my $sth=$self->get_dbh()->prepare($allele_query);
 980     my @alleles=();
 981     $sth->execute($self->get_locus_id());
 982     while (my ($a_id) = $sth->fetchrow_array()) {
 983         my $allele= CXGN::Phenome::Allele->new($self->get_dbh(), $a_id);
 984         push  @alleles, $allele;
 985     }
 986     return @alleles;
 987 }
 988 =head2 get_default_allele
 989
 990  Usage: $self->get_default_allele()
 991  Desc:  find the database id from the default allele
 992  Ret:   database id
 993  Args:  none
 994  Side Effects: none
 995  Example:
 996
 997 =cut
 998
 999 sub get_default_allele {
1000     my $self=shift;
1001     my $query = "SELECT allele_id from phenome.allele
1002                 WHERE locus_id = ? AND is_default = 't'";
1003     my $sth=$self->get_dbh()->prepare($query);
1004     $sth->execute($self->get_locus_id());
1005     my ($allele_id) = $sth->fetchrow_array();
1006     return $allele_id;
1007 }
1008
1009 =head2 add_synonym
1010
1011  Usage:
1012  Desc:
1013  Ret:
1014  Args:
1015  Side Effects:
1016  Example:
1017
1018 =cut
1019
1020 sub add_synonym {
1021     my $self=shift;
1022     my $synonym=shift; #synonym
1023     push @{ $self->{synonyms} }, $synonym;
1024 }
1025
1026
1027 =head2 add_dbxref
1028
1029  Usage:
1030  Desc:
1031  Ret:
1032  Args:
1033  Side Effects:
1034  Example:
1035
1036 =cut
1037
1038
1039 sub add_dbxref {
1040     my $self=shift;
1041     my $dbxref=shift; #dbxref object
1042     push @{ $self->{dbxrefs} }, $dbxref;
1043 }
1044
1045 =head2 get_dbxrefs
1046
1047  Usage:        $locus->get_dbxrefs();
1048  Desc:         get all the dbxrefs associated with a locus
1049  Ret:          array of dbxref objects
1050  Args:         none
1051  Side Effects: accesses the database
1052  Example:
1053
1054 =cut
1055
1056 sub get_dbxrefs {
1057     my $self=shift;
1058     my $locus_id=$self->get_locus_id();
1059
1060     my $dbxref_query="SELECT locus_dbxref.dbxref_id from phenome.locus_dbxref JOIN public.dbxref USING(dbxref_id) WHERE locus_id=? ORDER BY public.dbxref.accession";
1061     my $sth=$self->get_dbh()->prepare($dbxref_query);
1062     my $dbxref;
1063     my @dbxrefs=(); #an array for storing dbxref objects
1064     $sth->execute($locus_id);
1065     while (my ($d) = $sth->fetchrow_array() ) {
1066         $dbxref= CXGN::Chado::Dbxref->new($self->get_dbh(), $d);
1067         push @dbxrefs, $dbxref;
1068     }
1069
1070     return @dbxrefs;
1071 }
1072 =head2 get_dbxrefs_by_type
1073
1074  Usage:        $locus->get_dbxrefs_by_type("ontology");
1075  Desc:         get all the dbxrefs terms associated with a locus
1076  Ret:          array of dbxref objects
1077  Args:         type (ontology, literature, genbank)
1078  Side Effects: accesses the database
1079  Example:
1080
1081 =cut
1082
1083 sub get_dbxrefs_by_type {
1084     my $self=shift;
1085     my $type = shift;
1086     my $locus_id=$self->get_locus_id();
1087     my $query;
1088     my $dbh = $self->get_dbh();
1089
1090     if ($type eq 'ontology') {
1091         $query="SELECT locus_dbxref.dbxref_id from phenome.locus_dbxref
1092                JOIN public.dbxref USING(dbxref_id)
1093                JOIN public.cvterm USING (dbxref_id)
1094                WHERE locus_id=? ORDER BY public.dbxref.accession";
1095     }elsif ($type eq 'literature') {
1096         $query="SELECT locus_dbxref.dbxref_id from phenome.locus_dbxref
1097                 JOIN public.dbxref USING(dbxref_id)
1098                 JOIN public.db USING (db_id)
1099                 WHERE locus_id=? AND db.name IN ('PMID','SGN_ref') ORDER BY public.dbxref.accession";
1100     }elsif ($type eq 'genbank') {
1101         $query="SELECT locus_dbxref.dbxref_id from phenome.locus_dbxref
1102                 JOIN public.dbxref USING(dbxref_id)
1103                 JOIN public.db USING (db_id)
1104                 WHERE locus_id=? AND db.name IN ('DB:GenBank_GI')
1105                 AND locus_dbxref.obsolete= 'f' ORDER BY public.dbxref.accession";
1106     }else { warn "dbxref type '$type' not recognized! \n" ; return undef; }
1107     my $sth=$self->get_dbh()->prepare($query);
1108     my $dbxref;
1109     my @dbxrefs=(); #an array for storing dbxref objects
1110     $sth->execute($locus_id);
1111     while (my ($d) = $sth->fetchrow_array() ) {
1112         $dbxref= CXGN::Chado::Dbxref->new($self->get_dbh(), $d);
1113         push @dbxrefs, $dbxref;
1114     }
1115     return @dbxrefs;
1116 }
1117
1118 =head2 get_dbxref_lists
1119
1120  Usage:        $locus->get_dbxref_lists();
1121  Desc:         get all the dbxrefs terms associated with a locus
1122  Ret:          hash of 2D arrays . Keys are the db names values are  [dbxref object, locus_dbxref.obsolete]
1123  Args:         none
1124  Side Effects: none
1125  Example:
1126
1127 =cut
1128
1129 sub get_dbxref_lists {
1130     my $self=shift;
1131     my %dbxrefs;
1132     my $query= "SELECT db.name, dbxref.dbxref_id, locus_dbxref.obsolete FROM locus_dbxref
1133                JOIN public.dbxref USING (dbxref_id) JOIN public.db USING (db_id)
1134                WHERE locus_id= ? ORDER BY db.name, dbxref.accession";
1135     my $sth=$self->get_dbh()->prepare($query);
1136     $sth->execute($self->get_locus_id());
1137     while (my ($db_name, $dbxref_id, $obsolete) = $sth->fetchrow_array()) {
1138         push @ {$dbxrefs{$db_name} }, [CXGN::Chado::Dbxref->new($self->get_dbh(), $dbxref_id), $obsolete] ;
1139     }
1140     return %dbxrefs;
1141 }
1142
1143 =head2 get_all_dbxrefs
1144
1145  Usage:
1146  Desc:
1147  Ret:
1148  Args:
1149  Side Effects:
1150  Example:
1151
1152 =cut
1153
1154 sub get_all_dbxrefs {
1155     my $locus = shift;
1156     my $locus_name = $locus->get_locus_name() ;
1157     my %dbs        = $locus->get_dbxref_lists() ;    #hash of arrays. keys=dbname values= dbxref objects
1158     my @alleles = $locus->get_alleles();
1159     #add the allele dbxrefs to the locus dbxrefs hash...
1160     #This way the alleles associated publications and sequences are also printed on the locus page
1161     #it might be a good idea to print a link to the allele next to each allele-derived annotation
1162
1163     foreach my $a (@alleles) {
1164         my %a_dbs = $a->get_dbxref_lists();
1165
1166         foreach my $a_db_name ( keys %a_dbs ) {
1167             #add allele_dbxrefs to the locus_dbxrefs list
1168             my %seen = () ; #hash for assisting filtering of duplicated dbxrefs (from allele annotation)
1169             foreach my $xref ( @{ $dbs{$a_db_name} } ) {
1170                 $seen{ $xref->[0]->get_accession() }++;
1171             }    #populate with the locus_dbxrefs
1172             foreach my $axref ( @{ $a_dbs{$a_db_name} } ) {    #and filter duplicates
1173                 push @{ $dbs{$a_db_name} }, $axref
1174                     unless $seen{ $axref->[0]->get_accession() }++;
1175             }
1176         }
1177     }
1178     return %dbs;
1179 }
1180
1181
1182
1183 =head2 get_locus_dbxrefs
1184
1185  Usage: $self->get_locus_dbxrefs()
1186  Desc:  get the LocusDbxref objects associated with this locus
1187  Ret:   a hash of arrays. Keys=db_name, values = lists of LocusDbxref objects
1188  Args:  none
1189  Side Effects: none
1190  Example:
1191
1192 =cut
1193
1194 sub get_locus_dbxrefs {
1195     my $self=shift;
1196      my %lds;
1197     my $query= "SELECT db.name, locus_dbxref.locus_dbxref_id FROM locus_dbxref
1198                JOIN public.dbxref USING (dbxref_id) JOIN public.db USING (db_id)
1199                WHERE locus_id= ? ORDER BY db.name, dbxref.accession";
1200     my $sth=$self->get_dbh()->prepare($query);
1201     $sth->execute($self->get_locus_id());
1202     while (my ($db_name, $ld_id) = $sth->fetchrow_array()) {
1203         push @ {$lds{$db_name} }, CXGN::Phenome::LocusDbxref->new($self->get_dbh(), $ld_id) ;
1204     }
1205     return %lds;
1206 }
1207
1208
1209 =head2 add_locus_marker
1210
1211  Usage:
1212  Desc:
1213  Ret:
1214  Args:
1215  Side Effects:
1216  Example:
1217
1218 =cut
1219
1220 sub add_locus_marker {
1221     my $self=shift;
1222     push @{ $self->{locus_markers} }, shift;
1223 }
1224
1225 =head2 get_locus_markers
1226
1227  Usage:
1228  Desc:
1229  Ret:
1230  Args:
1231  Side Effects:
1232  Example:
1233
1234 =cut
1235
1236 sub get_locus_markers {
1237   my $self=shift;
1238   return @{$self->{locus_markers} || [] };
1239 }
1240
1241
1242 =head2 get_locus_dbxref
1243
1244  Usage:        $locus->get_locus_dbxref($dbxref)
1245  Desc:         access locus_dbxref object for a given locus and
1246                its dbxref object
1247  Ret:          a LocusDbxref object
1248  Args:         dbxref object
1249  Side Effects: accesses the database
1250  Example:
1251
1252 =cut
1253
1254 sub get_locus_dbxref {
1255     my $self=shift;
1256     my $dbxref=shift; # my dbxref object..
1257     my $query="SELECT locus_dbxref_id from phenome.locus_dbxref
1258                                         WHERE locus_id=? AND dbxref_id=? ";
1259     my $sth=$self->get_dbh()->prepare($query);
1260     $sth->execute($self->get_locus_id(), $dbxref->get_dbxref_id() );
1261     my ($locus_dbxref_id) = $sth->fetchrow_array();
1262     my $locus_dbxref= CXGN::Phenome::LocusDbxref->new($self->get_dbh(), $locus_dbxref_id);
1263     return $locus_dbxref;
1264 }
1265
1266 =head2 add_locus_dbxref
1267
1268  Usage:        $locus->add_locus_dbxref($dbxref_object,
1269                                         $locus_dbxref_id,
1270                                         $sp_person_id);
1271  Desc:         adds a locus_dbxref relationship
1272  Ret:   database id
1273  Args:
1274  Side Effects: calls store function in LocusDbxref
1275  Example:
1276
1277 =cut
1278
1279 sub add_locus_dbxref {
1280     my $self=shift;
1281     my $dbxref=shift; #dbxref object
1282     my $locus_dbxref_id=shift;
1283     my $sp_person_id=shift;
1284
1285     my $locus_dbxref=CXGN::Phenome::LocusDbxref->new($self->get_dbh(), $locus_dbxref_id );
1286     $locus_dbxref->set_locus_id($self->get_locus_id() );
1287     $locus_dbxref->set_dbxref_id($dbxref->get_dbxref_id() );
1288     $locus_dbxref->set_sp_person_id($sp_person_id);
1289     if (!$dbxref->get_dbxref_id()) {return undef };
1290
1291     my $id = $locus_dbxref->store();
1292     return $id;
1293 }
1294
1295 =head2 function get_individuals
1296
1297   Synopsis:     DEPRECATED. Use get_stock_ids
1298                 my @individuals=$locus->get_individuals();
1299   Arguments:    none
1300   Returns:
1301   Side effects:
1302   Description:
1303
1304 =cut
1305
1306 sub get_individuals {
1307     my $self = shift;
1308     warn "DEPRECATED. Use get_stocks.";
1309     $self->get_stocks;
1310 }
1311
1312 =head2 get_stock_ids
1313
1314  Usage: my $stock_ids = $self->get_stock_ids
1315  Desc:  find stocks associated with the locus
1316  Ret:   a list of stock_ids
1317  Args:  none
1318  Side Effects: none
1319  Example:
1320
1321 =cut
1322
1323 sub get_stock_ids {
1324     my $self  = shift;
1325     my $query = "select distinct stock_id FROM phenome.stock_allele
1326              JOIN phenome.allele USING (allele_id)
1327              WHERE locus_id = ? AND allele.obsolete = ? ";
1328     my $ids = $self->get_dbh->selectcol_arrayref
1329         ( $query,
1330           undef,
1331           $self->get_locus_id,
1332           'false'
1333         );
1334     return $ids;
1335 }
1336
1337
1338 =head2 get_locus_registry_symbol
1339
1340  Usage: $locus->get_locus_registry_symbol()
1341  Desc:  get the registered symbol of a locus
1342  Ret:   a  registry object?
1343  Args:   none
1344  Side Effects:
1345  Example:
1346
1347 =cut
1348
1349 sub get_locus_registry_symbol {
1350     my $self=shift;
1351
1352     my $query=$self->get_dbh()->prepare("SELECT registry_id from phenome.locus_registry
1353                                         WHERE locus_id=?  ");
1354     $query->execute($self->get_locus_id() );
1355     my ($registry_id) = $query->fetchrow_array();
1356     if ($registry_id) {
1357         my $registry= CXGN::Phenome::Registry->new($self->get_dbh(), $registry_id);
1358         return $registry;
1359     }else { return undef; }
1360 }
1361
1362
1363
1364 =head2 store_history
1365
1366  Usage:        $self->store_history()
1367  Desc:         Inserts the current fields of a locus object into
1368                the locus_history table before updating the locus details
1369  Ret:
1370  Args: none
1371  Side Effects:
1372  Example:
1373
1374 =cut
1375
1376 sub store_history {
1377
1378     my $self=shift;
1379     my $locus=CXGN::Phenome::Locus->new($self->get_dbh(), $self->get_locus_id() );
1380     $self->d( "Locus.pm:*Storing history for locus " . $self->get_locus_id() . "\n");
1381     my $history_query = "INSERT INTO phenome.locus_history (locus_id, locus_name, locus_symbol, original_symbol,gene_activity,locus_description,linkage_group, lg_arm, sp_person_id, updated_by, obsolete, create_date)
1382                              VALUES(?,?,?,?,?,?,?,?,?,?,?, now())";
1383     my $history_sth= $self->get_dbh()->prepare($history_query);
1384
1385     $history_sth->execute($locus->get_locus_id(), $locus->get_locus_name(), $locus->get_locus_symbol(),  $locus->get_original_symbol(), $locus->get_gene_activity(), $locus->get_description(), $locus->get_linkage_group(), $locus->get_lg_arm(), $locus->get_sp_person_id, $self->get_updated_by(), $locus->get_obsolete() );
1386
1387
1388 }
1389
1390 =head2 show_history
1391
1392   Usage: $locus->show_history();
1393  Desc:   Selects the data from locus_history table for a locus object
1394  Ret:
1395  Args:
1396  Side Effects:
1397  Example:
1398
1399 =cut
1400
1401 sub show_history {
1402     my $self=shift;
1403     my $locus_id= $self->get_locus_id();
1404     my $history_query=$self->get_dbh()->prepare("SELECT locus_history_id FROM phenome.locus_history WHERE locus_id=?");
1405     my @history;
1406     $history_query->execute($locus_id);
1407     while (my ($history_id) = $history_query->fetchrow_array()) {
1408         my $history_obj = CXGN::Phenome::Locus::LocusHistory->new($self->get_dbh(), $history_id);
1409         push @history, $history_obj;
1410     }
1411     return @history;
1412 }
1413
1414 =head2 get_associated_registry
1415
1416  Usage:
1417  Desc:
1418  Ret: the Registry symbol
1419  Args:
1420  Side Effects:
1421  Example:
1422
1423 =cut
1424
1425 sub get_associated_registry{
1426     my $self=shift;
1427     my $locus_id= $self->get_locus_id();
1428     my $registry_query=$self->get_dbh()->prepare("SELECT locus_registry.registry_id, registry.name FROM phenome.locus_registry JOIN phenome.registry USING (registry_id) WHERE locus_id=?");
1429     $registry_query->execute($locus_id);
1430     my ($registry_id, $name) = $registry_query->fetchrow_array();
1431     return $name;
1432 }
1433
1434 =head2 associated_publication
1435
1436  Usage: my $associated= $locus->associated_publication($accession)
1437  Desc:  checks if a publication is already associated with the locus
1438  Ret:  a dbxref_id
1439  Args: publication accession (pubmed ID)
1440  Side Effects:
1441  Example:
1442
1443 =cut
1444
1445 sub associated_publication {
1446
1447     my $self=shift;
1448     my $accession=shift;
1449     my $query = $self->get_dbh()->prepare("SELECT dbxref_id FROM phenome.locus_dbxref JOIN dbxref USING (dbxref_id) WHERE locus_id = ? AND dbxref.accession = ? AND obsolete = 'f'");
1450     $query->execute($self->get_locus_id(), $accession);
1451     my ($is_associated) = $query->fetchrow_array();
1452     return $is_associated;
1453 }
1454
1455 =head2 get_recent_annotated_loci
1456
1457  Usage: my %edits= CXGN::Phenome::Locus::get_recent_annotated_loci($dbh, $date)
1458  Desc:  find all the loci annotated after date $date
1459  Ret:   hash of arrays of locus objects, aliases, alleles, locus_dbxrefs, unigenes, markers,stocks, and images
1460  Args:  database handle and a date
1461  Side Effects:
1462  Example:
1463
1464 =cut
1465
1466 sub get_recent_annotated_loci {
1467
1468     my $dbh=shift;
1469     my $date= shift;
1470     my %edits={};
1471
1472     ####
1473     #get all created and modified loci
1474     ####
1475     my $locus_query="SELECT locus_id FROM phenome.locus WHERE modified_date>? OR create_date>?
1476                      ORDER BY modified_date desc";
1477     my $locus_sth=$dbh->prepare($locus_query);
1478     $locus_sth->execute($date,$date);
1479     while (my($locus_id) = $locus_sth->fetchrow_array()) {
1480         my $locus= CXGN::Phenome::Locus->new($dbh, $locus_id);
1481         push @{ $edits{loci} }, $locus;
1482     }
1483
1484     #get all created and modified aliases
1485     ####
1486     my $locus_alias_query="SELECT locus_alias_id FROM phenome.locus_alias
1487                           WHERE (modified_date>? OR create_date>?) AND preferred='f'
1488                           ORDER BY modified_date desc";
1489     my $locus_alias_sth=$dbh->prepare($locus_alias_query);
1490     $locus_alias_sth->execute($date,$date);
1491     while (my($locus_alias_id) = $locus_alias_sth->fetchrow_array()) {
1492         my $locus_alias= CXGN::Phenome::LocusSynonym->new($dbh, $locus_alias_id);
1493         push @{ $edits{aliases} }, $locus_alias;
1494     }
1495     #get all created and modified alleles
1496     ####
1497     my $allele_query="SELECT allele_id FROM phenome.allele
1498                       WHERE (modified_date>? OR create_date>?) and is_default='f'
1499                       ORDER BY modified_date desc";
1500     my $allele_sth=$dbh->prepare($allele_query);
1501     $allele_sth->execute($date,$date);
1502     while (my($allele_id) = $allele_sth->fetchrow_array()) {
1503         my $allele= CXGN::Phenome::Allele->new($dbh, $allele_id);
1504         push @{ $edits{alleles} }, $allele;
1505     }
1506
1507     ####
1508     #get all locus_dbxrefs
1509     ####
1510     my $locus_dbxref_query="SELECT locus_dbxref_id FROM phenome.locus_dbxref
1511                             WHERE (modified_date>? OR create_date>?)
1512                             ORDER BY modified_date desc, create_date desc";
1513     my $locus_dbxref_sth=$dbh->prepare($locus_dbxref_query);
1514     $locus_dbxref_sth->execute($date,$date);
1515
1516     while (my($locus_dbxref_id) = $locus_dbxref_sth->fetchrow_array()) {
1517         my $locus_dbxref= CXGN::Phenome::LocusDbxref->new($dbh, $locus_dbxref_id);
1518         push @{ $edits{locus_dbxrefs} }, $locus_dbxref;
1519     }
1520
1521     ###
1522     #get associated images
1523     ####
1524     my $image_query="SELECT locus_id, image_id , sp_person_id, create_date, modified_date, obsolete
1525                      FROM phenome.locus_image
1526                      WHERE (modified_date>? OR create_date>?)
1527                      ORDER BY modified_date desc, create_date desc";
1528     my $image_sth=$dbh->prepare($image_query);
1529     $image_sth->execute($date,$date);
1530
1531     while (my($locus_id, $image_id, $person_id, $cdate, $mdate, $obsolete) = $image_sth->fetchrow_array()) {
1532         my $image= CXGN::Image->new($dbh, $image_id);
1533         my $locus=CXGN::Phenome::Locus->new($dbh, $locus_id);
1534         push @{ $edits{locus_images} }, [$locus, $image, $person_id, $cdate, $mdate, $obsolete];
1535     }
1536
1537     ###
1538     #get associated stocks
1539     ####
1540     my $schema= Bio::Chado::Schema->connect( sub { $dbh->clone } ) ;
1541     my $stock_query = "SELECT *  FROM phenome.stock_allele  join metadata.md_metadata USING (metadata_id) WHERE create_date>? OR modified_date>? ORDER BY modified_date DESC, create_date DESC";
1542     my $stock_sth = $dbh->prepare($stock_query);
1543     $stock_sth->execute($date, $date);
1544     while ( my $hashref = $stock_sth->fetchrow_hashref() ) {
1545         my $stock = CXGN::Chado::Stock->new($schema, $hashref->{stock_id} );
1546         my $allele = CXGN::Phenome::Allele->new($dbh, $hashref->{allele_id} );
1547         push @{ $edits{stocks} }, [$stock, $allele, $hashref->{create_person_id}, $hashref->{create_date}, $hashref->{modified_date}, $hashref->{obsolete}];
1548     }
1549     ###
1550     #get associated unigenes
1551     ####
1552     my $locus_unigene_query="SELECT locus_id, unigene_id, sp_person_id, create_date, modified_date, obsolete
1553                             FROM phenome.locus_unigene
1554                             WHERE (modified_date>? OR create_date>?)
1555                             ORDER BY modified_date DESC, create_date DESC";
1556
1557     my $locus_unigene_sth=$dbh->prepare($locus_unigene_query);
1558     $locus_unigene_sth->execute($date,$date);
1559
1560     while (my($locus_id, $unigene_id, $person_id, $cdate,$mdate, $obsolete) = $locus_unigene_sth->fetchrow_array()) {
1561         my $unigene= CXGN::Transcript::Unigene->new_lite_unigene($dbh, $unigene_id);
1562         my $locus=CXGN::Phenome::Locus->new($dbh, $locus_id);
1563         push @{ $edits{locus_unigenes} }, [$unigene,$locus, $person_id, $cdate, $mdate, $obsolete];
1564     }
1565
1566     #get associated markers
1567     my $locus_marker_query="SELECT locus_marker_id
1568                             FROM phenome.locus_marker
1569                             WHERE (modified_date>? OR create_date>?)
1570                             ORDER BY modified_date DESC, create_date DESC";
1571     my $locus_marker_sth=$dbh->prepare($locus_marker_query);
1572     $locus_marker_sth->execute($date,$date);
1573
1574     while (my ($locus_marker_id) = $locus_marker_sth->fetchrow_array()) {
1575         my $locus_marker= CXGN::Phenome::LocusMaker->new($dbh, $locus_marker_id);
1576         push @{ $edits{locus_markers} }, $locus_marker;
1577     }
1578
1579     return %edits;
1580 }
1581
1582
1583 =head2 get_edit
1584
1585  Usage: my %edits= CXGN::Phenome::Locus::get_edits($locus)
1586  Desc:  find all annotations by date for this locus
1587  Ret:   hash of arrays of  aliases, alleles, locus_dbxrefs, unigenes, markers,stocks, and images
1588  Args:  locus object
1589  Side Effects:
1590  Example:
1591
1592 =cut
1593
1594 sub get_edits {
1595     my $self= shift;
1596     my %edits={};
1597     my $dbh=$self->get_dbh();
1598     ####
1599     #get all locus edits (LocusHistory objects
1600     ####
1601
1602     push @{ $edits{loci} }, $self->show_history();
1603
1604
1605     #get all created and modified aliases
1606     ####
1607     my $locus_alias_query="SELECT locus_alias_id FROM phenome.locus_alias
1608                            WHERE locus_id= ?
1609                           ORDER BY modified_date desc, create_date desc";
1610     my $locus_alias_sth=$dbh->prepare($locus_alias_query);
1611     $locus_alias_sth->execute($self->get_locus_id());
1612     while (my($locus_alias_id) = $locus_alias_sth->fetchrow_array()) {
1613         my $locus_alias= CXGN::Phenome::LocusSynonym->new($dbh, $locus_alias_id);
1614         push @{ $edits{aliases} }, $locus_alias;
1615     }
1616     #get all created and modified alleles
1617     ####
1618     my $allele_query="SELECT allele_id FROM phenome.allele
1619                       WHERE  is_default='f' AND locus_id =?
1620                       ORDER BY modified_date DESC,  create_date DESC";
1621     my $allele_sth=$dbh->prepare($allele_query);
1622     $allele_sth->execute($self->get_locus_id());
1623     while (my($allele_id) = $allele_sth->fetchrow_array()) {
1624         my $allele= CXGN::Phenome::Allele->new($dbh, $allele_id);
1625         push @{ $edits{alleles} }, $allele;
1626     }
1627
1628     ####
1629     #get all locus_dbxrefs
1630     ####
1631     my $locus_dbxref_query="SELECT locus_dbxref_id FROM phenome.locus_dbxref
1632                             WHERE locus_id = ?
1633                             ORDER BY modified_date desc, create_date desc";
1634     my $locus_dbxref_sth=$dbh->prepare($locus_dbxref_query);
1635     $locus_dbxref_sth->execute($self->get_locus_id());
1636
1637     while (my($locus_dbxref_id) = $locus_dbxref_sth->fetchrow_array()) {
1638         my $locus_dbxref= CXGN::Phenome::LocusDbxref->new($dbh, $locus_dbxref_id);
1639         push @{ $edits{locus_dbxrefs} }, $locus_dbxref;
1640     }
1641
1642     ###
1643     #get associated images
1644     ####
1645     my $image_query="SELECT image_id , sp_person_id, create_date, modified_date, obsolete
1646                      FROM phenome.locus_image
1647                      WHERE locus_id=?
1648                      ORDER BY modified_date desc, create_date desc";
1649     my $image_sth=$dbh->prepare($image_query);
1650     $image_sth->execute($self->get_locus_id);
1651
1652     while (my($image_id, $person_id, $cdate, $mdate, $obsolete) = $image_sth->fetchrow_array()) {
1653         my $image= CXGN::Image->new($dbh, $image_id);
1654         push @{ $edits{images} }, [$image, $person_id, $cdate, $mdate, $obsolete];
1655     }
1656
1657     ###
1658     #get associated stocks
1659     ####
1660     # need to figure out a way for storing stockprops of type 'sgn allele_id' with storage date
1661     #push @{ $edits{individuals} }, $individual;
1662
1663
1664     ###
1665     #get associated unigenes
1666     ####
1667     my $locus_unigene_query="SELECT unigene_id, sp_person_id, create_date, modified_date, obsolete
1668                             FROM phenome.locus_unigene
1669                             WHERE locus_id = ?
1670                             ORDER BY modified_date DESC, create_date DESC";
1671
1672     my $locus_unigene_sth=$dbh->prepare($locus_unigene_query);
1673     $locus_unigene_sth->execute($self->get_locus_id());
1674
1675     while (my($unigene_id, $person_id, $cdate,$mdate, $obsolete) = $locus_unigene_sth->fetchrow_array()) {
1676         my $unigene= CXGN::Transcript::Unigene->new($dbh, $unigene_id);
1677         push @{ $edits{unigenes} }, [$unigene, $person_id, $cdate, $mdate, $obsolete];
1678     }
1679
1680     #get associated markers
1681     my $locus_marker_query="SELECT marker_id FROM phenome.locus_marker
1682                             WHERE locus_id  = ?
1683                             ORDER BY modified_date DESC, create_date DESC";
1684     my $locus_marker_sth=$dbh->prepare($locus_marker_query);
1685     $locus_marker_sth->execute($self-get_locus_id());
1686
1687     while (my($locus_marker_id) = $locus_marker_sth->fetchrow_array()) {
1688         my $locus_marker= CXGN::Phenome::LocusMaker->new($dbh, $locus_marker_id);
1689         push @{ $edits{markers} }, $locus_marker;
1690     }
1691
1692     return %edits;
1693 }
1694
1695
1696 =head2 function get_figures
1697
1698   Synopsis:     my @figures=$locus->get_figures();
1699   Arguments:    none
1700   Returns:      list of CXGN::image objects
1701   Side effects:
1702   Description:  all images are stored in the locus_image linking table
1703
1704 =cut
1705
1706 sub get_figures {
1707     my $self = shift;
1708     my $query = "SELECT image_id FROM phenome.locus_image
1709                  WHERE  obsolete = 'f' and locus_id=?";
1710     my $sth = $self->get_dbh()->prepare($query);
1711     $sth->execute($self->get_locus_id());
1712     my $image;
1713     my @images = ();
1714     while (my ($image_id) = $sth->fetchrow_array()) {
1715         $image = CXGN::Image->new($self->get_dbh(), $image_id);
1716         push @images, $image;
1717     }
1718     return @images;
1719 }
1720
1721 =head2 get_figure_ids
1722
1723  Usage: $self->get_figure_ids
1724  Desc:  get a list of image_ids for figures associated with the locus
1725  Ret:   a list of image ids
1726  Args:  none
1727  Side Effects:
1728  Example:
1729
1730 =cut
1731
1732 sub get_figure_ids {
1733     my $self = shift;
1734     my $query = "SELECT image_id FROM phenome.locus_image
1735                  WHERE  obsolete = 'f' and locus_id=?";
1736     my $sth = $self->get_dbh()->prepare($query);
1737     $sth->execute($self->get_locus_id());
1738     my @image_ids = ();
1739     while (my ($image_id) = $sth->fetchrow_array()) {
1740         push @image_ids, $image_id;
1741     }
1742     return @image_ids;
1743 }
1744
1745
1746
1747 =head2 add_figure
1748
1749  Usage: $self->add_figure($image_id, $sp_person_id)
1750  Desc: associate an existing image/figure with the locus
1751  Ret:  database id (locus_image_id)
1752  Args: image_id, sp_person_id
1753  Side Effects: accesses the database
1754  Example:
1755
1756 =cut
1757
1758 sub add_figure {
1759     my $self=shift;
1760     my $image_id=shift;
1761     my $sp_person_id=shift;
1762     my $query="Insert INTO phenome.locus_image (locus_id, image_id,sp_person_id) VALUES (?,?,?)";
1763     my $sth=$self->get_dbh->prepare($query);
1764     $sth->execute($self->get_locus_id(), $image_id, $sp_person_id);
1765     my $id= $self->get_currval("phenome.locus_image_locus_image_id_seq");
1766     return $id;
1767 }
1768
1769
1770 =head2 get_owners
1771
1772  Usage: my @owners=$locus->get_owners(1)
1773  Desc:  get all the owners of the current locus object
1774  Ret:   an array of SGN person ids
1775  Args:  [optional] boolean - if passed then return an arrayref of people objects
1776  Side Effects:
1777  Example:
1778
1779 =cut
1780
1781 sub get_owners {
1782     my $self=shift;
1783     my $return_obj = shift;
1784     my $query = "SELECT sp_person_id FROM phenome.locus_owner
1785                  WHERE locus_id = ? AND obsolete = 'f' ORDER BY create_date";
1786     my $sth=$self->get_dbh()->prepare($query);
1787     $sth->execute($self->get_locus_id());
1788     my $person;
1789     my @owners = ();
1790     my @o_objects = ();
1791     while (my ($sp_person_id) = $sth->fetchrow_array()) {
1792         $person = CXGN::People::Person->new($self->get_dbh(), $sp_person_id);
1793         push @owners, $sp_person_id;
1794         push @o_objects, $person;
1795     }
1796     return \@o_objects if $return_obj;
1797     return @owners;
1798 }
1799
1800 =head2 add_owner
1801
1802  Usage: $self->add_owner($owner_id,$sp_person_id)
1803  Desc:  assign a locus owner
1804  Ret:    database id
1805  Args:   owner_id, user_id
1806  Side Effects: insert a new locus_owner
1807  Example:
1808
1809 =cut
1810
1811 sub add_owner {
1812     my $self=shift;
1813     my $owner_id=shift;
1814     my $sp_person_id=shift;
1815
1816     if (!$self->owner_exists($owner_id)) {
1817
1818         my $query = "INSERT INTO phenome.locus_owner (sp_person_id, locus_id, granted_by)
1819                       VALUES (?,?,?)";
1820         my $sth=$self->get_dbh()->prepare($query);
1821         $sth->execute($owner_id, $self->get_locus_id(), $sp_person_id);
1822         my $id= $self->get_currval("phenome.locus_owner_locus_owner_id_seq");
1823         $self->d( "Locus.pm:add_owner: added owner id: $owner_id, granted by: $sp_person_id\n");
1824         return $id;
1825     }else { return undef; }
1826 }
1827
1828
1829 =head2 owner_exists
1830
1831  Usage: $self->owner_exists($sp_person_id)
1832  Desc:  check if the locus already has owner $sp_person_id
1833  Ret:   database id (locus_owner_id) or undef
1834  Args:  $sp_person_id
1835  Side Effects: none
1836  Example:
1837
1838 =cut
1839
1840 sub owner_exists {
1841     my $self=shift;
1842     my $sp_person_id=shift;
1843     my $q= "SELECT locus_owner_id, obsolete FROM phenome.locus_owner WHERE locus_id=? AND sp_person_id=? ";
1844     my $sth=$self->get_dbh()->prepare($q);
1845     $sth->execute($self->get_locus_id(), $sp_person_id);
1846     my ($id, $ob)= $sth->fetchrow_array();
1847     return $id || undef;
1848 }
1849
1850
1851
1852 =head2 get_individual_allele_id
1853
1854  Usage: DEPRECATED. allele_ids are now stored in stock_allele
1855         my $individual_allele_id= $locus->get_individual_allele_id($individual_id)
1856  Desc:  find the individual_allele database id for a given individual id
1857         useful for manipulating individual_allele table (like obsoleting an individual-allele  association)
1858
1859  Ret: a database id from the table phenome.individual_allele
1860  Args: $individual_id
1861  Side Effects:
1862  Example:
1863
1864 =cut
1865
1866 sub get_individual_allele_id {
1867     my $self=shift;
1868     my $individual_id=shift;
1869     my $query= "SELECT individual_allele_id FROM phenome.individual_allele
1870                 JOIN phenome.allele USING (allele_id)
1871                 WHERE locus_id=? AND individual_id=?";
1872     my $sth=$self->get_dbh()->prepare($query);
1873     $sth->execute($self->get_locus_id(), $individual_id);
1874     my ($individual_allele_id) = $sth->fetchrow_array();
1875     return $individual_allele_id;
1876 }
1877
1878 =head2 get_associated_locus    DEPRECATED. SEE get_locusgroups()
1879
1880  Usage: $locus->get_associated_locus($associated_locus_id)
1881  Desc:  get a locus2locus object of the locus (object) associated to the current locus (subject)
1882  Ret:    a Locus2Locus object or undef
1883  Args:  $associated_locus_id
1884  Side Effects: none
1885  Example:
1886
1887 =cut
1888
1889 sub get_associated_locus {
1890     warn("DEPRECATED. SEE get_locusgroups() !!!!!!!\n");
1891
1892     my $self=shift;
1893     my $associated_locus_id=shift;
1894     my $query = "SELECT locus2locus_id FROM phenome.locus2locus WHERE object_id=? AND subject_id = ? AND obsolete= 'f'";
1895     my $sth = $self->get_dbh()->prepare($query);
1896     $sth->execute($associated_locus_id, $self->get_locus_id());
1897     my ($l2l_id) = $sth->fetchrow_array();
1898
1899     if ($l2l_id) {
1900         my $l2l=CXGN::Phenome::Locus2Locus->new($self->get_dbh(), $l2l_id);
1901         return $l2l;
1902     } else { return undef };
1903 }
1904
1905 =head2 get_reciprocal_locus  DEPRECATED. SEE get_locusgroups()
1906
1907
1908  Usage:  $locus->get_reciprocal_locus($reciprocal_locus_id)
1909  Desc:   get a locus2locus object of the reciprocal_locus (subject) associated to the current locus (object).
1910          This is used for printing the reciprocal loci associated with a specific locus.
1911  Ret:    Locus2Locus object or undef
1912  Args:   $reciprocal_locus_id
1913  Side Effects: none
1914  Example:
1915
1916 =cut
1917
1918 sub get_reciprocal_locus {
1919     warn("DEPRECATED. SEE get_locusgroups() !!!!!!!\n");
1920
1921     my $self=shift;
1922     my $reciprocal_locus_id=shift;
1923     my $query = "SELECT locus2locus_id FROM phenome.locus2locus WHERE object_id=? AND subject_id = ? AND obsolete='f'";
1924     my $sth = $self->get_dbh()->prepare($query);
1925     $sth->execute( $self->get_locus_id(), $reciprocal_locus_id);
1926     my ($l2l_id) = $sth->fetchrow_array();
1927     if ($l2l_id) {
1928         my $l2l=CXGN::Phenome::Locus2Locus->new($self->get_dbh(), $l2l_id);
1929         return $l2l;
1930     }else {return undef ; }
1931 }
1932
1933
1934 =head2 get_locus_annotations
1935
1936  Usage: $self->get_locus_annotations($dbh, $cv_name)
1937  Desc:  find all cv_name annotations for loci
1938  Ret:   list of LocusDbxref objects
1939  Args:  database handle and a cv name
1940  Side Effects: none
1941  Example:
1942
1943 =cut
1944
1945 sub get_locus_annotations {
1946     my $self=shift;
1947     my $dbh=shift;
1948     my $cv_name=shift;
1949     my @annotations;
1950     my $query = "SELECT locus_dbxref_id FROM phenome.locus_dbxref
1951                  JOIN public.dbxref USING (dbxref_id)
1952                  JOIN public.cvterm USING (dbxref_id)
1953                  JOIN public.cv USING (cv_id)
1954                  WHERE cv.name = ? AND locus_dbxref.obsolete= 'f' ORDER BY locus_id";
1955     my $sth=$dbh->prepare($query);
1956     $sth->execute($cv_name);
1957     while (my ($locus_dbxref_id) = $sth->fetchrow_array()) {
1958         my $locus_dbxref= CXGN::Phenome::LocusDbxref->new($dbh, $locus_dbxref_id);
1959         push @annotations , $locus_dbxref;
1960     }
1961     return @annotations;
1962 }
1963
1964 =head2 get_curated_annotations
1965
1966  Usage: $self->get_curated_annotations($dbh, $cv_name)
1967  Desc:  find all cv_name non-electronic annotations for loci
1968  Ret:   list of LocusDbxref objects
1969  Args:  database handle and a cv name
1970  Side Effects: none
1971  Example:
1972
1973 =cut
1974
1975 sub get_curated_annotations {
1976     my $self=shift;
1977     my $dbh=shift;
1978     my $cv_name=shift;
1979     my @annotations;
1980     my $query = "SELECT locus_dbxref_id , locus_dbxref_evidence.evidence_code_id FROM phenome.locus_dbxref
1981                  JOIN public.dbxref USING (dbxref_id)
1982                  JOIN public.cvterm USING (dbxref_id)
1983                  JOIN public.cv USING (cv_id)
1984                  JOIN locus_dbxref_evidence USING (locus_dbxref_id)
1985                  WHERE cv.name = ? AND locus_dbxref.obsolete= 'f'
1986                  AND locus_dbxref_evidence.evidence_code_id !=(SELECT dbxref_id FROM public.cvterm WHERE name = 'inferred from electronic annotation') ORDER BY locus_id";
1987     my $sth=$dbh->prepare($query);
1988     $sth->execute($cv_name);
1989     while (my ($locus_dbxref_id) = $sth->fetchrow_array()) {
1990         my $locus_dbxref= CXGN::Phenome::LocusDbxref->new($dbh, $locus_dbxref_id);
1991         push @annotations , $locus_dbxref;
1992     }
1993     return @annotations;
1994 }
1995
1996 =head2 get_annotations_by_db
1997
1998  Usage: $self->get_annotations_by_db('GO')
1999  Desc:  find all locus cvterm annotations for a given db
2000  Ret:   an array of locus_dbxref objects
2001  Args:  $db_name
2002  Side Effects: none
2003  Example:
2004
2005 =cut
2006
2007 sub get_annotations_by_db {
2008     my $self=shift;
2009     my $dbh=shift;
2010     my $db_name=shift;
2011     my @annotations;
2012     my $query = "SELECT locus_dbxref_id FROM phenome.locus_dbxref
2013                  JOIN phenome.locus_dbxref_evidence USING (locus_dbxref_id)
2014                  JOIN public.dbxref USING (dbxref_id)
2015                  JOIN public.db USING (db_id)
2016                  JOIN public.cvterm USING (dbxref_id)
2017                  WHERE db.name = ? AND locus_dbxref_evidence.obsolete= 'f'";
2018     my $sth=$dbh->prepare($query);
2019     $sth->execute($db_name);
2020     while (my ($locus_dbxref_id) = $sth->fetchrow_array()) {
2021         my $locus_dbxref= CXGN::Phenome::LocusDbxref->new($dbh, $locus_dbxref_id);
2022         push @annotations , $locus_dbxref;
2023     }
2024     return @annotations;
2025 }
2026
2027
2028
2029 =head2 merge_locus
2030
2031  Usage: $self->merge_locus($merged_locus_id, $sp_person_id)
2032  Desc:  merge locus X with this locus. The merged locus will be set to obsolete.
2033  Ret:   nothing
2034  Args:  the id of the locus to be merged
2035  Side Effects: all data associated with the merged locus will now be associated with the current locus.
2036  Example:
2037
2038 =cut
2039
2040 sub merge_locus {
2041     my $self=shift;
2042     my $merged_locus_id=shift;
2043     my $sp_person_id=shift;
2044     my $m_locus=CXGN::Phenome::Locus->new($self->get_dbh(), $merged_locus_id);
2045     $self->d( "*****locus.pm: calling merge_locus...merging locus " . $m_locus->get_locus_id() . " with locus ". $self->get_locus_id() . " \n");
2046     eval {
2047         my @m_owners=$m_locus->get_owners();
2048         foreach my $o (@m_owners) {
2049             my $o_id= $self->add_owner($o, $sp_person_id);
2050             $self->d( "merge_locus is adding owner $o to locus " . $self->get_locus_id() . "\n**") if $o_id;
2051         }
2052         $self->d( "merge_locus checking for aliases ....\n");
2053         my @m_aliases=$m_locus->get_locus_aliases();
2054         foreach my $alias(@m_aliases) {
2055             $self->add_locus_alias($alias);
2056             $self->d( "merge_locus is adding alias " . $alias->get_locus_alias() . " to locus " . $self->get_locus_id() . "\n**");
2057         }
2058         my @unigenes=$m_locus->get_unigenes();
2059         foreach my $u(@unigenes) {
2060             my $u_id= $u->get_unigene_id();
2061             $self->add_unigene($u_id, $sp_person_id);
2062             $self->d( "merge_locus is adding unigene $u to locus" . $self->get_locus_id() . "\n**");
2063         }
2064         my @alleles=$m_locus->get_alleles();
2065         foreach my $allele(@alleles) {
2066             $self->d( "adding allele ........\n");
2067             #reset allele id for storing a new one for the current locus
2068             $allele->set_allele_id(undef);
2069             my $allele_id=$self->add_allele($allele);
2070             $self->d( "merge_locus is adding allele $allele_id " . $allele->get_allele_symbol() . "to locus" . $self->get_locus_id() . "\n**");
2071
2072             #find the stocks of the current allele
2073             my $stock_ids = $allele->get_stock_ids;
2074             #associated stocks with the newly inserted allele
2075             foreach my $stock_id(@$stock_ids) {
2076                 $allele->associate_stock($stock_id, $sp_person_id);
2077                 $self->d( "merge_locus is adding allele $allele_id to *stock* $stock_id n**");
2078             }
2079         }
2080
2081         my @figures=$m_locus->get_figures();
2082         foreach my $image(@figures) {
2083             $self->add_figure($image->get_image_id(), $sp_person_id);
2084             $self->d( "merge_locus is adding figure" . $image->get_image_id() . " to locus " . $self->get_locus_id() . "\n**");
2085         }
2086
2087         my @dbxrefs=$m_locus->get_dbxrefs();
2088         foreach my $dbxref(@dbxrefs) {
2089             my $ldbxref=$m_locus->get_locus_dbxref($dbxref); #the old locusDbxref object
2090             my @ld_evs=$ldbxref->get_locus_dbxref_evidence(); #some have evidence codes
2091             my $ldbxref_id=$self->add_locus_dbxref($dbxref, undef, $ldbxref->get_sp_person_id()); #store the new locus_dbxref..
2092             $self->d( "merge_locus is adding dbxref " . $dbxref->get_dbxref_id() . "to locus " . $self->get_locus_id() . "\n");
2093             foreach my $ld_ev ( @ld_evs) {
2094                 if ($ld_ev->get_object_dbxref_evidence_id() ) {
2095                     $ld_ev->set_object_dbxref_evidence_id(undef);
2096                     $ld_ev->set_object_dbxref_id($ldbxref_id);
2097                     $ld_ev->store(); #store the new locus_dbxref_evidence
2098                 }
2099             }
2100         }
2101         #Add this locus to all the groups of the merged locus
2102         my @groups=$m_locus->get_locusgroups();
2103
2104         my $schema;
2105
2106         if ($groups[0]) { $schema = $groups[0]->get_schema(); }
2107         foreach my $group (@groups) {
2108             my $m_lgm = $group->get_object_row()->
2109                 find_related('locusgroup_members', { locus_id => $m_locus->get_locus_id() } );
2110             #see if the locus is already a member of the group
2111             my $existing_member= $group->get_object_row()->
2112                 find_related('locusgroup_members', { locus_id => $self->get_locus_id() } );
2113             if (!$existing_member) {
2114                 my $lgm=CXGN::Phenome::LocusgroupMember->new($schema);
2115                 $lgm->set_locusgroup_id($m_lgm->get_column('locusgroup_id') );
2116                 $lgm->set_locus_id($self->get_locus_id() );
2117                 $lgm->set_evidence_id($m_lgm->get_column('evidence_id'));
2118                 $lgm->set_reference_id($m_lgm->get_column('reference_id'));
2119                 $lgm->set_sp_person_id($m_lgm->get_column('sp_person_id'));
2120                 $lgm->set_direction($m_lgm->get_column('direction'));
2121                 $lgm->set_obsolete($m_lgm->get_column('obsolete'));
2122                 $lgm->set_create_date($m_lgm->get_column('create_date'));
2123                 $lgm->set_modified_date($m_lgm->get_column('modified_date'));
2124                 my $lgm_id= $lgm->store();
2125             }
2126             $self->d( "obsoleting group member... \n");
2127             $m_lgm->set_column(obsolete => 't');
2128             $m_lgm->update();
2129         }
2130         #concatenate description
2131         my $self_description = $self->get_description . "\n" if $self->get_description ;
2132         $self->set_description($self_description  . $m_locus->get_description) ;
2133         #update chromosome and arm, but only if null in $self locus
2134         $self->set_linkage_group($m_locus->get_linkage_group) if !$self->get_linkage_group;
2135         $self->set_lg_arm($m_locus->get_lg_arm) if !$self->get_lg_arm;
2136         ##update genome locus identifier
2137         $self->set_genome_locus($m_locus->get_genome_locus) if !$self->get_genome_locus;
2138         #update gene activity
2139         $self->set_gene_activity($m_locus->get_gene_activity) if !$self->get_gene_activity;
2140         #
2141         $self->store();
2142         $self->d( "Obsoleting merged locus... \n");
2143         #last step is to obsolete the old locus. All associated objects (images, alleles, individuals..) should not display obsolete objects on the relevant pages!
2144         $m_locus->delete();
2145     };
2146     if ($@) {
2147         my $error = "Merge locus failed! \n $@\n\nCould not merge locus $merged_locus_id with locus " . $self->get_locus_id() . "\n";
2148         return $error;
2149     } else {
2150         $self->d( "merging locus succeded ! \n");
2151         return undef;
2152     }
2153 }
2154
2155 =head2 get_locus_stats
2156
2157  Usage: CXGN::Phenome::Locus->get_locus_stats($dbh)
2158  Desc:  class function. Find the status of the locus database by month.
2159  Ret:   List of lists [locus_count], [month/year]]
2160  Args:  dbh
2161  Side Effects: none
2162  Example:
2163
2164 =cut
2165
2166
2167 sub get_locus_stats {
2168     my $self=shift;
2169     my $dbh=shift;
2170     my $query = "select count (locus_id), date_part('month', create_date) as month , date_part('year', create_date) as year from phenome.locus group by month, year order by year, month asc";
2171     my $sth=$dbh->prepare($query);
2172     $sth->execute();
2173     my @stats;
2174     my $count;
2175     while (my ($loci, $month, $year) = $sth->fetchrow_array()) {
2176         $year= substr($year, -2);
2177         $count +=$loci;
2178         push @{ $stats[0] }, "$month/$year";
2179         push @{ $stats[1] }, $count;
2180     }
2181     return @stats;
2182 }
2183
2184 =head2 get_locusgroups
2185
2186  Usage: $self->get_locusgroups()
2187  Desc:  Find all the locus groups this locus is a member of
2188  Ret:   a list of CXGN::Phenome::LocusGroup objects (DBIx::Class ojects! )
2189  Args:  none
2190  Side Effects: connects to CXGN::Phenome::Schema
2191  Example:
2192
2193 =cut
2194
2195 sub get_locusgroups {
2196     my $self=shift;
2197     my $locus_id = $self->get_locus_id();
2198     my $schema= CXGN::Phenome::Schema->connect(
2199         sub { $self->get_dbh->clone } ,
2200         { on_connect_do => ['set search_path to phenome'] },
2201         );
2202     my @members= $schema->resultset('LocusgroupMember')->search(
2203         {
2204             locus_id => $locus_id ,
2205             obsolete => 'f',
2206         });
2207     my @lgs;
2208     foreach my $member (@members) {
2209         my $group_id = $member->get_column('locusgroup_id');
2210         my $lg= CXGN::Phenome::LocusGroup->new($schema, $group_id);
2211         push @lgs, $lg;
2212     }
2213     return @lgs;
2214 }
2215
2216 =head2 count_associated_loci
2217
2218  Usage: $self->count_associated_loci()
2219  Desc:  count the number of loci associated with this locus
2220  Ret: an integer
2221  Args: none
2222  Side Effects:
2223  Example:
2224
2225 =cut
2226
2227 sub count_associated_loci {
2228     my $self=shift;
2229     my $locus_id=$self->get_locus_id();
2230     my $count=0;
2231     my @locus_groups= $self->get_locusgroups();
2232     foreach my $group(@locus_groups) {
2233         my @members= $group->get_locusgroup_members();
2234         foreach my $member(@members) {
2235             my $member_locus_id= $member->get_column('locus_id');
2236             if (( $member->obsolete() == 0 ) &&  ($member_locus_id != $locus_id) ) {
2237                 $count++;
2238             }
2239         }
2240     }
2241     return $count;
2242 }
2243
2244 =head2 count_ontology_annotations
2245
2246  Usage: $self->count_ontology_annotations()
2247  Desc:  count the number of non-obsolete ontology terms  with this locus directly or indirectly via alleles
2248  Ret: an integer
2249  Args: none
2250  Side Effects:
2251  Example:
2252
2253 =cut
2254
2255 sub count_ontology_annotations {
2256     my $self=shift;
2257     my $locus_id=$self->get_locus_id();
2258
2259     my $query = "SELECT count(distinct(cvterm_id)) FROM public.cvterm
2260                 JOIN phenome.locus_dbxref USING (dbxref_id) JOIN phenome.locus_dbxref_evidence USING (locus_dbxref_id)
2261                 LEFT JOIN phenome.allele_dbxref USING  (dbxref_id)
2262                 LEFT JOIN phenome.allele USING (allele_id)
2263                 WHERE locus_dbxref.locus_id=? AND locus_dbxref.obsolete='f' AND locus_dbxref_evidence.obsolete='f'
2264                 OR allele_dbxref.obsolete = 'f'";
2265     my $sth=$self->get_dbh()->prepare($query);
2266     $sth->execute($locus_id);
2267     my ($count)= $sth->fetchrow_array();
2268
2269     return $count;
2270 }
2271
2272
2273 ###
2274 1;#do not remove
2275 ###
2276
2277
2278