lib/SGN/Controller/AJAX/Locus.pm

   1 =head1 NAME
   2
   3 SGN::Controller::AJAX::Locus - a REST controller class to provide the
   4 backend for objects linked with loci
   5
   6 =head1 DESCRIPTION
   7
   8 Browse the locus database for selecting loci to be linked with other objects
   9
  10 =head1 AUTHOR
  11
  12 Lukas Mueller <lam87@cornell.edu>
  13 Naama Menda <nm249@cornell.edu>
  14
  15
  16 =cut
  17
  18 package SGN::Controller::AJAX::Locus;
  19
  20 use Moose;
  21
  22 use CXGN::Phenome::LocusDbxref;
  23 use CXGN::Phenome::Locus::LocusDbxrefEvidence;
  24 use CXGN::Phenome::LocusgroupMember;
  25 use CXGN::Chado::Publication;
  26 use CXGN::Page::FormattingHelpers qw/ columnar_table_html info_table_html html_alternate_show /;
  27 use List::MoreUtils qw /any /;
  28 use Scalar::Util qw(looks_like_number);
  29 use CXGN::Tools::Organism;
  30 use CXGN::Phenome::Schema;
  31 use Try::Tiny;
  32
  33
  34 BEGIN { extends 'Catalyst::Controller::REST' }
  35
  36 __PACKAGE__->config(
  37     default   => 'application/json',
  38     stash_key => 'rest',
  39     map       => { 'application/json' => 'JSON', 'text/html' => 'JSON' },
  40    );
  41
  42
  43 =head2 autocomplete
  44
  45 Public Path: /ajax/locus/autocomplete
  46
  47 Autocomplete a locus name.  Takes a single GET param,
  48 C<term>, responds with a JSON array of completions for that term.
  49
  50 =cut
  51
  52 sub autocomplete : Local : ActionClass('REST') { }
  53
  54 sub autocomplete_GET : Args(0) {
  55     my ( $self, $c ) = @_;
  56     my $mode = $c->req->param('mode');
  57     my $term = $c->req->param('term');
  58     my $common_name_id = $c->req->param('common_name_id');
  59     my $common_name = $c->req->param('common_name');
  60     # trim and regularize whitespace
  61     $term =~ s/(^\s+|\s+)$//g;
  62     $term =~ s/\s+/ /g;
  63
  64     if ($common_name) {
  65         my $q = "SELECT common_name_id FROM sgn.common_name where common_name = ? ";
  66         my $sth = $c->dbc->dbh->prepare($q);
  67         $sth->execute($common_name);
  68         ($common_name_id) = $sth->fetchrow_array ;
  69     }
  70     my @results;
  71     if ($mode eq "no_alleles") {
  72         my $q = "SELECT locus_symbol, locus_name, locus_id FROM locus
  73                  WHERE (locus_name ilike '%$term%' OR  locus_symbol ilike '%$term%')
  74                  AND locus.obsolete = 'f' ";
  75         if ($common_name_id)  { $q .= " AND common_name_id = $common_name_id "; }
  76         $q .= " LIMIT 20";
  77         my $sth = $c->dbc->dbh->prepare($q);
  78         $sth->execute;
  79         while (my ($locus_symbol, $locus_name, $locus_id) = $sth->fetchrow_array ) {
  80             push @results , "$locus_name|$locus_symbol|$locus_id" ;
  81         }
  82     } else {
  83         my $q =  "SELECT  locus_symbol, locus_name, allele_symbol, is_default
  84                   FROM locus JOIN allele USING (locus_id)
  85                   WHERE (locus_name ilike '%$term%' OR  locus_symbol ilike '%$term%')
  86                   AND locus.obsolete = 'f' AND allele.obsolete='f' ";
  87         if ($common_name_id)  { $q .= " AND common_name_id = $common_name_id "; }
  88         $q .= " LIMIT 20";
  89         my $sth = $c->dbc->dbh->prepare($q);
  90         $sth->execute;
  91         while (my ($locus_symbol, $locus_name, $allele_symbol, $is_default) = $sth->fetchrow_array ) {
  92             my $allele_data = "Allele: $allele_symbol"  if !$is_default  ;
  93             no warnings 'uninitialized';
  94             push @results , "$locus_name ($locus_symbol) $allele_data";
  95         }
  96     }
  97     $c->stash->{rest} = \@results;
  98 }
  99
 100 =head2 genome_autocomplete
 101
 102 Public Path: /ajax/locus/genome_autocomplete
 103
 104 Autocomplete a genome locus name.  Takes a single GET param,
 105 C<term>, responds with a JSON array of completions for that term.
 106 Genome locus names are stored in the Chado feature table
 107
 108 =cut
 109
 110 sub genome_autocomplete : Local : ActionClass('REST') { }
 111
 112 sub genome_autocomplete_GET :Args(0) {
 113     my ( $self, $c ) = @_;
 114     my $term = $c->req->param('term');
 115     # trim and regularize whitespace
 116     $term =~ s/(^\s+|\s+)$//g;
 117     $term =~ s/\s+/ /g;
 118     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 119     my @results;
 120     my @feature_names = $schema->resultset("Sequence::Feature")->search(
 121         { 'me.name'        => { 'like' => 'Solyc%' },
 122           'me.uniquename'  => { 'ilike' => '%' . $term  . '%' } ,
 123           'type.name'      => 'gene' },
 124         { prefetch    => 'type',
 125           select      => 'me.name' ,
 126           rows        => 20 ,}
 127         )->get_column('me.name')->all;
 128     map ( s/\.\d+$// ,  @feature_names) ;
 129     $c->stash->{rest} = \@feature_names;
 130 }
 131
 132
 133
 134 sub display_ontologies : Chained('/locus/get_locus') :PathPart('ontologies') : ActionClass('REST') { }
 135
 136 sub display_ontologies_GET  {
 137     my ($self, $c) = @_;
 138     $c->forward('/locus/get_locus_dbxrefs');
 139     my $locus = $c->stash->{locus};
 140     my $locus_id = $locus->get_locus_id;
 141     my $schema = $c->dbic_schema("Bio::Chado::Schema", 'sgn_chado');
 142     ##############
 143     #hash of arrays. keys=dbname values= dbxref objects
 144     my %dbs = $locus->get_dbxref_lists();
 145     my (@alleles) = $locus->get_alleles();
 146
 147     #add the allele dbxrefs to the locus dbxrefs hash...
 148     #This way the allele associated ontologies
 149     #it might be a good idea to print a link to the allele next to each allele-derived annotation
 150     foreach my $a (@alleles) {
 151             my %a_dbs = $a->get_dbxref_lists();
 152             foreach my $a_db_name ( keys %a_dbs )
 153             {    #add allele_dbxrefs to the locus_dbxrefs list
 154                 my %seen = () ; #hash for assisting filtering of duplicated dbxrefs (from allele annotation)
 155                 foreach ( @{ $dbs{$a_db_name} } ) {
 156                     $seen{ $_->[0]->get_accession() }++;
 157                 }    #populate with the locus_dbxrefs
 158                 foreach ( @{ $a_dbs{$a_db_name} } ) {    #and filter duplicates
 159                     push @{ $dbs{$a_db_name} }, $_
 160                         unless $seen{ $_->[0]->get_accession() }++;
 161                 }
 162             }
 163     }
 164     my $hashref;
 165     # need to check if the user is logged in, and has editing privileges
 166     my $privileged;
 167     if ($c->user) {
 168         if ( $c->user->check_roles('curator') || $c->user->check_roles('submitter')  || $c->user->check_roles('sequencer') ) { $privileged = 1; }
 169     }
 170     my $trait_db_name = $c->config->{trait_ontology_db_name} || 'SP';
 171     #now add all GO PO SP CO annotations to an array
 172     my @ont_annot;
 173     foreach ( @{ $dbs{'GO'} } ) { push @ont_annot, $_; }
 174     foreach ( @{ $dbs{'PO'} } ) { push @ont_annot, $_; }
 175     foreach ( @{ $dbs{ $trait_db_name } } ) { push @ont_annot, $_; }
 176     my @obs_annot;
 177     my %ont_hash = () ; #keys= cvterms, values= hash of arrays (keys= ontology details, values= list of evidences)
 178     foreach (@ont_annot) {
 179         my $cv_name      = $_->[0]->get_cv_name();
 180         my $cvterm_id    = $_->[0]->get_cvterm_id();
 181         my $cvterm_name  = $_->[0]->get_cvterm_name();
 182         my $db_name      = $_->[0]->get_db_name();
 183         my $accession    = $_->[0]->get_accession();
 184         my $db_accession = $accession;
 185         $db_accession = $cvterm_id if $db_name eq $trait_db_name;
 186         my $url = $_->[0]->get_urlprefix() . $_->[0]->get_url();
 187         my $cvterm_link =
 188             qq |<a href="/cvterm/$cvterm_id/view" target="blank">$cvterm_name</a>|;
 189         my $locus_dbxref = $locus->get_locus_dbxref( $_->[0] );
 190         my @AoH = $locus_dbxref->evidence_details();
 191         for my $href (@AoH) {
 192             my $relationship = $href->{relationship};
 193             my $evidence_id = $href->{dbxref_ev_object}->get_object_dbxref_evidence_id;
 194             my $ontology_url = "/locus/$locus_id/ontologies/";
 195             if ( $href->{obsolete} eq 't' ) {
 196                 my $unobsolete =  qq | <input type = "button" onclick= "javascript:Tools.toggleObsoleteAnnotation('0', \'$evidence_id\',  \'/ajax/locus/toggle_obsolete_annotation\', \'/locus/$locus_id/ontologies\')" value = "unobsolete" /> | if $privileged ;
 197                 push @obs_annot,
 198                 $href->{relationship} . " "
 199                     . $cvterm_link . " ("
 200                     . $href->{ev_code} . ")"
 201                     . $unobsolete;
 202             }
 203             else {
 204                 my $ontology_details = $href->{relationship}
 205                 . qq| $cvterm_link ($db_name:<a href="$url$db_accession" target="blank"> $accession</a>)<br />|;
 206                 my $obsolete_link =  qq | <input type = "button" onclick="javascript:Tools.toggleObsoleteAnnotation('1', \'$evidence_id\',  \'/ajax/locus/toggle_obsolete_annotation\', \'/locus/$locus_id/ontologies\')" value ="delete" /> | if $privileged ;
 207
 208                 ##################
 209                 # add an empty row if there is more than 1 evidence code
 210                 my $ev_string;
 211                 $ev_string .= "<hr />"
 212                     if $ont_hash{$cv_name}{$ontology_details};
 213                 no warnings 'uninitialized';
 214                 $ev_string .=
 215                     $href->{ev_code}
 216                 . "<br />"
 217                     . $href->{ev_desc}
 218                 . "<br /><a href=\""
 219                     . $href->{ev_with_url} . "\">"
 220                     . $href->{ev_with_acc}
 221                 . "</a><br /><a href=\""
 222                     . $href->{reference_url} . "\">"
 223                     . $href->{reference_acc}
 224                 . "</a><br />"
 225                     . $href->{submitter}
 226                 . $obsolete_link;
 227                 $ont_hash{$cv_name}{$ontology_details} .= $ev_string;
 228             }
 229         }
 230     }
 231     my $ontology_evidence;
 232     #now we should have an %ont_hash with all the details we need for printing ...
 233     #hash keys are the cv names ..
 234     for my $cv_name ( sort keys %ont_hash ) {
 235         my @evidence;
 236         #and for each ontology annotation create an array ref of evidences
 237         for my $ont_detail ( sort keys %{ $ont_hash{$cv_name} } ) {
 238             push @evidence,
 239             [ $ont_detail, $ont_hash{$cv_name}{$ont_detail} ];
 240         }
 241         my $ev = join "\n", map {
 242             qq|<div class="term">$_->[0]</div>\n|
 243                 .qq|<div class="evidence">$_->[1]</div>\n|;
 244         } @evidence;
 245         $ontology_evidence .= info_table_html(
 246             $cv_name     => $ev,
 247             __border     => 0,
 248             __tableattrs => 'width="100%"',
 249             );
 250     }
 251     #display ontology annotation form
 252     my $print_obsoleted;
 253     if ( @obs_annot &&  $privileged ) {
 254         #####$ontology_evidence .= print_obsoleted(@obs_annot);
 255         my $obsoleted;
 256         foreach my $term (@obs_annot) {
 257             $obsoleted .= qq |$term  <br />\n |;
 258         }
 259         $print_obsoleted = html_alternate_show(
 260             'obsoleted_terms', 'Show obsolete',
 261             '',                qq|<div class="minorbox">$obsoleted</div> |,
 262             );
 263     }
 264     $hashref->{html} = $ontology_evidence . $print_obsoleted;
 265     $c->stash->{rest} = $hashref;
 266 }
 267
 268 ############
 269 sub associate_ontology:Path('/ajax/locus/associate_ontology') :ActionClass('REST') {}
 270
 271 sub associate_ontology_GET :Args(0) {
 272     my ($self, $c) = @_;
 273     $c->stash->{rest} = { error => "Nothing here, it's a GET.." } ;
 274 }
 275 #########################change this to the locus object !!
 276 sub associate_ontology_POST :Args(0) {
 277     my ( $self, $c ) = @_;
 278      my $dbh = $c->dbc->dbh;
 279      my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 280     my $phenome_schema = $c->dbic_schema('CXGN::Phenome::Schema');
 281     my $cvterm_rs = $schema->resultset('Cv::Cvterm');
 282
 283     my $locus_id       = $c->req->param('object_id');
 284     my $ontology_input = $c->req->param('term_name');
 285      my $relationship   = $c->req->param('relationship'); # a cvterm_id
 286     my ($relationship_id) = $cvterm_rs->find( { cvterm_id => $relationship } )->dbxref_id;
 287     my $evidence_code  = $c->req->param('evidence_code'); # a cvterm_id
 288     my ($evidence_code_id) = $cvterm_rs->find( {cvterm_id => $evidence_code })->dbxref_id;
 289     my $evidence_description = $c->req->param('evidence_description') || undef; # a cvterm_id
 290     my ($evidence_description_id) = $cvterm_rs->find( {cvterm_id => $evidence_description })->dbxref_id if $evidence_description;
 291     my $evidence_with = $c->req->param('evidence_with') || undef; # a dbxref_id (type='evidence_with' value = 'dbxref_id'
 292     my ($evidence_with_id) = $evidence_with if $evidence_with && $evidence_with ne 'null';
 293     my $logged_user = $c->user;
 294     my $logged_person_id = $logged_user->get_object->get_sp_person_id if $logged_user;
 295
 296     my $reference = $c->req->param('reference');
 297     my $reference_id = $reference ? $reference :
 298         CXGN::Chado::Publication::get_curator_ref($dbh);
 299 ##
 300     my ($locus_dbxref, $locus_dbxref_id, $locus_dbxref_evidence);
 301     ##
 302     #solanaceae_phenotype--SP:000001--fruit size
 303     my ($cv_name, $db_accession, $cvterm_name)  = split /--/ , $ontology_input;
 304     my ($db_name, $accession) = split ':' , $db_accession;
 305
 306     my ($cvterm) = $schema
 307         ->resultset('General::Db')
 308         ->search({ 'me.name' => $db_name, } )->search_related('dbxrefs' , { accession => $accession } )
 309         ->search_related('cvterm')->first; # should be only 1 cvterm per dbxref
 310     if (!$cvterm) {
 311         $c->stash->{rest} = { error => "no ontology term found for term $db_name : $accession" };
 312         return;
 313     }
 314     my $locus = CXGN::Phenome::Locus->new($dbh, $locus_id);
 315     my $cvterm_id = $cvterm->cvterm_id;
 316     my $dbxref_id  = $cvterm->dbxref_id;
 317     if (!$c->user) {
 318         $c->stash->{rest} = { error => 'Must be logged in for associating ontology terms! ' };
 319         return;
 320     }
 321     if ( any { $_ eq 'curator' || $_ eq 'submitter' || $_ eq 'sequencer' } $c->user->roles() ) {
 322         # if this fails, it will throw an acception and will (probably
 323         # rightly) be counted as a server error
 324         #########################################################
 325         if ($locus->get_locus_id && $cvterm_id) {
 326             try {
 327                 #check if the locus cvterm annotation exists. These annotations are stored in locus_dbxref
 328
 329                 $locus_dbxref_id= CXGN::Phenome::LocusDbxref::locus_dbxref_exists($dbh,$locus_id, $dbxref_id);
 330                 $locus_dbxref=CXGN::Phenome::LocusDbxref->new($dbh, $locus_dbxref_id);
 331                 $locus_dbxref->set_locus_id($locus_id);
 332
 333                 $locus_dbxref_evidence= CXGN::Phenome::Locus::LocusDbxrefEvidence->new($dbh);
 334
 335                 $locus_dbxref->set_dbxref_id($dbxref_id);
 336                 $locus_dbxref->set_sp_person_id($logged_person_id);
 337
 338                 #this store should insert a new locus_dbxref if !$locus_dbxref_id
 339                 #update obsolete to 'f' if $locus_dbxref_id and obsolete ='t'
 340                 #do nothing if $locus_dbxref_id and obsolete = 'f'
 341                 my $obsolete = $locus_dbxref->get_obsolete();
 342
 343                 #if the dbxref exists this should just return the database id to be used for
 344                 #storing a  dbxref_evidence
 345                 $locus_dbxref_id = $locus_dbxref->store;
 346                 #print STDERR "object_dbxref_id = $object_dbxref_id ! \n";
 347                 $locus_dbxref_evidence->set_object_dbxref_id($locus_dbxref_id);
 348                 $locus_dbxref_evidence->set_relationship_type_id($relationship_id);
 349                 $locus_dbxref_evidence->set_evidence_code_id($evidence_code_id);
 350                 $locus_dbxref_evidence->set_evidence_description_id($evidence_description_id);
 351                 $locus_dbxref_evidence->set_evidence_with($evidence_with_id);
 352                 $locus_dbxref_evidence->set_reference_id($reference_id);
 353                 $locus_dbxref_evidence->set_sp_person_id($logged_person_id);
 354
 355                 my $locus_dbxref_evidence_id = $locus_dbxref_evidence->store ;
 356 ##########################################
 357             } catch {
 358                 $c->stash->{rest} = { error => "Failed: $_" };
 359                 # send an email to sgn bugs
 360                 $c->stash->{email} = {
 361                     to      => 'sgn-bugs@sgn.cornell.edu',
 362                     from    => 'sgn-bugs@sgn.cornell.edu',
 363                     subject => "Associate ontology failed! locus_id = $locus_id",
 364                     body    => $_,
 365                 };
 366                 $c->forward( $c->view('Email') );
 367                 return;
 368             };
 369             # if you reached here this means associate_ontology worked. Now send an email to sgn-db-curation
 370             $c->stash->{rest} = { success => "1" };
 371             $c->stash->{email} = {
 372                 to      => 'sgn-db-curation@sgn.cornell.edu',
 373                 from    => 'www-data@sgn-vm.sgn.cornell.edu',
 374                 subject => "New ontology term loaded. Locus $locus_id",
 375                 body    => "User " . $logged_user->get_object->get_first_name . " " . $logged_user->get_object->get_last_name . "has stored a new ontology term for locus $locus_id http://solgenomics.net/locus/$locus_id/view",
 376             };
 377             $c->forward( $c->view('Email') );
 378         } else {
 379             $c->stash->{rest} = { error => 'need both valid locus_id and cvterm_id for adding an ontology term to this locus! ' };
 380         }
 381     } else {
 382         $c->stash->{rest} = { error => 'No privileges for adding new ontology terms. You must have an sgn submitter account. Please contact sgn-feedback@solgenomics.net for upgrading your user account. ' };
 383     }
 384     return;
 385 }
 386
 387 sub references : Chained('/locus/get_locus') :PathPart('references') : ActionClass('REST') { }
 388
 389
 390 sub references_GET :Args(0) {
 391     my ($self, $c) = @_;
 392     my $locus = $c->stash->{locus};
 393     # get a list of references
 394     my $q = "SELECT dbxref.dbxref_id, accession,title
 395                                           FROM public.dbxref
 396                                           JOIN public.pub_dbxref USING (dbxref_id)
 397                                           JOIN public.pub USING (pub_id)
 398                                           JOIN phenome.locus_dbxref USING (dbxref_id)
 399                                           WHERE locus_id= ?
 400                                           AND phenome.locus_dbxref.obsolete = 'f'";
 401     my $sth = $c->dbc->dbh->prepare($q);
 402     $sth->execute($locus->get_locus_id);
 403     my $response_hash={};
 404     while (my ($dbxref_id, $accession, $title) = $sth->fetchrow_array) {
 405         $response_hash->{$accession . ": " . $title} = $dbxref_id;
 406     }
 407     $c->stash->{rest} = $response_hash;
 408 }
 409
 410 sub evidences : Chained('/locus/get_locus') :PathPart('evidences') : ActionClass('REST') { }
 411
 412 sub evidences_GET :Args(0) {
 413     my ($self, $c) = @_;
 414     my $locus = $c->stash->{locus};
 415     # get a list of evidences
 416     my $q = "SELECT dbxref.dbxref_id, accession,name, description
 417                                           FROM public.dbxref
 418                                           JOIN feature USING (dbxref_id)
 419                                           JOIN phenome.locus_dbxref USING (dbxref_id)
 420                                           WHERE locus_id= ?
 421                                           AND phenome.locus_dbxref.obsolete = 'f'" ;
 422     my $sth = $c->dbc->dbh->prepare($q);
 423     $sth->execute($locus->get_locus_id);
 424     my $response_hash={};
 425     while (my ($dbxref_id, $accession, $name, $description) = $sth->fetchrow_array) {
 426         $response_hash->{$name . ": " . $description} = $dbxref_id ;
 427     }
 428     $c->stash->{rest} = $response_hash;
 429 }
 430
 431 sub toggle_obsolete_annotation : Path('/ajax/locus/toggle_obsolete_annotation') : ActionClass('REST') { }
 432
 433 sub toggle_obsolete_annotation_POST :Args(0) {
 434     my ($self, $c) = @_;
 435     my $locus = $c->stash->{locus};
 436     my $locus_dbxref_evidence_id = $c->request->body_parameters->{id};
 437     my $obsolete = $c->request->body_parameters->{obsolete};
 438
 439     my $response = {} ;
 440     if ($locus_dbxref_evidence_id && $c->user ) {
 441         my $locus_dbxref_evidence = $c->dbic_schema('CXGN::Phenome::Schema')->resultset('LocusDbxrefEvidence')->find( {
 442             locus_dbxref_evidence_id => $locus_dbxref_evidence_id });
 443         if ($locus_dbxref_evidence) {
 444             $locus_dbxref_evidence->update( { obsolete => $obsolete } );
 445             $response->{response} = "success";
 446         }else { $response->{error} = "No locus evidence found for locus_dbxref_evidence_id $locus_dbxref_evidence_id! "; }
 447         #set locus_dbxref_evidence to obsolete
 448     } else { $response->{error} = "locus_dbxref_evidence $locus_dbxref_evidence_id does not exists! ";  }
 449     $c->stash->{rest} = $response;
 450 }
 451
 452 sub locus_network : Chained('/locus/get_locus') :PathPart('network') : ActionClass('REST') { }
 453
 454 sub locus_network_GET :Args(0) {
 455     my ($self, $c) = @_;
 456     my $locus = $c->stash->{locus};
 457     my $locus_id = $locus->get_locus_id;
 458     my $privileged;
 459     if ($c->user) {
 460         if ( $c->user->check_roles('curator') || $c->user->check_roles('submitter')  || $c->user->check_roles('sequencer') ) { $privileged = 1; }
 461     }
 462     my $dbh = $c->dbc->dbh;
 463     my @locus_groups = $locus->get_locusgroups();
 464     my $direction;
 465     my $al_count = 0;
 466     my $associated_loci;
 467     my %rel = ();
 468   GROUP: foreach my $group (@locus_groups) {
 469       my $relationship = $group->get_relationship_name();
 470       my @members      = $group->get_locusgroup_members();
 471       my $members_info;
 472       my $index = 0;
 473       my %by_organism;
 474 #check if group has only 1 member. This means the locus itself is the only member (other members might have been obsolete)
 475       if ( $group->count_members() == 1 ) { next GROUP; }
 476     MEMBER: foreach my $member (@members) {
 477         if ( $member->obsolete() == 1 ) {
 478             delete $members[$index];
 479             $index++;
 480             next MEMBER;
 481         }
 482         my ($organism, $associated_locus_name, $gene_activity);
 483         my $member_locus_id = $member->get_column('locus_id');
 484         my $member_direction = $member->direction() || '';
 485         my $lgm_id = $member->locusgroup_member_id();
 486         if ( $member_locus_id == $locus_id ) {
 487             $direction = $member_direction;
 488         }
 489         else {
 490             $al_count++;
 491             my $associated_locus =
 492                 CXGN::Phenome::Locus->new( $dbh, $member_locus_id );
 493             $associated_locus_name =
 494                 $associated_locus->get_locus_name();
 495             $gene_activity = $associated_locus->get_gene_activity();
 496             $organism      = $associated_locus->get_common_name;
 497             my $lgm_obsolete_link =  $privileged ?
 498                 qq|<a href="javascript:Locus.obsoleteLocusgroupMember(\'$lgm_id\', \'$locus_id\', \'/ajax/locus/obsolete_locusgroup_member\', \'/locus/$locus_id/netwrok\')">[Remove]</a>| : qq| <span class="ghosted">[Remove]</span> |;
 499
 500             $by_organism{$organism} .=
 501                 qq|<a href="/locus/$member_locus_id/view">$associated_locus_name</a> $lgm_obsolete_link <br /> |
 502                 if ( $associated_locus->get_obsolete() eq 'f' );
 503             #directional relationships
 504             if ( $member_direction eq 'subject' ) {
 505                 $relationship = $relationship . ' of';
 506             }
 507         }    #non-self members
 508         $index++;
 509     }    #members
 510       foreach my $common_name (sort keys %by_organism) {
 511           $members_info .= info_table_html(
 512               $common_name => $by_organism{$common_name},
 513               __sub        => 1,
 514               __border     => 0,
 515               );
 516       }
 517       $rel{$relationship} .= $members_info if ( scalar(@members) > 1 );
 518   }    #groups
 519     foreach my $r ( keys %rel ) {
 520         $associated_loci .= info_table_html(
 521             $r           => $rel{$r},
 522             __border     => 0,
 523             __tableattrs => 'width="100%"'
 524             );
 525     }
 526     ################
 527     $c->stash->{rest} = { html => $associated_loci } ;
 528 }
 529
 530
 531 sub associate_locus:Path('/ajax/locus/associate_locus') :ActionClass('REST') {}
 532
 533 sub associate_locus_GET :Args(0) {
 534     my ($self, $c) = @_;
 535     $c->stash->{rest} = { error => "Nothing here, it's a GET.." } ;
 536 }
 537 sub associate_locus_POST :Args(0) {
 538     my ($self, $c) = @_;
 539     my $schema = $c->dbic_schema('CXGN::Phenome::Schema');
 540     my $privileged;
 541     my $response;
 542     if ($c->user) {
 543         if ( $c->user->check_roles('curator') || $c->user->check_roles('submitter')  || $c->user->check_roles('sequencer') ) { $privileged = 1; }
 544     }
 545     my $logged_person_id = $c->user->get_object->get_sp_person_id if $c->user;
 546     my %params = map { $_ => $c->request->body_parameters->{$_} } qw/
 547        locus_info locus_reference_id locus_evidence_code_id
 548        locus_relationship_id locus_id locusgroup_id
 549     /;
 550     my $locus_id = $params{locus_id}; #locus_id is used when making locus-locus association from a locus page
 551     my $locusgroup_id = $params{locusgroup_id} ; #used when adding a locus to an existing group , from the manual gene family page
 552     my $locus_info = $params{locus_info};
 553     my ($locus_name,$locus_symbol,$a_locus_id) = split (/\|/ ,$locus_info);
 554     if (!$locus_info || !$a_locus_id) {
 555         #$self->status_bad_request($c, message => 'need loci param' );
 556         $response->{error} .= "bad request. Invalid locus";
 557     }
 558     my $reference_id = $params{'locus_reference_id'};
 559     $reference_id = $reference_id ? $reference_id :
 560         CXGN::Chado::Publication::get_curator_ref($c->dbc->dbh);
 561 ##
 562     my $relationship;
 563     if ($privileged) {
 564         try {
 565             my $bcs = $c->dbic_schema("Bio::Chado::Schema", 'sgn_chado');
 566             my $cvterm = $bcs->resultset('Cv::Cvterm')->find( { cvterm_id => $params{locus_relationship_id} } );
 567             $relationship=$cvterm->name();
 568             my %directional_rel =
 569                 ('Downstream'=>1,
 570                  'Inhibition'=>1,
 571                  'Activation'=>1
 572                 );
 573             my $directional= $directional_rel{$relationship};
 574             my $lgm=CXGN::Phenome::LocusgroupMember->new($schema);
 575             $lgm->set_locus_id($locus_id );
 576             $lgm->set_evidence_id($params{locus_evidence_code_id});
 577             $lgm->set_reference_id($reference_id);
 578             $lgm->set_sp_person_id($logged_person_id);
 579             my $a_lgm=CXGN::Phenome::LocusgroupMember->new($schema);
 580             $a_lgm->set_locus_id($a_locus_id);
 581             $a_lgm->set_evidence_id($params{locus_evidence_code_id});
 582             $a_lgm->set_reference_id($reference_id);
 583             $a_lgm->set_sp_person_id($logged_person_id);
 584
 585             if ($directional) {
 586                 $lgm->set_direction('subject');
 587                 $a_lgm->set_direction('object')
 588             }
 589             my $locusgroup= $lgm->find_or_create_group($params{locus_relationship_id}, $a_lgm);
 590             my $lg_id= $locusgroup->get_locusgroup_id();
 591             $lgm->set_locusgroup_id($lg_id);
 592             $a_lgm->set_locusgroup_id($lg_id);
 593
 594             my $lgm_id= $lgm->store();
 595             my $algm_id=$a_lgm->store();
 596             $response->{response} = 'success';
 597             return;
 598         } catch {
 599             $response->{error} .= "Failed: $_" ;
 600             # send an email to sgn bugs
 601             $c->stash->{email} = {
 602                 to      => 'sgn-bugs@sgn.cornell.edu',
 603                 from    => 'sgn-bugs@sgn.cornell.edu',
 604                 subject => "Associate locus failed! locus_id = $locus_id",
 605                 body    => $_,
 606             };
 607             $c->forward( $c->view('Email') );
 608             return;
 609         };
 610         # if you reached here this means associate_locus worked. Now send an email to sgn-db-curation
 611         $c->stash->{email} = {
 612             to      => 'sgn-db-curation@sgn.cornell.edu',
 613             from    => 'www-data@sgn-vm.sgn.cornell.edu',
 614             subject => "New locus associated with locus $locus_id",
 615             body    => "User " . $c->user->get_object->get_first_name . " " . $c->user->get_object->get_last_name . "has associated locus $locus_id ($relationship) with locus " . $params{object_id} . "( /solgenomics.net/locus/$locus_id/view )",
 616         };
 617         $c->forward( $c->view('Email') );
 618     } else {
 619         $response->{ error} = 'No privileges for associating loci. You must have an sgn submitter account. Please contact sgn-feedback@solgenomics.net for upgrading your user account. ' ;
 620     }
 621     $c->stash->{rest} = $response;
 622 }
 623
 624
 625 sub obsolete_locusgroup_member : Path('/ajax/locus/obsolete_locusgroup_member') : ActionClass('REST') { }
 626
 627 sub obsolete_locusgroup_member_POST :Args(0) {
 628     my ($self, $c) = @_;
 629     my $locus_id = $c->request->body_parameters->{locus_id};
 630     my $lgm_id = $c->request->body_parameters->{lgm_id};
 631     my $obsolete = $c->request->body_parameters->{obsolete};
 632     my $schema = $c->dbic_schema('CXGN::Phenome::Schema');
 633     my $response = {} ;
 634     if ($lgm_id && $c->user ) {
 635         my $lgm=CXGN::Phenome::LocusgroupMember->new($schema, $lgm_id);
 636         if ($lgm->get_locusgroup_member_id) {
 637             try {
 638                 $lgm->obsolete_lgm();
 639             } catch {
 640                 $c->stash->{rest} = { error => "Failed: $_" };
 641                 $c->stash->{email} = {
 642                     to      => 'sgn-bugs@sgn.cornell.edu',
 643                     from    => 'sgn-bugs@sgn.cornell.edu',
 644                     subject => " /ajax/locus/obsolete_locusgroup_member failed! locus_id = $locus_id, locusgroup_member_id = $lgm_id, obsolete = $obsolete",
 645                     body    => $_,
 646                 };
 647                 $c->forward( $c->view('Email') );
 648                 return;
 649             };
 650             $response->{response} = "success";
 651             $c->stash->{email} = {
 652                 to      => 'sgn-db-curation@sgn.cornell.edu',
 653                 from    => 'www-data@sgn-vm.sgn.cornell.edu',
 654                 subject => "[A locus group member has been obsoleted]",
 655                 body    => "User " . $c->user->get_object->get_first_name . " " . $c->user->get_object->get_last_name .  " has obsoleted locus group member $lgm_id \n ( /solgenomics.net/locus/$locus_id/view )",
 656             };
 657             $c->forward( $c->view('Email') );
 658         }else { $response->{error} = "No locus group member  for locus group member_id $lgm_id! "; }
 659     } else { $response->{error} = "locus group member  $lgm_id does not exists! ";  }
 660     $c->stash->{rest} = $response;
 661 }
 662
 663
 664 sub locus_unigenes : Chained('/locus/get_locus') :PathPart('unigenes') : ActionClass('REST') { }
 665
 666 sub locus_unigenes_GET :Args(0) {
 667     my ($self, $c) = @_;
 668     my $locus = $c->stash->{locus};
 669     my $locus_id = $locus->get_locus_id;
 670     my $privileged;
 671     if ($c->user) {
 672         if ( $c->user->check_roles('curator') || $c->user->check_roles('submitter')  || $c->user->check_roles('sequencer') ) { $privileged = 1; }
 673     }
 674     my $dbh = $c->dbc->dbh;
 675     my $response ={};
 676     try {
 677         my @unigenes = $locus->get_unigenes({current=>1});
 678         my $unigenes;
 679         my $common_name    = $locus->get_common_name();
 680         my %solcyc_species = (
 681             Tomato  => "LYCO",
 682             Potato  => "POTATO",
 683             Pepper  => "CAP",
 684             Petunia => "PET",
 685             Coffee  => "COFFEA"
 686         );
 687         if ( !@unigenes ) {
 688             $unigenes = qq|<span class=\"ghosted\">none</span>|;
 689         }
 690         my @solcyc;
 691         my ( $solcyc_links, $sequence_links );
 692         my $solcyc_count = 0;
 693         foreach my $unigene (@unigenes) {
 694             my $unigene_id    = $unigene->get_unigene_id();
 695             my $unigene_build = $unigene->get_unigene_build();
 696             my $organism_name = $unigene_build->get_organism_group_name();
 697             my $build_nr      = $unigene->get_build_nr();
 698             my $nr_members    = $unigene->get_nr_members();
 699             my $locus_unigene_id = $locus->get_locus_unigene_id($unigene_id);
 700             #
 701             my $unigene_obsolete_link = $privileged ?
 702                 qq | <input type = "button" onclick="javascript:Locus.obsoleteLocusUnigene(\'$locus_unigene_id\',  \'$locus_id\')" value ="Remove" /> |
 703                 : qq| <span class="ghosted">[Remove]</span> |;
 704             #
 705             my $blast_link = "<a href='/tools/blast/?preload_id=SGN-U" . $unigene_id . "&preload_type=15'>[Blast]</a>";
 706             $unigenes .=
 707                 qq|<a href="/search/unigene.pl?unigene_id=$unigene_id">SGN-U$unigene_id</a> $organism_name -- build $build_nr -- $nr_members members $unigene_obsolete_link $blast_link<br />|;
 708
 709             # get solcyc links from the unigene page...
 710             #
 711             foreach my $dbxref ( $unigene->get_dbxrefs() ) {
 712                 if ( $dbxref->get_db_name() eq "solcyc_images" ) {
 713                     my $url       = $dbxref->get_url();
 714                     my $accession = $dbxref->get_accession();
 715                     my ( $species, $reaction_id ) = split /\_\_/, $accession;
 716                     my $description = $dbxref->get_description();
 717                     unless ( grep { /^$accession$/ } @solcyc ) {
 718                         push @solcyc, $accession;
 719                         if ( $solcyc_species{$common_name} =~ /$species/i ) {
 720                             $solcyc_count++;
 721                             $solcyc_links .=
 722                                 qq |  <a href="http://solcyc.solgenomics.net/$species/NEW-IMAGE?type=REACTION-IN-PATHWAY&object=$reaction_id" border="0" ><img src="http://$url$accession.gif" border="0" width="25%" / ></a> |;
 723                         }
 724                     }
 725                 }
 726             }
 727         }
 728
 729         $response->{unigenes} = $unigenes;
 730         $response->{solcyc}   = $solcyc_links;
 731
 732     } catch {
 733         $response->{error} = "Failed: $_" ;
 734         # send an email to sgn bugs
 735         $c->stash->{email} = {
 736             to      => 'sgn-bugs@sgn.cornell.edu',
 737             from    => 'sgn-bugs@sgn.cornell.edu',
 738             subject => "locus_unigenes failed! locus_id = $locus_id",
 739             body    =>  $_,
 740         };
 741         $c->forward( $c->view('Email') );
 742         return;
 743     };
 744     $c->stash->{rest} = $response ;
 745 }
 746
 747
 748
 749 sub obsolete_locus_unigene : Path('/ajax/locus/obsolete_locus_unigene') : ActionClass('REST') { }
 750
 751 sub obsolete_locus_unigene_POST :Args(0) {
 752     my ($self, $c) = @_;
 753     my $locus_unigene_id = $c->request->body_parameters->{locus_unigene_id};
 754     my $locus_id = $c->request->body_parameters->{locus_id};
 755     my $dbh = $c->dbc->dbh;
 756     my $response = {} ;
 757     try {
 758         my $u_query="UPDATE phenome.locus_unigene SET obsolete='t' WHERE locus_unigene_id=?";
 759         my $u_sth=$dbh->prepare($u_query);
 760         $u_sth->execute($locus_unigene_id);
 761     } catch {
 762         $c->stash->{rest} = { error => "Failed: $_" };
 763         $c->stash->{email} = {
 764             to      => 'sgn-bugs@sgn.cornell.edu',
 765             from    => 'sgn-bugs@sgn.cornell.edu',
 766             subject => " /ajax/locus/obsolete_locus_unigene failed! locus_unigene_id = $locus_unigene_id",
 767             body    => $_,
 768         };
 769         $c->forward( $c->view('Email') );
 770         return;
 771     };
 772     $response->{response} = "success";
 773     $c->stash->{email} = {
 774         to      => 'sgn-db-curation@sgn.cornell.edu',
 775         from    => 'www-data@sgn-vm.sgn.cornell.edu',
 776         subject => "[A locus-unigene link has beed obsoleted] locus_id = $locus_id",
 777         body    => "User " . $c->user->get_object->get_first_name . " " . $c->user->get_object->get_last_name .  " has obsoleted locus_unigene_id $locus_unigene_id \n ( /solgenomics.net/locus/$locus_id/view )",
 778     };
 779     $c->forward( $c->view('Email') );
 780     $c->stash->{rest} = $response;
 781 }
 782
 783 sub associate_unigene : Chained('/locus/get_locus') :PathPart('associate_unigene') : ActionClass('REST') { }
 784
 785 sub associate_unigene_POST :Args(0) {
 786     my ($self, $c) = @_;
 787     my  $locus   = $c->stash->{locus};
 788     my $locus_id = $locus->get_locus_id;
 789     my $response;
 790     my $unigene_input = $c->request->body_parameters->{unigene_input};
 791     my ($unigene_id, undef, undef) = split /--/ , $unigene_input;
 792     # "SGN-U$unigene_id--build $build_id--$nr_members members";
 793     $unigene_id =~ s/sgn-u//i ;
 794     if ( !(looks_like_number($unigene_id)) ) {
 795         $response->{ error} = "This does not look like a valid unigene id ($unigene_id). Check your input! \n " ;
 796         $c->stash->{rest} = $response;
 797         return;
 798     }
 799     my $dbh = $c->dbc->dbh;
 800     my $privileged;
 801     if ($c->user) {
 802         if ( $c->user->check_roles('curator') || $c->user->check_roles('submitter')  || $c->user->check_roles('sequencer') ) { $privileged = 1; }
 803     }
 804     my $logged_person_id = $c->user->get_object->get_sp_person_id if $c->user;
 805     if ($privileged) {
 806         try {
 807             print STDERR "****ABOUT TO ADD UNIGENE $unigene_id to locus $locus_id\n\n\n";
 808             my $id = $locus->add_unigene($unigene_id, $logged_person_id);
 809             print STDERR "**DONE id = $id \n\n\n";
 810         } catch {
 811             $response->{error} = "Failed: $_" ;
 812             # send an email to sgn bugs
 813             $c->stash->{email} = {
 814                 to      => 'sgn-bugs@sgn.cornell.edu',
 815                 from    => 'sgn-bugs@sgn.cornell.edu',
 816                 subject => "Associate unigene failed! locus_id = $locus_id",
 817                 body    => $_,
 818             };
 819             $c->forward( $c->view('Email') );
 820             $c->stash->{rest} = $response;
 821             return;
 822         };
 823         # if you reached here this means associate_unigene worked.
 824         #Now send an email to sgn-db-curation
 825         $c->stash->{email} = {
 826             to      => 'sgn-db-curation@sgn.cornell.edu',
 827             from    => 'www-data@sgn-vm.sgn.cornell.edu',
 828             subject => "New unigene associated with locus $locus_id",
 829             body    => "User " . $c->user->get_object->get_first_name . " " . $c->user->get_object->get_last_name . "has associated unigene $unigene_id  with locus $locus_id " . "( /solgenomics.net/locus/$locus_id/view )",
 830         };
 831         $c->forward( $c->view('Email') );
 832         $response->{response} = "success";
 833     } else {
 834         $response->{ error} = 'No privileges for associating unigenes. You must have an sgn submitter account. Please contact sgn-feedback@solgenomics.net for upgrading your user account. ' ;
 835     }
 836     $c->stash->{rest} = $response;
 837 }
 838
 839 sub display_owners : Chained('/locus/get_locus') :PathPart('owners') : ActionClass('REST') { }
 840
 841 sub display_owners_GET  {
 842     my ($self, $c) = @_;
 843     $c->forward('/locus/get_locus_owner_objects');
 844     my $owners = $c->stash->{owner_objects};
 845     my $dbh = $c->dbc->dbh;
 846     my $locus = $c->stash->{locus};
 847     my $owners_html;
 848
 849     my $hashref;
 850     foreach my $person (@$owners) {
 851         my $first_name = $person->get_first_name();
 852         my $last_name  = $person->get_last_name();
 853         my $id = $person->get_sp_person_id();
 854         if ($person->get_user_type() eq 'curator' && scalar(@$owners) == 1  ) {
 855             $owners_html .= '<b>No editor assigned</b>';
 856         } else {
 857             $owners_html .=
 858                 qq |<a href="/solpeople/personal-info.pl?sp_person_id=$id">$first_name $last_name</a>;|;
 859         }
 860     }
 861     chop $owners_html;
 862
 863     $hashref->{html} = "<p>Locus editors: $owners_html </p> ";
 864     $c->stash->{rest} = $hashref;
 865 }
 866
 867 sub assign_owner:Path('/ajax/locus/assign_owner') :ActionClass('REST') {}
 868
 869 sub assign_owner_GET :Args(0) {
 870     my ($self, $c) = @_;
 871     $c->stash->{rest} = { error => "Nothing here, it's a GET.." } ;
 872 }
 873 sub assign_owner_POST :Args(0) {
 874     my ($self, $c) = @_;
 875     my $schema = $c->dbic_schema('CXGN::Phenome::Schema');
 876     my $privileged;
 877     my $response;
 878     my $logged_person_id;
 879     if ($c->user) {
 880         if ( $c->user->check_roles('curator') ) { $privileged = 1; }
 881         $logged_person_id = $c->user->get_object->get_sp_person_id ;
 882     }
 883
 884     my %params = map { $_ => $c->request->body_parameters->{$_} } qw/
 885        sp_person
 886        object_id
 887     /;
 888     my $sp_person = $params{sp_person};
 889     my ($first_name, $last_name , $sp_person_id) = split ',' , $sp_person;
 890     my $locus_id  = $params{object_id};
 891     if ($privileged && $locus_id) {
 892         my $dbh = $c->dbc->dbh;
 893         my $new_owner = CXGN::People::Person->new( $dbh, $sp_person_id );
 894         try {
 895             #if the new owner is not a submitter, assign that role
 896             if ( !$new_owner->has_role('submitter') ) {
 897                 $new_owner->add_role('submitter');
 898             }
 899             my $new_locus_owner = $schema->resultset('LocusOwner')->find_or_create(
 900                 {
 901                     sp_person_id => $sp_person_id,
 902                     locus_id     => $locus_id,
 903                     granted_by   => $logged_person_id
 904                 });
 905             #if the current owner of the locus is a logged-in SGN curator, do an obsolete
 906             my $remove_curator_query =
 907                 "UPDATE phenome.locus_owner SET obsolete='t', modified_date= now()
 908                   WHERE locus_id=? AND sp_person_id IN
 909                     (SELECT sp_person_id FROM sgn_people.sp_person_roles WHERE sp_role_id  = (SELECT sp_role_id FROM sgn_people.sp_roles WHERE name = 'curator') )";
 910             my $remove_curator_sth =
 911                 $dbh->prepare($remove_curator_query);
 912             $remove_curator_sth->execute($locus_id);
 913         }
 914         catch {
 915             $response->{error} = "Failed: $_" ;
 916             # send an email to sgn bugs
 917             $c->stash->{email} = {
 918                 to      => 'sgn-bugs@sgn.cornell.edu',
 919                 from    => 'sgn-bugs@sgn.cornell.edu',
 920                 subject => "assign_owner failed! locus_id = $locus_id",
 921                 body    => $_,
 922             };
 923             $c->forward( $c->view('Email') );
 924             $c->stash->{rest} = $response;
 925         };
 926         # if you reached here this means assign_owner worked. Now send an email to sgn-db-curation
 927         $response->{response} = "success";
 928         my $owner_link =
 929             qq |/solpeople/personal-info.pl?sp_person_id=$sp_person_id|;
 930         $c->stash->{email} = {
 931             to      => 'sgn-db-curation@sgn.cornell.edu',
 932             from    => 'www-data@sgn-vm.sgn.cornell.edu',
 933             subject => "New owner $sp_person assigned to locus $locus_id",
 934             body    => "Curator " . $c->user->get_object->get_first_name . " " . $c->user->get_object->get_last_name . "has assigned owner $sp_person ($owner_link) to locus $locus_id"  . "( /solgenomics.net/locus/$locus_id/view )",
 935         };
 936         $c->forward( $c->view('Email') );
 937     } else {
 938         $response->{error} = 'No privileges for assigning new owner. You must be an SGN curator' ;
 939     }
 940     $c->stash->{rest} = $response;
 941 }
 942
 943 =head2 organisms
 944
 945 Public Path: /ajax/locus/organisms
 946
 947 get a list of available organisms as stored in locus.common_name_id,
 948 responds with a JSON array .
 949
 950 =cut
 951
 952 sub organisms : Local : ActionClass('REST') { }
 953
 954 sub organisms_GET :Args(0) {
 955     my ($self, $c) = @_;
 956     my $response;
 957     my ($organism_names_ref, $organism_ids_ref)=CXGN::Tools::Organism::get_existing_organisms( $c->dbc->dbh);
 958     my $var = join "\n" , @$organism_ids_ref ;
 959     $response->{html} = $organism_names_ref;
 960     $c->stash->{rest} = $response;
 961 }
 962
 963
 964 ####
 965 1;
 966 ###