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