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