lib/SGN/Controller/AJAX/Stock.pm

   1
   2 =head1 NAME
   3
   4 SGN::Controller::AJAX::Stock - a REST controller class to provide the
   5 backend for objects linked with stocks
   6
   7 =head1 DESCRIPTION
   8
   9 Add new stock properties, stock dbxrefs and so on.
  10
  11 =head1 AUTHOR
  12
  13 Lukas Mueller <lam87@cornell.edu>
  14 Naama Menda <nm249@cornell.edu>
  15
  16 =cut
  17
  18 package SGN::Controller::AJAX::Stock;
  19
  20 use Moose;
  21
  22 use List::MoreUtils qw /any /;
  23 use Data::Dumper;
  24 use Try::Tiny;
  25 use CXGN::Phenome::Schema;
  26 use CXGN::Phenome::Allele;
  27 use CXGN::Chado::Stock;
  28 use CXGN::Page::FormattingHelpers qw/ columnar_table_html info_table_html html_alternate_show /;
  29 use CXGN::Phenome::DumpGenotypes;
  30 use CXGN::BreederSearch;
  31 use Scalar::Util 'reftype';
  32
  33 use Scalar::Util qw(looks_like_number);
  34 use DateTime;
  35 use SGN::Model::Cvterm;
  36
  37 BEGIN { extends 'Catalyst::Controller::REST' }
  38
  39 __PACKAGE__->config(
  40     default   => 'application/json',
  41     stash_key => 'rest',
  42     map       => { 'application/json' => 'JSON', 'text/html' => 'JSON' },
  43    );
  44
  45
  46 =head2 add_stockprop
  47
  48
  49 L<Catalyst::Action::REST> action.
  50
  51 Stores a new stockprop in the database
  52
  53 =cut
  54
  55 sub add_stockprop : Path('/stock/prop/add') : ActionClass('REST') { }
  56
  57 sub add_stockprop_POST {
  58     my ( $self, $c ) = @_;
  59     my $response;
  60     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
  61     if (!$c->user()) {
  62         $c->stash->{rest} = { error => "Log in required for adding stock properties." }; return;
  63     }
  64
  65     if (  any { $_ eq 'curator' || $_ eq 'submitter' || $_ eq 'sequencer' } $c->user->roles() ) {
  66         my $req = $c->req;
  67         # refactor this code  using $stock->create_stockprop
  68         my $stock_id = $c->req->param('stock_id');
  69         my $prop  = $c->req->param('prop');
  70         my $prop_type = $c->req->param('prop_type');
  71         if ($prop_type eq 'synonym') { $prop_type = 'stock_synonym' ; }
  72
  73         my $stock = $schema->resultset("Stock::Stock")->find( { stock_id => $stock_id } );
  74
  75         if ($stock && $prop && $prop_type) {
  76             try {
  77                 $stock->create_stockprops( { $prop_type => $prop }, { autocreate => 1 } );
  78                 $c->stash->{rest} = { message => "stock_id $stock_id and type_id $prop_type have been associated with value $prop", }
  79             } catch {
  80                 $c->stash->{rest} = { error => "Failed: $_" }
  81             };
  82         } else {
  83             $c->stash->{rest} = { error => "Cannot associate prop $prop_type: $prop with stock $stock_id " };
  84         }
  85     } else {
  86         $c->stash->{rest} = { error => 'user does not have a curator/sequencer/submitter account' };
  87     }
  88     #$c->stash->{rest} = { message => 'success' };
  89 }
  90
  91 sub add_stockprop_GET {
  92     my $self = shift;
  93     my $c = shift;
  94     return $self->add_stockprop_POST($c);
  95 }
  96
  97
  98 =head2 get_stockprops
  99
 100  Usage:
 101  Desc:         Gets the stockprops of type type_id associated with a stock_id
 102  Ret:
 103  Args:
 104  Side Effects:
 105  Example:
 106
 107 =cut
 108
 109
 110
 111 sub get_stockprops : Path('/stock/prop/get') : ActionClass('REST') { }
 112
 113 sub get_stockprops_GET {
 114     my ($self, $c) = @_;
 115
 116     my $stock_id = $c->req->param("stock_id");
 117     my $type_id = $c->req->param("type_id");
 118
 119     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 120
 121     my $prop_rs = $schema->resultset("Stock::Stockprop")->search(
 122         {
 123             stock_id => $stock_id,
 124             #type_id => $type_id,
 125         }, { join => 'type', order_by => 'stockprop_id' } );
 126
 127     my @propinfo = ();
 128     while (my $prop = $prop_rs->next()) {
 129         push @propinfo, { stockprop_id => $prop->stockprop_id, stock_id => $prop->stock_id, type_id => $prop->type_id(), type_name => $prop->type->name(), value => $prop->value() };
 130     }
 131
 132     $c->stash->{rest} = \@propinfo;
 133
 134
 135 }
 136
 137
 138 sub delete_stockprop : Path('/stock/prop/delete') : ActionClass('REST') { }
 139
 140 sub delete_stockprop_GET {
 141     my $self = shift;
 142     my $c = shift;
 143     my $stockprop_id = $c->req->param("stockprop_id");
 144     if (! any { $_ eq 'curator' || $_ eq 'submitter' || $_ eq 'sequencer' } $c->user->roles() ) {
 145         $c->stash->{rest} = { error => 'Log in required for deletion of stock properties.' };
 146         return;
 147     }
 148     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 149     my $spr = $schema->resultset("Stock::Stockprop")->find( { stockprop_id => $stockprop_id });
 150     if (! $spr) {
 151         $c->stash->{rest} = { error => 'The specified prop does not exist' };
 152         return;
 153     }
 154     eval {
 155         $spr->delete();
 156     };
 157     if ($@) {
 158         $c->stash->{rest} = { error => "An error occurred during deletion: $@" };
 159             return;
 160     }
 161     $c->stash->{rest} = { message => "The element was removed from the database." };
 162
 163 }
 164
 165
 166
 167 sub associate_locus:Path('/ajax/stock/associate_locus') :ActionClass('REST') {}
 168
 169 sub associate_locus_POST :Args(0) {
 170     my ($self, $c) = @_;
 171     $c->stash->{rest} = { error => "Nothing here, it's a POST.." } ;
 172 }
 173
 174 sub associate_locus_GET :Args(0) {
 175     my ( $self, $c ) = @_;
 176     my $stock_id = $c->req->param('object_id');
 177     ##my $allele_id = $c->req->param('allele_id');
 178     #Phytoene synthase 1 (psy1) Allele: 1
 179     #phytoene synthase 1 (psy1)
 180     my $locus_input = $c->req->param('loci') ;
 181     if (!$locus_input) {
 182         $self->status_bad_request($c, message => 'need loci param' );
 183         return;
 184     }
 185     my ($locus_data, $allele_symbol) = split (/ Allele: / ,$locus_input);
 186     my $is_default = $allele_symbol ? 'f' : 't' ;
 187     $locus_data =~ m/(.*)\s\((.*)\)/ ;
 188     my $locus_name = $1;
 189     my $locus_symbol = $2;
 190     my $schema =  $c->dbic_schema('Bio::Chado::Schema' , 'sgn_chado');
 191     my ($allele) = $c->dbic_schema('CXGN::Phenome::Schema')
 192         ->resultset('Locus')
 193         ->search({
 194             locus_name   => $locus_name,
 195             locus_symbol => $locus_symbol,
 196                  } )
 197         ->search_related('alleles' , {
 198             allele_symbol => $allele_symbol,
 199             is_default => $is_default} );
 200     if (!$allele) {
 201         $c->stash->{rest} = { error => "no allele found for locus '$locus_data' (allele: '$allele_symbol')" };
 202         return;
 203     }
 204     my $stock = $schema->resultset("Stock::Stock")->find({stock_id => $stock_id } ) ;
 205     my  $allele_id = $allele->allele_id;
 206     if (!$c->user) {
 207         $c->stash->{rest} = { error => 'Must be logged in for associating loci! ' };
 208         return;
 209     }
 210     if ( any { $_ eq 'curator' || $_ eq 'submitter' || $_ eq 'sequencer' } $c->user->roles() ) {
 211         # if this fails, it will throw an acception and will (probably
 212         # rightly) be counted as a server error
 213         if ($stock && $allele_id) {
 214             try {
 215                 my $cxgn_stock = CXGN::Chado::Stock->new($schema, $stock_id);
 216                 $cxgn_stock->associate_allele($allele_id, $c->user->get_object->get_sp_person_id);
 217
 218                 $c->stash->{rest} = ['success'];
 219                 # need to update the loci div!!
 220                 return;
 221             } catch {
 222                 $c->stash->{rest} = { error => "Failed: $_" };
 223                 return;
 224             };
 225         } else {
 226             $c->stash->{rest} = { error => 'need both valid stock_id and allele_id for adding the stockprop! ' };
 227         }
 228     } else {
 229         $c->stash->{rest} = { error => 'No privileges for adding new loci. You must have an sgn submitter account. Please contact sgn-feedback@solgenomics.net for upgrading your user account. ' };
 230     }
 231 }
 232
 233 sub display_alleles : Chained('/stock/get_stock') :PathPart('alleles') : ActionClass('REST') { }
 234
 235 sub display_alleles_GET  {
 236     my ($self, $c) = @_;
 237
 238     $c->forward('/stock/get_stock_allele_ids');
 239
 240     my $stock = $c->stash->{stock};
 241     my $allele_ids = $c->stash->{allele_ids};
 242     my $dbh = $c->dbc->dbh;
 243     my @allele_data;
 244     my $hashref;
 245     foreach my $allele_id (@$allele_ids) {
 246         my $allele = CXGN::Phenome::Allele->new($dbh, $allele_id);
 247         my $phenotype        = $allele->get_allele_phenotype();
 248         my $allele_link  = qq|<a href="/phenome/allele.pl?allele_id=$allele_id">$phenotype </a>|;
 249         my $locus_id = $allele->get_locus_id;
 250         my $locus_name = $allele->get_locus_name;
 251         my $locus_link = qq|<a href="/phenome/locus_display.pl?locus_id=$locus_id">$locus_name </a>|;
 252         push @allele_data,
 253         [
 254          (
 255           $locus_link,
 256           $allele->get_allele_name,
 257           $allele_link
 258          )
 259         ];
 260     }
 261     $hashref->{html} = @allele_data ?
 262         columnar_table_html(
 263             headings     =>  [ "Locus name", "Allele symbol", "Phenotype" ],
 264             data         => \@allele_data,
 265         )  : undef ;
 266     $c->stash->{rest} = $hashref;
 267 }
 268
 269 ##############
 270
 271
 272 sub display_ontologies : Chained('/stock/get_stock') :PathPart('ontologies') : ActionClass('REST') { }
 273
 274 sub display_ontologies_GET  {
 275     my ($self, $c) = @_;
 276     $c->forward('/stock/get_stock_cvterms');
 277     my $schema = $c->dbic_schema("Bio::Chado::Schema", 'sgn_chado');
 278     my $stock = $c->stash->{stock};
 279     my $stock_id = $stock->get_stock_id;
 280     my $trait_db_name => $c->get_conf('trait_ontology_db_name');
 281     my $trait_cvterms = $c->stash->{stock_cvterms}->{$trait_db_name};
 282     my $po_cvterms = $c->stash->{stock_cvterms}->{PO} ;
 283     # should GO be here too?
 284     my $go_cvterms = $c->stash->{stock_cvterms}->{GO};
 285     my @stock_cvterms;
 286     push @stock_cvterms, @$trait_cvterms if $trait_cvterms;
 287     push @stock_cvterms, @$po_cvterms if $po_cvterms;
 288     ################################
 289     ###the following code should be re-formatted in JSON object,
 290     #and the html generated in the javascript code
 291     ### making this more reusable !
 292     ###############################
 293     my $hashref;
 294     # need to check if the user is logged in, and has editing privileges
 295     my $privileged;
 296     if ($c->user) {
 297         if ( $c->user->check_roles('curator') || $c->user->check_roles('submitter')  || $c->user->check_roles('sequencer') ) { $privileged = 1; }
 298     }
 299     # the ontology term is a stock_cvterm
 300     # the evidence details are in stock_cvtermprop (relationship, evidence_code,
 301     # evidence_description, evidence_with, reference, obsolete
 302     # and the metadata for sp_person_id, create_date, etc.)
 303     my @obs_annot;
 304     #keys= cvterms, values= hash of arrays
 305     #(keys= ontology details, values= list of evidences)
 306     my %ont_hash = () ;
 307     #some cvterms to be used for the evidence codes
 308     my $cvterm_rs =  $schema->resultset("Cv::Cvterm");
 309     my ($rel_cvterm) = $cvterm_rs->search( { name => 'relationship'} );
 310     my ($evidence_cvterm) = $cvterm_rs->search( { name => 'evidence_code' } );
 311     # go over the lists of Bio::Chado::Schema::Cv::Cvterm objects
 312     # and build the annotation details
 313     foreach (@stock_cvterms) {
 314         my $cv_name      = $_->cvterm->cv->name;
 315         my $cvterm_id    = $_->cvterm->cvterm_id;
 316         my $cvterm_name  = $_->cvterm->name;
 317         my $db_name      = $_->cvterm->dbxref->db->name;
 318         my $accession    = $_->cvterm->dbxref->accession;
 319         my $db_accession = $accession;
 320         $db_accession = $cvterm_id if $db_name eq $trait_db_name;
 321         my $url = $_->cvterm->dbxref->db->urlprefix . $_->cvterm->dbxref->db->url;
 322         my $cvterm_link =
 323             qq |<a href="/cvterm/$cvterm_id/view" target="blank">$cvterm_name</a>|;
 324         # the stock_cvtermprop objects have all the evidence and metadata for the annotation
 325         my $props = $_->stock_cvtermprops;
 326         my ($relationship_id) = $props->search( { type_id =>$rel_cvterm->cvterm_id} )->single ? $props->search( { type_id =>$rel_cvterm->cvterm_id} )->single->value : undef; # should be 1 relationship per annotation
 327         my ($evidence_code_id) = $props->search( { type_id => $evidence_cvterm->cvterm_id })->single ?  $props->search( { type_id => $evidence_cvterm->cvterm_id })->single->value : undef;
 328         # should be 1 evidence_code
 329         ############
 330         my $evidence_desc_name;
 331         my $rel_name = $relationship_id ? $cvterm_rs->find({ cvterm_id=>$relationship_id})->name : undef;
 332         my $ev_name  = $evidence_code_id ? $cvterm_rs->find({ cvterm_id=>$evidence_code_id})->name : undef;
 333         #if the cvterm has an obsolete property (must have a true value
 334         # since annotations can be obsolete and un-obsolete, it is possible
 335         # to have an obsolete property with value = 0, meaning the annotation
 336         # is not obsolete.
 337         # build the unobsolete link
 338         my $stock_cvterm_id = $_->stock_cvterm_id;
 339         my ($obsolete_prop) = $props->search(
 340             {
 341                 value => '1',
 342                 'type.name' => 'obsolete',
 343             },
 344             { join =>  'type' } , );
 345         if ($obsolete_prop) {
 346             my $unobsolete =  qq | <input type = "button" onclick= "javascript:Tools.toggleObsoleteAnnotation('0', \'$stock_cvterm_id\',  \'/ajax/stock/toggle_obsolete_annotation\', \'/stock/$stock_id/ontologies\')" value = "unobsolete" /> | if $privileged ;
 347
 348             # generate the list of obsolete annotations
 349             push @obs_annot,
 350             $rel_name . " "
 351                 . $cvterm_link . " ("
 352                 . $ev_name . ")"
 353                 . $unobsolete;
 354         }else {
 355             my $ontology_details = $rel_name
 356                 . qq| $cvterm_link ($db_name:<a href="$url$db_accession" target="blank"> $accession</a>)<br />|;
 357             # build the obsolete link if the user has  editing privileges
 358             my $obsolete_link =  qq | <input type = "button" onclick="javascript:Tools.toggleObsoleteAnnotation('1', \'$stock_cvterm_id\',  \'/ajax/stock/toggle_obsolete_annotation\', \'/stock/$stock_id/ontologies\')" value ="delete" /> | if $privileged ;
 359
 360             my ($ev_with) = $props->search( {'type.name' => 'evidence_with'} , { join => 'type'  } )->single;
 361             my $ev_with_dbxref = $ev_with ? $schema->resultset("General::Dbxref")->find( { dbxref_id=> $ev_with->value } ) : undef;
 362             my $ev_with_url = $ev_with_dbxref ?  $ev_with_dbxref->urlprefix . $ev_with_dbxref->url . $ev_with_dbxref->accession : undef;
 363             my $ev_with_acc = $ev_with_dbxref ? $ev_with_dbxref->accession : undef ;
 364             # the reference is a stock_cvterm.pub_id
 365             my ($reference) = $_->pub;
 366             my $reference_dbxref = $reference ? $reference->pub_dbxrefs->first->dbxref : undef;
 367             my $reference_url = $reference_dbxref ? $reference_dbxref->db->urlprefix . $reference_dbxref->db->url . $reference_dbxref->accession : undef;
 368             my $reference_acc = $reference_dbxref ? $reference_dbxref->accession : undef;
 369             my $display_ref = $reference_acc =~ /^\d/ ? 1 : 0;
 370             # the submitter is a sp_person_id prop
 371             my ($submitter) = $props->search( {'type.name' => 'sp_person_id'} , { join => 'type' } );
 372             my $sp_person_id = $submitter ? $submitter->value : undef;
 373             my $person= CXGN::People::Person->new($c->dbc->dbh, $sp_person_id);
 374             my $submitter_info = qq| <a href="solpeople/personal_info.pl?sp_person_id=$sp_person_id">| . $person->get_first_name . " " . $person->get_last_name . "</a>" ;
 375             my ($date) = $props->search( {'type.name' => 'create_date'} , { join =>  'type'  } )->first || undef ; # $props->search( {'type.name' => 'modified_date'} , { join =>  'type' } ) ;
 376             my $evidence_date = $date ? substr $date->value , 0, 10 : undef;
 377
 378             # add an empty row if there is more than 1 evidence code
 379             my $ev_string;
 380             $ev_string .= "<hr />" if $ont_hash{$cv_name}{$ontology_details};
 381             no warnings 'uninitialized';
 382             $ev_string .=  $ev_name . "<br />";
 383             $ev_string .= $evidence_desc_name . "<br />" if $evidence_desc_name;
 384             $ev_string .= "<a href=\"$ev_with_url\">$ev_with_acc</a><br />" if $ev_with_acc;
 385             $ev_string .="<a href=\"$reference_url\">$reference_acc</a><br />" if $display_ref;
 386             $ev_string .= "$submitter_info $evidence_date $obsolete_link";
 387             $ont_hash{$cv_name}{$ontology_details} .= $ev_string;
 388         }
 389     }
 390     my $ontology_evidence;
 391
 392     #now we should have an %ont_hash with all the details we need for printing ...
 393     #hash keys are the cv names ..
 394     for my $cv_name ( sort keys %ont_hash ) {
 395         my @evidence;
 396         #and for each ontology annotation create an array ref of evidences
 397         for my $ont_detail ( sort keys %{ $ont_hash{$cv_name} } ) {
 398             push @evidence,
 399             [ $ont_detail, $ont_hash{$cv_name}{$ont_detail} ];
 400         }
 401         my $ev = join "\n", map {
 402             qq|<div class="term">$_->[0]</div>\n|
 403                 .qq|<div class="evidence">$_->[1]</div>\n|;
 404         } @evidence;
 405         $ontology_evidence .= info_table_html(
 406             $cv_name     => $ev,
 407             __border     => 0,
 408             __tableattrs => 'width="100%"',
 409             );
 410     }
 411     #display ontology annotation form
 412     my $print_obsoleted;
 413     if ( @obs_annot &&  $privileged ) {
 414         my $obsoleted;
 415         foreach my $term (@obs_annot) {
 416             $obsoleted .= qq |$term  <br />\n |;
 417         }
 418         $print_obsoleted = html_alternate_show(
 419             'obsoleted_terms', 'Show obsolete',
 420             '',                qq|<div class="minorbox">$obsoleted</div> |,
 421             );
 422     }
 423     $hashref->{html} = $ontology_evidence . $print_obsoleted;
 424     $c->stash->{rest} = $hashref;
 425 }
 426
 427 ############
 428 sub associate_ontology:Path('/ajax/stock/associate_ontology') :ActionClass('REST') {}
 429
 430 sub associate_ontology_GET :Args(0) {
 431     my ($self, $c) = @_;
 432     $c->stash->{rest} = { error => "Nothing here, it's a GET.." } ;
 433 }
 434
 435
 436 sub associate_ontology_POST :Args(0) {
 437     my ( $self, $c ) = @_;
 438
 439     my $params = map { $_ => $c->req->param($_) } qw/
 440        object_id ontology_input relationship evidence_code evidence_description
 441        evidence_with reference
 442     /;
 443
 444     my $stock_id       = $c->req->param('object_id');
 445     my $ontology_input = $c->req->param('term_name');
 446     my $relationship   = $c->req->param('relationship'); # a cvterm_id
 447     my $evidence_code  = $c->req->param('evidence_code'); # a cvterm_id
 448     my $evidence_description = $c->req->param('evidence_description') || undef; # a cvterm_id
 449     my $evidence_with  = $c->req->param('evidence_with') || undef; # a dbxref_id (type='evidence_with' value = 'dbxref_id'
 450     my $logged_user = $c->user;
 451     my $logged_person_id = $logged_user->get_object->get_sp_person_id if $logged_user;
 452
 453     my $reference = $c->req->param('reference'); # a pub_id
 454
 455     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 456     my $cvterm_rs = $schema->resultset('Cv::Cvterm');
 457     my ($pub_id) = $reference ? $reference :
 458         $schema->resultset('Pub::Pub')->search( { title=> 'curator' } )->first->pub_id; # a pub for 'curator' should already be in the sgn database. can add here $curator_cvterm->create_with ... and then create the curator pub with type_id of $curator_cvterm
 459
 460     #solanaceae_phenotype--SP:000001--fruit size
 461     my ($cv_name, $db_accession, $cvterm_name)  = split /--/ , $ontology_input;
 462     my ($db_name, $accession) = split ':' , $db_accession;
 463
 464     my ($cvterm) = $schema
 465         ->resultset('General::Db')
 466         ->search({ 'me.name' => $db_name, } )->search_related('dbxrefs' , { accession => $accession } )
 467         ->search_related('cvterm')->first; # should be only 1 cvterm per dbxref
 468     if (!$cvterm) {
 469         $c->stash->{rest} = { error => "no ontology term found for term $db_name : $accession" };
 470         return;
 471     }
 472     my ($stock) = $c->stash->{stock} || $schema->resultset("Stock::Stock")->find( { stock_id => $stock_id } );
 473
 474     my  $cvterm_id = $cvterm->cvterm_id;
 475     if (!$c->user) {
 476         $c->stash->{rest} = { error => 'Must be logged in for associating ontology terms! ' };
 477         return;
 478     }
 479     if ( any { $_ eq 'curator' || $_ eq 'submitter' || $_ eq 'sequencer' } $c->user->roles() ) {
 480         # if this fails, it will throw an acception and will (probably
 481         # rightly) be counted as a server error
 482         #########################################################
 483         if ($stock && $cvterm_id) {
 484             try {
 485                 #check if the stock_cvterm exists
 486                 my $s_cvterm_rs = $stock->search_related(
 487                     'stock_cvterms', { cvterm_id => $cvterm_id, pub_id => $pub_id } );
 488                 # if it exists , we need to increment the rank
 489                 my $rank = 0;
 490                 if ($s_cvterm_rs->first) {
 491                     $rank = $s_cvterm_rs->get_column('rank')->max + 1;
 492                     # now check if the evidence codes already exists
 493                     my ($rel_prop, $ev_prop, $desc_prop, $with_prop);
 494                     my $eprops = $s_cvterm_rs->search_related('stock_cvtermprops');
 495                     $rel_prop = $eprops->search( {
 496                         type_id => $cvterm_rs->search( { name => 'relationship'})->single->cvterm_id,
 497                         value => $relationship  })->first;
 498
 499                     $ev_prop = $eprops->search( {
 500                         type_id =>   $cvterm_rs->search( { name => 'evidence_code'})->single->cvterm_id,
 501                         value => $evidence_code })->first;
 502
 503                     $desc_prop = $eprops->search( {
 504                         type_id =>  $cvterm_rs->search( { name => 'evidence description'})->single->cvterm_id,
 505                         value => $evidence_description })->first if $evidence_description;
 506
 507                     $with_prop = $eprops->search( {
 508                         type_id =>  $cvterm_rs->search( { name => 'evidence_with'})->single->cvterm_id,
 509                         value => $evidence_with })->first if $evidence_with;
 510
 511                     # return error if annotation + evidence exist
 512                     if ($rel_prop && $ev_prop) {
 513                         $c->stash->{rest} = { error => "Annotation exists with these evidence codes! " };
 514                         return;
 515                     }
 516                 }
 517                 # now store a new stock_cvterm
 518                 my $s_cvterm = $stock->create_related('stock_cvterms', {
 519                     cvterm_id => $cvterm_id,
 520                     pub_id    => $pub_id,
 521                     rank      => $rank, } );
 522 #########
 523                 $s_cvterm->create_stock_cvtermprops(
 524                     { 'relationship' => $relationship } , { db_name => 'OBO_REL', cv_name =>'relationship' } ) if looks_like_number($relationship);
 525                 $s_cvterm->create_stock_cvtermprops(
 526                     { 'evidence_code' => $evidence_code } , { db_name => 'ECO', cv_name =>'evidence_code' } ) if looks_like_number($evidence_code);
 527                  $s_cvterm->create_stock_cvtermprops(
 528                      { 'evidence_description' => $evidence_description } , { cv_name =>'local', autocreate => 1 } ) if looks_like_number($evidence_description);
 529                 $s_cvterm->create_stock_cvtermprops(
 530                     { 'evidence_with' => $evidence_with  } , { cv_name =>'local' , autocreate=>1} ) if looks_like_number($evidence_with);
 531                 # store the person loading the annotation
 532                 $s_cvterm->create_stock_cvtermprops(
 533                     { 'sp_person_id' => $logged_person_id  } , { cv_name =>'local' , autocreate=>1} );
 534                 #store today's date
 535                 my $val = "now()";
 536                 $s_cvterm->create_stock_cvtermprops(
 537                     { 'create_date' =>  \$val   } , { cv_name =>'local' , autocreate=>1, allow_duplicate_values => 1} );
 538
 539                 $c->stash->{rest} = ['success'];
 540                 return;
 541             } catch {
 542                 print STDERR "***** associate_ontology failed! $_ \n\n";
 543                 $c->stash->{rest} = { error => "Failed: $_" };
 544                 # send an email to sgn bugs
 545                 $c->stash->{email} = {
 546                     to      => 'sgn-bugs@sgn.cornell.edu',
 547                     from    => 'sgn-bugs@sgn.cornell.edu',
 548                     subject => "Associate ontology failed! Stock_id = $stock_id",
 549                     body    => $_,
 550                 };
 551                 $c->forward( $c->view('Email') );
 552                 return;
 553             };
 554             # if you reached here this means associate_ontology worked. Now send an email to sgn-db-curation
 555             print STDERR "***** User " . $logged_user->get_object->get_first_name . " " . $logged_user->get_object->get_last_name . "has stored a new ontology term for stock $stock_id\n\n";
 556             $c->stash->{email} = {
 557                 to      => 'sgn-db-curation@sgn.cornell.edu',
 558                 from    => 'www-data@sgn-vm.sgn.cornell.edu',
 559                 subject => "New ontology term loaded. Stock $stock_id",
 560                 body    => "User " . $logged_user->get_object->get_first_name . " " . $logged_user->get_object->get_last_name . "has stored a new ontology term for stock $stock_id http://solgenomics.net/stock/$stock_id/view",
 561             };
 562             $c->forward( $c->view('Email') );
 563
 564         } else {
 565             $c->stash->{rest} = { error => 'need both valid stock_id and cvterm_id for adding an ontology term to this stock! ' };
 566         }
 567     } else {
 568         $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. ' };
 569     }
 570 }
 571
 572 sub references : Chained('/stock/get_stock') :PathPart('references') : ActionClass('REST') { }
 573
 574
 575 sub references_GET :Args(0) {
 576     my ($self, $c) = @_;
 577     my $stock = $c->stash->{stock};
 578     # get a list of references
 579     my $q =  "SELECT dbxref.dbxref_id, pub.pub_id, accession,title
 580               FROM public.stock_pub
 581               JOIN public.pub USING (pub_id)
 582               JOIN public.pub_dbxref USING (pub_id)
 583               JOIN public.dbxref USING (dbxref_id)
 584               WHERE stock_id= ?";
 585     my $sth = $c->dbc->dbh->prepare($q);
 586     $sth->execute($stock->get_stock_id);
 587     my $response_hash={};
 588     while (my ($dbxref_id, $pub_id, $accession, $title) = $sth->fetchrow_array) {
 589         $response_hash->{$accession . ": " . $title} = $pub_id ;
 590     }
 591     $c->stash->{rest} = $response_hash;
 592 }
 593
 594
 595 # nothing is returned here for now. This is just required for the integrity of the associate ontology form
 596 sub evidences : Chained('/stock/get_stock') :PathPart('evidences') : ActionClass('REST') { }
 597
 598 sub evidences_GET :Args(0) {
 599     my ($self, $c) = @_;
 600     my $stock = $c->stash->{stock};
 601     # get a list of evidences
 602     my $response_hash={};
 603
 604     $c->stash->{rest} = $response_hash;
 605 }
 606
 607 sub toggle_obsolete_annotation : Path('/ajax/stock/toggle_obsolete_annotation') : ActionClass('REST') { }
 608
 609 sub toggle_obsolete_annotation_POST :Args(0) {
 610     my ($self, $c) = @_;
 611     my $stock = $c->stash->{stock};
 612     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 613     my $obsolete_cvterm = $schema->resultset("Cv::Cvterm")->search(
 614         { name => 'obsolete',
 615           is_obsolete => 0 ,
 616         } )->single; #should be one local term
 617     my $stock_cvterm_id = $c->request->body_parameters->{id};
 618     my $obsolete = $c->request->body_parameters->{obsolete};
 619     my $response = {} ;
 620     if ($stock_cvterm_id && $c->user ) {
 621         my $stock_cvterm = $schema->resultset("Stock::StockCvterm")->find( { stock_cvterm_id => $stock_cvterm_id } );
 622         if ($stock_cvterm) {
 623             my ($prop) = $stock_cvterm->stock_cvtermprops( { type_id => $obsolete_cvterm->cvterm_id } ) if $obsolete_cvterm;
 624             if ($prop) {
 625                 $prop->update( { value => $obsolete } ) ;
 626             } else {
 627                 $stock_cvterm->create_stock_cvtermprops(
 628                     { obsolete   => $obsolete },
 629                     { autocreate => 1, cv_name => 'local'  },
 630                     );
 631             }
 632             $response->{response} = "success";
 633         }
 634         else { $response->{error} = "No stock_cvtermp found for id $stock_cvterm_id ! "; }
 635     } else { $response->{error} = 'stock_cvterm $stock_cvterm_id does not exists! ';  }
 636     $c->stash->{rest} = $response;
 637 }
 638
 639
 640 =head2 trait_autocomplete
 641
 642 Public Path: /ajax/stock/trait_autocomplete
 643
 644 Autocomplete a trait name.  Takes a single GET param,
 645 C<term>, responds with a JSON array of completions for that term.
 646 Finds only traits that exist in nd_experiment_phenotype
 647
 648 =cut
 649
 650 sub trait_autocomplete : Local : ActionClass('REST') { }
 651
 652 sub trait_autocomplete_GET :Args(0) {
 653     my ( $self, $c ) = @_;
 654
 655     my $term = $c->req->param('term');
 656     # trim and regularize whitespace
 657     $term =~ s/(^\s+|\s+)$//g;
 658     $term =~ s/\s+/ /g;
 659     my @response_list;
 660     my $q = "SELECT DISTINCT cvterm.name FROM phenotype JOIN cvterm ON cvterm_id = observable_id WHERE cvterm.name ilike ? ORDER BY cvterm.name";
 661     #my $q = "select distinct cvterm.name from stock join nd_experiment_stock using (stock_id) join nd_experiment_phenotype using (nd_experiment_id) join phenotype using (phenotype_id) join cvterm on cvterm_id = phenotype.observable_id WHERE cvterm.name ilike ?";
 662     my $sth = $c->dbc->dbh->prepare($q);
 663     $sth->execute( '%'.$term.'%');
 664     while  (my ($term_name) = $sth->fetchrow_array ) {
 665         push @response_list, $term_name;
 666     }
 667     $c->{stash}->{rest} = \@response_list;
 668 }
 669
 670 =head2 project_autocomplete
 671
 672 Public Path: /ajax/stock/project_autocomplete
 673
 674 Autocomplete a project name.  Takes a single GET param,
 675 C<term>, responds with a JSON array of completions for that term.
 676 Finds only projects that are linked with a stock
 677
 678 =cut
 679
 680 sub project_autocomplete : Local : ActionClass('REST') { }
 681
 682 sub project_autocomplete_GET :Args(0) {
 683     my ( $self, $c ) = @_;
 684
 685     my $term = $c->req->param('term');
 686     # trim and regularize whitespace
 687     $term =~ s/(^\s+|\s+)$//g;
 688     $term =~ s/\s+/ /g;
 689     my @response_list;
 690     my $q = "SELECT  distinct project.name FROM
 691   nd_experiment_stock JOIN
 692   nd_experiment_project USING (nd_experiment_id) JOIN
 693   project USING (project_id)
 694   WHERE project.name ilike ? ORDER BY project.name";
 695     my $sth = $c->dbc->dbh->prepare($q);
 696     $sth->execute( '%'.$term.'%');
 697     while  (my ($project_name) = $sth->fetchrow_array ) {
 698         push @response_list, $project_name;
 699     }
 700     $c->{stash}->{rest} = \@response_list;
 701 }
 702
 703 =head2 project_year_autocomplete
 704
 705 Public Path: /ajax/stock/project_year_autocomplete
 706
 707 Autocomplete a project year value.  Takes a single GET param,
 708 C<term>, responds with a JSON array of completions for that term.
 709 Finds only year projectprops that are linked with a stock
 710
 711 =cut
 712
 713 sub project_year_autocomplete : Local : ActionClass('REST') { }
 714
 715 sub project_year_autocomplete_GET :Args(0) {
 716     my ( $self, $c ) = @_;
 717
 718     my $term = $c->req->param('term');
 719     # trim and regularize whitespace
 720     $term =~ s/(^\s+|\s+)$//g;
 721     $term =~ s/\s+/ /g;
 722     my @response_list;
 723     my $q = "SELECT  distinct value FROM
 724   nd_experiment_stock JOIN
 725   nd_experiment_project USING (nd_experiment_id) JOIN
 726   projectprop USING (project_id) JOIN
 727   cvterm on cvterm_id = projectprop.type_id
 728   WHERE cvterm.name ilike ? AND value ilike ?";
 729     my $sth = $c->dbc->dbh->prepare($q);
 730     $sth->execute( '%year%' , '%'.$term.'%');
 731     while  (my ($project_name) = $sth->fetchrow_array ) {
 732         push @response_list, $project_name;
 733     }
 734     $c->{stash}->{rest} = \@response_list;
 735 }
 736
 737 =head2 geolocation_autocomplete
 738
 739 Public Path: /ajax/stock/geolocation_autocomplete
 740
 741 Autocomplete a geolocation description.  Takes a single GET param,
 742 C<term>, responds with a JSON array of completions for that term.
 743 Finds only locations that are linked with a stock
 744
 745 =cut
 746
 747 sub geolocation_autocomplete : Local : ActionClass('REST') { }
 748
 749 sub geolocation_autocomplete_GET :Args(0) {
 750     my ( $self, $c ) = @_;
 751
 752     my $term = $c->req->param('term');
 753     # trim and regularize whitespace
 754     $term =~ s/(^\s+|\s+)$//g;
 755     $term =~ s/\s+/ /g;
 756     my @response_list;
 757     my $q = "SELECT  distinct nd_geolocation.description FROM
 758   nd_experiment_stock JOIN
 759   nd_experiment USING (nd_experiment_id) JOIN
 760   nd_geolocation USING (nd_geolocation_id)
 761   WHERE nd_geolocation.description ilike ?";
 762     my $sth = $c->dbc->dbh->prepare($q);
 763     $sth->execute( '%'.$term.'%');
 764     while  (my ($location) = $sth->fetchrow_array ) {
 765         push @response_list, $location;
 766     }
 767     $c->{stash}->{rest} = \@response_list;
 768 }
 769
 770 =head2 stock_autocomplete
 771
 772  Usage:
 773  Desc:
 774  Ret:
 775  Args:
 776  Side Effects:
 777  Example:
 778
 779 =cut
 780
 781 sub stock_autocomplete : Local : ActionClass('REST') { }
 782
 783 sub stock_autocomplete_GET :Args(0) {
 784     my ($self, $c) = @_;
 785
 786     my $term = $c->req->param('term');
 787
 788     $term =~ s/(^\s+|\s+)$//g;
 789     $term =~ s/\s+/ /g;
 790
 791     my @response_list;
 792     my $q = "select distinct(uniquename) from stock where uniquename ilike ? ORDER BY stock.uniquename LIMIT 100";
 793     my $sth = $c->dbc->dbh->prepare($q);
 794     $sth->execute('%'.$term.'%');
 795     while (my ($stock_name) = $sth->fetchrow_array) {
 796         push @response_list, $stock_name;
 797     }
 798
 799     print STDERR "stock_autocomplete RESPONSELIST = ".join ", ", @response_list;
 800
 801     $c->{stash}->{rest} = \@response_list;
 802 }
 803
 804 =head2 accession_autocomplete
 805
 806  Usage:
 807  Desc:
 808  Ret:
 809  Args:
 810  Side Effects:
 811  Example:
 812
 813 =cut
 814
 815 sub accession_autocomplete : Local : ActionClass('REST') { }
 816
 817 sub accession_autocomplete_GET :Args(0) {
 818     my ($self, $c) = @_;
 819
 820     my $term = $c->req->param('term');
 821
 822     $term =~ s/(^\s+|\s+)$//g;
 823     $term =~ s/\s+/ /g;
 824
 825     my @response_list;
 826     my $q = "select distinct(stock.uniquename) from stock join cvterm on(type_id=cvterm_id) where stock.uniquename ilike ? and cvterm.name='accession' ORDER BY stock.uniquename";
 827     my $sth = $c->dbc->dbh->prepare($q);
 828     $sth->execute('%'.$term.'%');
 829     while (my ($stock_name) = $sth->fetchrow_array) {
 830         push @response_list, $stock_name;
 831     }
 832
 833     #print STDERR "stock_autocomplete RESPONSELIST = ".join ", ", @response_list;
 834
 835     $c->{stash}->{rest} = \@response_list;
 836 }
 837
 838 sub parents : Local : ActionClass('REST') {}
 839
 840 sub parents_GET : Path('/ajax/stock/parents') Args(0) {
 841     my $self = shift;
 842     my $c = shift;
 843
 844     my $stock_id = $c->req->param("stock_id");
 845
 846     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 847
 848     my $female_parent_type_id = $schema->resultset("Cv::Cvterm")->find( { name=> "female_parent" } )->cvterm_id();
 849
 850     my $male_parent_type_id = $schema->resultset("Cv::Cvterm")->find( { name=> "male_parent" } )->cvterm_id();
 851
 852     my %parent_types;
 853     $parent_types{$female_parent_type_id} = "female";
 854     $parent_types{$male_parent_type_id} = "male";
 855
 856     my $parent_rs = $schema->resultset("Stock::StockRelationship")->search( { 'me.type_id' => { -in => [ $female_parent_type_id, $male_parent_type_id] }, object_id => $stock_id })->search_related("subject");
 857
 858     my @parents;
 859     while (my $p = $parent_rs->next()) {
 860         push @parents, [
 861             $p->get_column("stock_id"),
 862             $p->get_column("uniquename"),
 863         ];
 864
 865     }
 866     $c->stash->{rest} = {
 867         stock_id => $stock_id,
 868         parents => \@parents,
 869     };
 870 }
 871
 872 sub remove_stock_parent : Local : ActionClass('REST') { }
 873
 874 sub remove_parent_GET : Path('/ajax/stock/parent/remove') Args(0) {
 875     my ($self, $c) = @_;
 876
 877     my $stock_id = $c->req->param("stock_id");
 878     my $parent_id = $c->req->param("parent_id");
 879
 880     if (!$stock_id || ! $parent_id) {
 881         $c->stash->{rest} = { error => "No stock and parent specified" };
 882         return;
 883     }
 884
 885     if (! ($c->user && ($c->user->check_roles('curator') || $c->user->check_roles('submitter'))))  {
 886         $c->stash->{rest} = { error => "Log in is required, or insufficent privileges, for removing parents" };
 887         return;
 888     }
 889
 890     my $q = $c->dbic_schema("Bio::Chado::Schema")->resultset("Stock::StockRelationship")->find( { object_id => $stock_id, subject_id=> $parent_id });
 891
 892     eval {
 893         $q->delete();
 894     };
 895     if ($@) {
 896         $c->stash->{rest} = { error => $@ };
 897         return;
 898     }
 899
 900     $c->stash->{rest} = { success => 1 };
 901 }
 902
 903
 904
 905 =head2 add_stock_parent
 906
 907  Usage:
 908  Desc:
 909  Ret:
 910  Args:
 911  Side Effects:
 912  Example:
 913
 914 =cut
 915
 916 sub add_stock_parent : Local : ActionClass('REST') { }
 917
 918 sub add_stock_parent_GET :Args(0) {
 919     my ($self, $c) = @_;
 920
 921     print STDERR "Add_stock_parent function...\n";
 922     if (!$c->user()) {
 923         print STDERR "User not logged in... not associating stocks.\n";
 924         $c->stash->{rest} = {error => "You need to be logged in to add pedigree information." };
 925         return;
 926     }
 927
 928     if (!any { $_ eq "curator" || $_ eq "submitter" } ($c->user()->roles)  ) {
 929         print STDERR "User does not have sufficient privileges.\n";
 930         $c->stash->{rest} = {error =>  "you have insufficient privileges to add pedigree information." };
 931         return;
 932     }
 933
 934     my $stock_id = $c->req->param('stock_id');
 935     my $parent_name = $c->req->param('parent_name');
 936     my $parent_type = $c->req->param('parent_type');
 937
 938     my $schema = $c->dbic_schema("Bio::Chado::Schema", "sgn_chado");
 939
 940     my $cvterm_name = "";
 941     if ($parent_type eq "male") {
 942         $cvterm_name = "male_parent";
 943     }
 944     elsif ($parent_type eq "female") {
 945         $cvterm_name = "female_parent";
 946     }
 947
 948     my $type_id_row = $schema->resultset("Cv::Cvterm")->find( { name=> $cvterm_name } );
 949
 950     # check if a parent of this parent_type is already associated with this stock
 951     #
 952     my $previous_parent = $schema->resultset("Stock::StockRelationship")->find( { type_id => $type_id_row->cvterm_id,
 953                                                                                   object_id => $stock_id });
 954
 955     if ($previous_parent) {
 956         print STDERR "The stock ".$previous_parent->subject_id." is already associated with stock $stock_id - returning.\n";
 957         $c->stash->{rest} = { error => "A $parent_type parent with id ".$previous_parent->subject_id." is already associated with this stock. Please specify another parent." };
 958         return;
 959     }
 960
 961     my $cvterm_id;
 962     if ($type_id_row) {
 963         $cvterm_id = $type_id_row->cvterm_id;
 964     }
 965
 966     print STDERR "PARENT_NAME = $parent_name STOCK_ID $stock_id  $cvterm_name\n";
 967
 968     my $stock = $schema->resultset("Stock::Stock")->find( { stock_id => $stock_id });
 969
 970    my $parent = $schema->resultset("Stock::Stock")->find( { uniquename => $parent_name } );
 971
 972
 973
 974     if (!$stock) {
 975         $c->stash->{rest} = { error => "Stock with $stock_id is not found in the database!"};
 976         return;
 977     }
 978     if (!$parent) {
 979         $c->stash->{rest} = { error => "Stock with uniquename $parent_name was not found, Either this is not unique name or it is not in the database!"};
 980         return;     }
 981
 982     my $new_row = $schema->resultset("Stock::StockRelationship")->new(
 983         {
 984             subject_id => $parent->stock_id,
 985             object_id  => $stock->stock_id,
 986             type_id    => $cvterm_id,
 987         });
 988
 989     eval {
 990         $new_row->insert();
 991     };
 992
 993     if ($@) {
 994         $c->stash->{rest} = { error => "An error occurred: $@"};
 995     }
 996     else {
 997         $c->stash->{rest} = { error => '', };
 998     }
 999 }
