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