1000
1001
1002
1003 sub generate_genotype_matrix : Path('/phenome/genotype/matrix/generate') :Args(1) {
1004     my $self = shift;
1005     my $c = shift;
1006     my $group = shift;
1007
1008     my $file = $c->config->{genotype_dump_file} || "/tmp/genotype_dump_file";
1009
1010     CXGN::Phenome::DumpGenotypes::dump_genotypes($c->dbc->dbh, $file);
1011
1012
1013     $c->stash->{rest}= [ 1];
1014
1015 }
1016
1017
1018 =head2 add_phenotype
1019
1020
1021 L<Catalyst::Action::REST> action.
1022
1023 Store a new phenotype and link with nd_experiment_stock
1024
1025 =cut
1026
1027
1028 sub add_phenotype :PATH('/ajax/stock/add_phenotype') : ActionClass('REST') { }
1029
1030 sub add_phenotype_GET :Args(0) {
1031     my ($self, $c) = @_;
1032     $c->stash->{rest} = { error => "Nothing here, it's a GET.." } ;
1033 }
1034
1035 sub add_phenotype_POST {
1036     my ( $self, $c ) = @_;
1037     my $response;
1038     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
1039     if (  any { $_ eq 'curator' || $_ eq 'submitter' || $_ eq 'sequencer' } $c->user->roles() ) {
1040         my $req = $c->req;
1041
1042         my $stock_id = $c->req->param('stock_id');
1043         my $project_id = $c->req->param('project_id');
1044         my $geolocation_id = $c->req->param('geolocation_id');
1045         my $observable_id = $c->req->param('observable_id');
1046         my $value = $c->req->param('value');
1047         my $date = DateTime->now;
1048         my $user =  $c->user->get_object->get_sp_person_id;
1049         try {
1050             # find the cvterm for a phenotyping experiment
1051             my $pheno_cvterm = SGN::Model::Cvterm->get_cvterm_row($schema,'phenotyping_experiment','experiment_type');
1052
1053
1054             #create the new phenotype
1055             my $phenotype = $schema->resultset("Phenotype::Phenotype")->find_or_create(
1056                 {
1057                     observable_id => $observable_id, #cvterm
1058                     value => $value ,
1059                     uniquename => "Stock: $stock_id, Observable id: $observable_id. Uploaded by web form by $user on $date" ,
1060                 });
1061             #create a new nd_experiment
1062             my $experiment = $schema->resultset('NaturalDiversity::NdExperiment')->create(
1063                 {
1064                     nd_geolocation_id => $geolocation_id,
1065                     type_id => $pheno_cvterm->cvterm_id(),
1066                 } );
1067             #link to the project
1068             $experiment->find_or_create_related('nd_experiment_projects', {
1069                 project_id => $project_id,
1070                                                 } );
1071             #link the experiment to the stock
1072             $experiment->find_or_create_related('nd_experiment_stocks' , {
1073                 stock_id => $stock_id,
1074                 type_id  =>  $pheno_cvterm->cvterm_id(),
1075                                                 });
1076             #link the phenotype with the nd_experiment
1077             my $nd_experiment_phenotype = $experiment->find_or_create_related(
1078                 'nd_experiment_phenotypes', {
1079                     phenotype_id => $phenotype->phenotype_id()
1080                 } );
1081
1082             $response = { message => "stock_id $stock_id and project_id $project_id associated with cvterm $observable_id , phenotype value $value (phenotype_id = " . $phenotype->phenotype_id . "\n" , }
1083         } catch {
1084             $response = { error => "Failed: $_" }
1085         };
1086     }  else {  $c->stash->{rest} = { error => 'user does not have a curator/sequencer/submitter account' };
1087     }
1088 }
1089
1090 =head2 action stock_members_phenotypes()
1091
1092  Usage:        /stock/<stock_id>/datatables/traits
1093  Desc:         get all the phenotypic scores associated with the stock $stock_id
1094  Ret:          json of the form
1095                { data => [  { db_name : 'A', observable: 'B', value : 'C' }, { ... }, ] }
1096  Args:
1097  Side Effects:
1098  Example:
1099
1100 =cut
1101
1102 sub stock_members_phenotypes :Chained('/stock/get_stock') PathPart('datatables/traits') Args(0) {
1103     my $self = shift;
1104     my $c = shift;
1105     #my $trait_id = shift;
1106
1107
1108     my $subject_phenotypes = $self->get_phenotypes($c);
1109
1110     # collect the data from the hashref...
1111     #
1112     my @stock_data;
1113
1114     foreach my $project (keys (%$subject_phenotypes)) {
1115         foreach my $trait (@{$subject_phenotypes->{$project}}) {
1116             push @stock_data, [
1117                 $project,
1118                 $trait->get_column("db_name").":".$trait->get_column("accession"),
1119                 $trait->get_column("observable"),
1120                 $trait->get_column("value"),
1121             ];
1122         }
1123     }
1124
1125     $c->stash->{rest} = { data => \@stock_data,
1126                           #has_members_genotypes => $has_members_genotypes
1127     };
1128
1129 }
1130
1131 sub _stock_project_phenotypes {
1132     my ($self, $schema, $bcs_stock) = @_;
1133
1134     return {} unless $bcs_stock;
1135     my $rs =  $schema->resultset("Stock::Stock")->stock_phenotypes_rs($bcs_stock);
1136     my %project_hashref;
1137     while ( my $r = $rs->next) {
1138         my $project_desc = $r->get_column('project_description');
1139         push @{ $project_hashref{ $project_desc }}, $r;
1140     }
1141     return \%project_hashref;
1142 }
1143
1144 =head2 action get_stock_trials()
1145
1146  Usage:        /stock/<stock_id>/datatables/trials
1147  Desc:         retrieves trials associated with the stock
1148  Ret:          a table in json suitable for datatables
1149  Args:
1150  Side Effects:
1151  Example:
1152
1153 =cut
1154
1155 sub get_stock_trials :Chained('/stock/get_stock') PathPart('datatables/trials') Args(0) {
1156     my $self = shift;
1157     my $c = shift;
1158
1159     my @trials = $c->stash->{stock}->get_trials();
1160
1161     my @formatted_trials;
1162     foreach my $t (@trials) {
1163         push @formatted_trials, [ '<a href="/breeders/trial/'.$t->[0].'">'.$t->[1].'</a>', $t->[3], '<a href="javascript:show_stock_trial_detail('.$c->stash->{stock}->get_stock_id().', \''.$c->stash->{stock}->get_name().'\' ,'.$t->[0].',\''.$t->[1].'\')">Details</a>' ];
1164     }
1165     $c->stash->{rest} = { data => \@formatted_trials };
1166 }
1167
1168
1169 =head2 action get_shared_trials()
1170
1171  Usage:        /datatables/sharedtrials
1172  Desc:         retrieves trials associated with multiple stocks
1173  Ret:          a table in json suitable for datatables
1174  Args:         array of stock uniquenames
1175  Side Effects:
1176  Example:
1177
1178 =cut
1179
1180 sub get_shared_trials :Path('/stock/get_shared_trials') : ActionClass('REST'){
1181
1182 sub get_shared_trials_POST :Args(1) {
1183     my ($self, $c) = @_;
1184     $c->stash->{rest} = { error => "Nothing here, it's a POST.." } ;
1185 }
1186 sub get_shared_trials_GET :Args(1) {
1187
1188     my $self = shift;
1189     my $c = shift;
1190     my @stock_ids = $c->request->param( 'stock_ids[]' );
1191     my $stock_string = join ",", map { "'$_'" } (@stock_ids);
1192     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
1193     my $dbh = $c->dbc->dbh();
1194     my $bs = CXGN::BreederSearch->new( { dbh=>$dbh } );
1195
1196     my $criteria_list = [
1197                'accessions',
1198                'trials'
1199              ];
1200
1201     my $dataref = {
1202                'trials' => {
1203                            'accessions' => $stock_string
1204                          }
1205                   };
1206
1207     my $queryref = {
1208                'trials' => {
1209                            'accessions' => 1
1210                          }
1211                   };
1212
1213     my $trial_query = $bs->metadata_query($c, $criteria_list, $dataref, $queryref);
1214     my %query_response = %$trial_query;
1215     my $shared_trials = $query_response{'results'};
1216
1217     my @formatted_rows = ();
1218
1219     foreach my $stock_id (@stock_ids) {
1220              my $trials_string ='';
1221        my $stock = CXGN::Chado::Stock->new($schema, $stock_id);
1222        my $uniquename = $stock->get_uniquename;
1223        $dataref = {
1224              'trials' => {
1225                          'accessions' => $stock_id
1226                        }
1227                 };
1228         $trial_query = $bs->metadata_query($c, $criteria_list, $dataref, $queryref);
1229         %query_response = %$trial_query;
1230         my $current_trials = $query_response{'results'};
1231               my $num_trials = scalar @$current_trials;
1232
1233               foreach my $t (@$current_trials) {
1234           print STDERR "t = " . Dumper($t);
1235           $trials_string = $trials_string . '<a href="/breeders/trial/'.$t->[0].'">'.$t->[1].'</a>,  ';
1236               }
1237               $trials_string =~ s/,\s+$//;
1238               push @formatted_rows, ['<a href="/stock/'.$stock_id.'/view">'.$uniquename.'</a>', $num_trials, $trials_string ];
1239     }
1240
1241     my $num_trials = scalar @$shared_trials;
1242     if ($num_trials > 0) {
1243             my $trials_string = '';
1244             foreach my $t (@$shared_trials) {
1245                $trials_string = $trials_string . '<a href="/breeders/trial/'.$t->[0].'">'.$t->[1].'</a>,  ';
1246       }
1247             $trials_string  =~ s/,\s+$//;
1248             push @formatted_rows, [ "Trials in Common", $num_trials, $trials_string];
1249     } else {
1250       push @formatted_rows, [ "Trials in Common", $num_trials, "No shared trials found."];
1251     }
1252
1253     $c->stash->{rest} = { data => \@formatted_rows, shared_trials => $shared_trials };
1254   }
1255 }
1256
1257 =head2 action get_stock_trait_list()
1258
1259  Usage:        /stock/<stock_id>/datatables/traitlist
1260  Desc:         retrieves the list of traits assayed on the stock
1261  Ret:          json in a table format, suitable for datatables
1262  Args:
1263  Side Effects:
1264  Example:
1265
1266 =cut
1267
1268 sub get_stock_trait_list :Chained('/stock/get_stock') PathPart('datatables/traitlist') Args(0) {
1269     my $self = shift;
1270     my $c = shift;
1271
1272     my @trait_list = $c->stash->{stock}->get_trait_list();
1273
1274     my @formatted_list;
1275     foreach my $t (@trait_list) {
1276         print STDERR Dumper($t);
1277         push @formatted_list, [ '<a href="/cvterm/'.$t->[0].'/view">'.$t->[1].'</a>', $t->[2], sprintf("%3.1f", $t->[3]), sprintf("%3.1f", $t->[4]) ];
1278     }
1279     print STDERR Dumper(\@formatted_list);
1280
1281     $c->stash->{rest} = { data => \@formatted_list };
1282 }
1283
1284 sub get_phenotypes_by_stock_and_trial :Chained('/stock/get_stock') PathPart('datatables/trial') Args(1) {
1285     my $self = shift;
1286     my $c = shift;
1287     my $trial_id = shift;
1288
1289     my $q = "SELECT stock.stock_id, stock.uniquename, cvterm_id, cvterm.name, avg(phenotype.value::REAL), stddev(phenotype.value::REAL)   FROM stock JOIN stock_relationship ON (stock.stock_id=stock_relationship.object_id) JOIN  nd_experiment_stock ON (nd_experiment_stock.stock_id=stock_relationship.subject_id) JOIN nd_experiment_project ON (nd_experiment_stock.nd_experiment_id=nd_experiment_project.nd_experiment_id) JOIN nd_experiment_phenotype ON (nd_experiment_phenotype.nd_experiment_id=nd_experiment_project.nd_experiment_id) JOIN phenotype USING(phenotype_id) JOIN cvterm ON (phenotype.cvalue_id=cvterm.cvterm_id) WHERE project_id=? AND stock.stock_id=? GROUP BY stock.stock_id, stock.uniquename, cvterm_id, cvterm.name";
1290
1291     my $h = $c->dbc->dbh->prepare($q);
1292     $h->execute($trial_id, $c->stash->{stock}->get_stock_id());
1293
1294     my @phenotypes;
1295     while (my ($stock_id, $stock_name, $cvterm_id, $cvterm_name, $avg, $stddev) = $h->fetchrow_array()) {
1296         push @phenotypes, [ "<a href=\"/cvterm/$cvterm_id/view\">$cvterm_name</a>", sprintf("%.2f", $avg), sprintf("%.2f", $stddev) ];
1297     }
1298
1299     $c->stash->{rest} = { data => \@phenotypes };
1300 }
1301
1302 sub get_phenotypes {
1303     my $self = shift;
1304     my $c = shift;
1305     shift;
1306     my $trait_id = shift;
1307
1308     my $stock_id = $c->stash->{stock_row}->stock_id();
1309
1310     my $schema = $c->dbic_schema("Bio::Chado::Schema");
1311     my $bcs_stock_rs = $schema->resultset("Stock::Stock")->search( { stock_id => $stock_id });
1312
1313     if (! $bcs_stock_rs) { die "The stock $stock_id does not exist in the database"; }
1314
1315     my $bcs_stock = $bcs_stock_rs->first();
1316
1317 # #    my ($has_members_genotypes) = $bcs_stock->result_source->schema->storage->dbh->selectrow_array( <<'', undef, $bcs_stock->stock_id );
1318 # SELECT COUNT( DISTINCT genotype_id )
1319 #   FROM phenome.genotype
1320 #   JOIN stock subj using(stock_id)
1321 #   JOIN stock_relationship sr ON( sr.subject_id = subj.stock_id )
1322 #  WHERE sr.object_id = ?
1323
1324     # now we have rs of stock_relationship objects. We need to find
1325     # the phenotypes of their related subjects
1326     #
1327     my $subjects = $bcs_stock->search_related('stock_relationship_objects')
1328                              ->search_related('subject');
1329     my $subject_phenotypes = $self->_stock_project_phenotypes($schema, $subjects );
1330
1331     return $subject_phenotypes;
1332 }
1333
1334 sub get_pedigree_string :Chained('/stock/get_stock') PathPart('pedigree') Args(0) {
1335     my $self = shift;
1336     my $c = shift;
1337     my $level = $c->req->param("level");
1338     my $schema = $c->dbic_schema("Bio::Chado::Schema");
1339     my $s = CXGN::Chado::Stock->new($schema, $c->stash->{stock}->get_stock_id());
1340     my $pedigree_root = $s->get_parents($level);
1341     my $pedigree_string = $pedigree_root->get_pedigree_string($level);
1342
1343     $c->stash->{rest} = { pedigree_string => $pedigree_string };
1344 }
1345
1346 sub stock_lookup : Path('/stock_lookup/') Args(2) ActionClass('REST') { }
1347
1348 sub stock_lookup_POST {
1349     my $self = shift;
1350     my $c = shift;
1351     my $lookup_from_field = shift;
1352     my $lookup_field = shift;
1353     my $value_to_lookup = $c->req->param($lookup_from_field);
1354
1355     #print STDERR $lookup_from_field;
1356     #print STDERR $lookup_field;
1357     #print STDERR $value_to_lookup;
1358
1359     my $schema = $c->dbic_schema("Bio::Chado::Schema");
1360     my $s = $schema->resultset("Stock::Stock")->find( { $lookup_from_field => $value_to_lookup } );
1361     my $value;
1362     if ($s && $lookup_field eq 'stock_id') {
1363         $value = $s->stock_id();
1364     }
1365     $c->stash->{rest} = { $lookup_from_field => $value_to_lookup, $lookup_field => $value };
1366 }
1367
1368 1;