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 use CXGN::Genotype::Search;
  36 use JSON;
  37 use CXGN::Cross;
  38 use Bio::Chado::Schema;
  39
  40 use Scalar::Util qw(looks_like_number);
  41 use DateTime;
  42 use SGN::Model::Cvterm;
  43 use CXGN::People::Person;
  44 use CXGN::Stock::StockLookup;
  45
  46 BEGIN { extends 'Catalyst::Controller::REST' }
  47
  48 __PACKAGE__->config(
  49     default   => 'application/json',
  50     stash_key => 'rest',
  51     map       => { 'application/json' => 'JSON' },
  52    );
  53
  54
  55 =head2 add_stockprop
  56
  57
  58 L<Catalyst::Action::REST> action.
  59
  60 Stores a new stockprop in the database
  61
  62 =cut
  63
  64 sub add_stockprop : Path('/stock/prop/add') : ActionClass('REST') { }
  65
  66 sub add_stockprop_POST {
  67     my ( $self, $c ) = @_;
  68     my $response;
  69     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
  70     if (!$c->user()) {
  71         $c->stash->{rest} = { error => "Log in required for adding stock properties." }; return;
  72     }
  73
  74     if (  any { $_ eq 'curator' || $_ eq 'submitter' || $_ eq 'sequencer' } $c->user->roles() ) {
  75         my $req = $c->req;
  76         my $stock_id = $c->req->param('stock_id');
  77         my $prop  = $c->req->param('prop');
  78         $prop =~ s/^\s+|\s+$//g; #trim whitespace from both ends
  79         my $prop_type = $c->req->param('prop_type');
  80
  81         my $stock = $schema->resultset("Stock::Stock")->find( { stock_id => $stock_id } );
  82
  83     if ($stock && $prop && $prop_type) {
  84
  85         my $message = '';
  86         if ($prop_type eq 'stock_synonym') {
  87             my $fuzzy_accession_search = CXGN::BreedersToolbox::StocksFuzzySearch->new({schema => $schema});
  88             my $max_distance = 0.2;
  89             my $fuzzy_search_result = $fuzzy_accession_search->get_matches([$prop], $max_distance, 'accession');
  90             #print STDERR Dumper $fuzzy_search_result;
  91             my $found_accessions = $fuzzy_search_result->{'found'};
  92             my $fuzzy_accessions = $fuzzy_search_result->{'fuzzy'};
  93             if ($fuzzy_search_result->{'error'}){
  94                 $c->stash->{rest} = { error => "ERROR: ".$fuzzy_search_result->{'error'} };
  95                 $c->detach();
  96             }
  97             if (scalar(@$found_accessions) > 0){
  98                 $c->stash->{rest} = { error => "Synonym not added: The synonym you are adding is already stored as its own unique stock or as a synonym." };
  99                 $c->detach();
 100             }
 101             if (scalar(@$fuzzy_accessions) > 0){
 102                 my @fuzzy_match_names;
 103                 foreach my $a (@$fuzzy_accessions){
 104                     foreach my $m (@{$a->{'matches'}}) {
 105                         push @fuzzy_match_names, $m->{'name'};
 106                     }
 107                 }
 108                 $message = "CAUTION: The synonym you are adding is similar to these accessions and synonyms in the database: ".join(', ', @fuzzy_match_names).".";
 109             }
 110         }
 111
 112         try {
 113             $stock->create_stockprops( { $prop_type => $prop }, { autocreate => 1 } );
 114
 115             my $stock = CXGN::Stock->new({
 116                 schema=>$schema,
 117                 stock_id=>$stock_id,
 118                 is_saving=>1,
 119                 sp_person_id => $c->user()->get_object()->get_sp_person_id(),
 120                 user_name => $c->user()->get_object()->get_username(),
 121                 modification_note => "Added property: $prop_type = $prop"
 122             });
 123             my $added_stock_id = $stock->store();
 124
 125             my $dbh = $c->dbc->dbh();
 126             my $bs = CXGN::BreederSearch->new( { dbh=>$dbh, dbname=>$c->config->{dbname}, } );
 127             my $refresh = $bs->refresh_matviews($c->config->{dbhost}, $c->config->{dbname}, $c->config->{dbuser}, $c->config->{dbpass}, 'stockprop', 'concurrent', $c->config->{basepath});
 128
 129             $c->stash->{rest} = { message => "$message Stock_id $stock_id and type_id $prop_type have been associated with value $prop. ".$refresh->{'message'} };
 130         } catch {
 131             $c->stash->{rest} = { error => "Failed: $_" }
 132         };
 133     } else {
 134             $c->stash->{rest} = { error => "Cannot associate prop $prop_type: $prop with stock $stock_id " };
 135         }
 136     } else {
 137         $c->stash->{rest} = { error => 'user does not have a curator/sequencer/submitter account' };
 138     }
 139     #$c->stash->{rest} = { message => 'success' };
 140 }
 141
 142 sub add_stockprop_GET {
 143     my $self = shift;
 144     my $c = shift;
 145     return $self->add_stockprop_POST($c);
 146 }
 147
 148
 149 =head2 get_stockprops
 150
 151  Usage:
 152  Desc:         Gets the stockprops of type type_id associated with a stock_id
 153  Ret:
 154  Args:
 155  Side Effects:
 156  Example:
 157
 158 =cut
 159
 160
 161
 162 sub get_stockprops : Path('/stock/prop/get') : ActionClass('REST') { }
 163
 164 sub get_stockprops_GET {
 165     my ($self, $c) = @_;
 166
 167     my $stock_id = $c->req->param("stock_id");
 168     my $type_id = $c->req->param("type_id");
 169
 170     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 171
 172     my $prop_rs = $schema->resultset("Stock::Stockprop")->search(
 173         {
 174             stock_id => $stock_id,
 175             #type_id => $type_id,
 176         }, { join => 'type', order_by => 'stockprop_id' } );
 177
 178     my @propinfo = ();
 179     while (my $prop = $prop_rs->next()) {
 180         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() };
 181     }
 182
 183     $c->stash->{rest} = \@propinfo;
 184
 185
 186 }
 187
 188
 189 sub delete_stockprop : Path('/stock/prop/delete') : ActionClass('REST') { }
 190
 191 sub delete_stockprop_GET {
 192     my $self = shift;
 193     my $c = shift;
 194     my $stockprop_id = $c->req->param("stockprop_id");
 195     if (! any { $_ eq 'curator' || $_ eq 'submitter' || $_ eq 'sequencer' } $c->user->roles() ) {
 196         $c->stash->{rest} = { error => 'Log in required for deletion of stock properties.' };
 197         return;
 198     }
 199     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 200     my $spr = $schema->resultset("Stock::Stockprop")->find( { stockprop_id => $stockprop_id });
 201     if (! $spr) {
 202         $c->stash->{rest} = { error => 'The specified prop does not exist' };
 203         return;
 204     }
 205     eval {
 206         $spr->delete();
 207     };
 208     if ($@) {
 209         $c->stash->{rest} = { error => "An error occurred during deletion: $@" };
 210             return;
 211     }
 212     $c->stash->{rest} = { message => "The element was removed from the database." };
 213
 214 }
 215
 216
 217
 218 sub associate_locus:Path('/ajax/stock/associate_locus') :ActionClass('REST') {}
 219
 220 sub associate_locus_POST :Args(0) {
 221     my ($self, $c) = @_;
 222     $c->stash->{rest} = { error => "Nothing here, it's a POST.." } ;
 223 }
 224
 225 sub associate_locus_GET :Args(0) {
 226     my ( $self, $c ) = @_;
 227     my $stock_id = $c->req->param('object_id');
 228     ##my $allele_id = $c->req->param('allele_id');
 229     #Phytoene synthase 1 (psy1) Allele: 1
 230     #phytoene synthase 1 (psy1)
 231     my $locus_input = $c->req->param('loci') ;
 232     if (!$locus_input) {
 233         $self->status_bad_request($c, message => 'need loci param' );
 234         return;
 235     }
 236     my ($locus_data, $allele_symbol) = split (/ Allele: / ,$locus_input);
 237     my $is_default = $allele_symbol ? 'f' : 't' ;
 238     $locus_data =~ m/(.*)\s\((.*)\)/ ;
 239     my $locus_name = $1;
 240     my $locus_symbol = $2;
 241     #print STDERR "Name: $locus_name Symbol: $locus_symbol Allele: $allele_symbol Default: $is_default\n";
 242
 243     my $schema =  $c->dbic_schema('Bio::Chado::Schema' , 'sgn_chado');
 244     my ($allele) = $c->dbic_schema('CXGN::Phenome::Schema')
 245         ->resultset('Locus')
 246         ->search({
 247             locus_name   => $locus_name,
 248             locus_symbol => $locus_symbol,
 249                  } )
 250         ->search_related('alleles' , {
 251             allele_symbol => $allele_symbol,
 252             is_default => $is_default} );
 253     if (!$allele) {
 254         $c->stash->{rest} = { error => "no allele found for locus '$locus_data' (allele: '$allele_symbol')" };
 255         return;
 256     }
 257     my $stock = $schema->resultset("Stock::Stock")->find({stock_id => $stock_id } ) ;
 258     my  $allele_id = $allele->allele_id;
 259     if (!$c->user) {
 260         $c->stash->{rest} = { error => 'Must be logged in for associating loci! ' };
 261         return;
 262     }
 263     if ( any { $_ eq 'curator' || $_ eq 'submitter' || $_ eq 'sequencer' } $c->user->roles() ) {
 264         # if this fails, it will throw an acception and will (probably
 265         # rightly) be counted as a server error
 266         if ($stock && $allele_id) {
 267             try {
 268                 my $cxgn_stock = CXGN::Stock->new(schema => $schema, stock_id => $stock_id);
 269                 $cxgn_stock->associate_allele($allele_id, $c->user->get_object->get_sp_person_id);
 270
 271                 $c->stash->{rest} = ['success'];
 272                 # need to update the loci div!!
 273                 return;
 274             } catch {
 275                 $c->stash->{rest} = { error => "Failed: $_" };
 276                 return;
 277             };
 278         } else {
 279             $c->stash->{rest} = { error => 'need both valid stock_id and allele_id for adding the stockprop! ' };
 280         }
 281     } else {
 282         $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. ' };
 283     }
 284 }
 285
 286 sub display_alleles : Chained('/stock/get_stock') :PathPart('alleles') : ActionClass('REST') { }
 287
 288 sub display_alleles_GET  {
 289     my ($self, $c) = @_;
 290
 291     $c->forward('/stock/get_stock_allele_ids');
 292
 293     my $stock = $c->stash->{stock};
 294     my $allele_ids = $c->stash->{allele_ids};
 295     my $dbh = $c->dbc->dbh;
 296     my @allele_data;
 297     my $hashref;
 298     foreach my $allele_id (@$allele_ids) {
 299         my $allele = CXGN::Phenome::Allele->new($dbh, $allele_id);
 300         my $phenotype        = $allele->get_allele_phenotype();
 301         my $allele_link  = qq|<a href="/phenome/allele.pl?allele_id=$allele_id">$phenotype </a>|;
 302         my $locus_id = $allele->get_locus_id;
 303         my $locus_name = $allele->get_locus_name;
 304         my $locus_link = qq|<a href="/phenome/locus_display.pl?locus_id=$locus_id">$locus_name </a>|;
 305         push @allele_data,
 306         [
 307          (
 308           $locus_link,
 309           $allele->get_allele_name,
 310           $allele_link
 311          )
 312         ];
 313     }
 314     $hashref->{html} = @allele_data ?
 315         columnar_table_html(
 316             headings     =>  [ "Locus name", "Allele symbol", "Phenotype" ],
 317             data         => \@allele_data,
 318         )  : undef ;
 319     $c->stash->{rest} = $hashref;
 320 }
 321
 322 ##############
 323
 324
 325 sub display_ontologies : Chained('/stock/get_stock') :PathPart('ontologies') : ActionClass('REST') { }
 326
 327 sub display_ontologies_GET  {
 328     my ($self, $c) = @_;
 329     $c->forward('/stock/get_stock_cvterms');
 330     my $schema = $c->dbic_schema("Bio::Chado::Schema", 'sgn_chado');
 331     my $stock = $c->stash->{stock};
 332     my $stock_id = $stock->get_stock_id;
 333     my $trait_db_name => $c->get_conf('trait_ontology_db_name');
 334     my $trait_cvterms = $c->stash->{stock_cvterms}->{$trait_db_name};
 335     my $po_cvterms = $c->stash->{stock_cvterms}->{PO} ;
 336     # should GO be here too?
 337     my $go_cvterms = $c->stash->{stock_cvterms}->{GO};
 338     my @stock_cvterms;
 339     push @stock_cvterms, @$trait_cvterms if $trait_cvterms;
 340     push @stock_cvterms, @$po_cvterms if $po_cvterms;
 341     ################################
 342     ###the following code should be re-formatted in JSON object,
 343     #and the html generated in the javascript code
 344     ### making this more reusable !
 345     ###############################
 346     my $hashref;
 347     # need to check if the user is logged in, and has editing privileges
 348     my $privileged;
 349     if ($c->user) {
 350         if ( $c->user->check_roles('curator') || $c->user->check_roles('submitter')  || $c->user->check_roles('sequencer') ) { $privileged = 1; }
 351     }
 352     # the ontology term is a stock_cvterm
 353     # the evidence details are in stock_cvtermprop (relationship, evidence_code,
 354     # evidence_description, evidence_with, reference, obsolete
 355     # and the metadata for sp_person_id, create_date, etc.)
 356     my @obs_annot;
 357     #keys= cvterms, values= hash of arrays
 358     #(keys= ontology details, values= list of evidences)
 359     my %ont_hash = () ;
 360     #some cvterms to be used for the evidence codes
 361     my $cvterm_rs =  $schema->resultset("Cv::Cvterm");
 362     my ($rel_cvterm) = $cvterm_rs->search( { name => 'relationship'} );
 363     my ($evidence_cvterm) = $cvterm_rs->search( { name => 'evidence_code' } );
 364     # go over the lists of Bio::Chado::Schema::Cv::Cvterm objects
 365     # and build the annotation details
 366     foreach (@stock_cvterms) {
 367         my $cv_name      = $_->cvterm->cv->name;
 368         my $cvterm_id    = $_->cvterm->cvterm_id;
 369         my $cvterm_name  = $_->cvterm->name;
 370         my $db_name      = $_->cvterm->dbxref->db->name;
 371         my $accession    = $_->cvterm->dbxref->accession;
 372         my $db_accession = $accession;
 373         $db_accession = $cvterm_id if $db_name eq $trait_db_name;
 374         my $url = $_->cvterm->dbxref->db->urlprefix . $_->cvterm->dbxref->db->url;
 375         my $cvterm_link =
 376             qq |<a href="/cvterm/$cvterm_id/view" target="blank">$cvterm_name</a>|;
 377         # the stock_cvtermprop objects have all the evidence and metadata for the annotation
 378         my $props = $_->stock_cvtermprops;
 379         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
 380         my ($evidence_code_id) = $props->search( { type_id => $evidence_cvterm->cvterm_id })->single ?  $props->search( { type_id => $evidence_cvterm->cvterm_id })->single->value : undef;
 381         # should be 1 evidence_code
 382         ############
 383         my $evidence_desc_name;
 384         my $rel_name = $relationship_id ? $cvterm_rs->find({ cvterm_id=>$relationship_id})->name : undef;
 385         my $ev_name  = $evidence_code_id ? $cvterm_rs->find({ cvterm_id=>$evidence_code_id})->name : undef;
 386         #if the cvterm has an obsolete property (must have a true value
 387         # since annotations can be obsolete and un-obsolete, it is possible
 388         # to have an obsolete property with value = 0, meaning the annotation
 389         # is not obsolete.
 390         # build the unobsolete link
 391         my $stock_cvterm_id = $_->stock_cvterm_id;
 392         my ($obsolete_prop) = $props->search(
 393             {
 394                 value => '1',
 395                 'type.name' => 'obsolete',
 396             },
 397             { join =>  'type' } , );
 398         if ($obsolete_prop) {
 399             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 ;
 400
 401             # generate the list of obsolete annotations
 402             push @obs_annot,
 403             $rel_name . " "
 404                 . $cvterm_link . " ("
 405                 . $ev_name . ")"
 406                 . $unobsolete;
 407         }else {
 408             my $ontology_details = $rel_name
 409                 . qq| $cvterm_link ($db_name:<a href="$url$db_accession" target="blank"> $accession</a>)<br />|;
 410             # build the obsolete link if the user has  editing privileges
 411             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 ;
 412
 413             my ($ev_with) = $props->search( {'type.name' => 'evidence_with'} , { join => 'type'  } )->single;
 414             my $ev_with_dbxref = $ev_with ? $schema->resultset("General::Dbxref")->find( { dbxref_id=> $ev_with->value } ) : undef;
 415             my $ev_with_url = $ev_with_dbxref ?  $ev_with_dbxref->urlprefix . $ev_with_dbxref->url . $ev_with_dbxref->accession : undef;
 416             my $ev_with_acc = $ev_with_dbxref ? $ev_with_dbxref->accession : undef ;
 417             # the reference is a stock_cvterm.pub_id
 418             my ($reference) = $_->pub;
 419             my $reference_dbxref = $reference ? $reference->pub_dbxrefs->first->dbxref : undef;
 420             my $reference_url = $reference_dbxref ? $reference_dbxref->db->urlprefix . $reference_dbxref->db->url . $reference_dbxref->accession : undef;
 421             my $reference_acc = $reference_dbxref ? $reference_dbxref->accession : undef;
 422             my $display_ref = $reference_acc =~ /^\d/ ? 1 : 0;
 423             # the submitter is a sp_person_id prop
 424             my ($submitter) = $props->search( {'type.name' => 'sp_person_id'} , { join => 'type' } );
 425             my $sp_person_id = $submitter ? $submitter->value : undef;
 426             my $person= CXGN::People::Person->new($c->dbc->dbh, $sp_person_id);
 427             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>" ;
 428             my ($date) = $props->search( {'type.name' => 'create_date'} , { join =>  'type'  } )->first || undef ; # $props->search( {'type.name' => 'modified_date'} , { join =>  'type' } ) ;
 429             my $evidence_date = $date ? substr $date->value , 0, 10 : undef;
 430
 431             # add an empty row if there is more than 1 evidence code
 432             my $ev_string;
 433             $ev_string .= "<hr />" if $ont_hash{$cv_name}{$ontology_details};
 434             no warnings 'uninitialized';
 435             $ev_string .=  $ev_name . "<br />";
 436             $ev_string .= $evidence_desc_name . "<br />" if $evidence_desc_name;
 437             $ev_string .= "<a href=\"$ev_with_url\">$ev_with_acc</a><br />" if $ev_with_acc;
 438             $ev_string .="<a href=\"$reference_url\">$reference_acc</a><br />" if $display_ref;
 439             $ev_string .= "$submitter_info $evidence_date $obsolete_link";
 440             $ont_hash{$cv_name}{$ontology_details} .= $ev_string;
 441         }
 442     }
 443     my $ontology_evidence;
 444
 445     #now we should have an %ont_hash with all the details we need for printing ...
 446     #hash keys are the cv names ..
 447     for my $cv_name ( sort keys %ont_hash ) {
 448         my @evidence;
 449         #and for each ontology annotation create an array ref of evidences
 450         for my $ont_detail ( sort keys %{ $ont_hash{$cv_name} } ) {
 451             push @evidence,
 452             [ $ont_detail, $ont_hash{$cv_name}{$ont_detail} ];
 453         }
 454         my $ev = join "\n", map {
 455             qq|<div class="term">$_->[0]</div>\n|
 456                 .qq|<div class="evidence">$_->[1]</div>\n|;
 457         } @evidence;
 458         $ontology_evidence .= info_table_html(
 459             $cv_name     => $ev,
 460             __border     => 0,
 461             __tableattrs => 'width="100%"',
 462             );
 463     }
 464     #display ontology annotation form
 465     my $print_obsoleted;
 466     if ( @obs_annot &&  $privileged ) {
 467         my $obsoleted;
 468         foreach my $term (@obs_annot) {
 469             $obsoleted .= qq |$term  <br />\n |;
 470         }
 471         $print_obsoleted = html_alternate_show(
 472             'obsoleted_terms', 'Show obsolete',
 473             '',                qq|<div class="minorbox">$obsoleted</div> |,
 474             );
 475     }
 476     $hashref->{html} = $ontology_evidence . $print_obsoleted;
 477     $c->stash->{rest} = $hashref;
 478 }
 479
 480 ############
 481 sub associate_ontology:Path('/ajax/stock/associate_ontology') :ActionClass('REST') {}
 482
 483 sub associate_ontology_GET :Args(0) {
 484     my ($self, $c) = @_;
 485     $c->stash->{rest} = { error => "Nothing here, it's a GET.." } ;
 486 }
 487
 488
 489 sub associate_ontology_POST :Args(0) {
 490     my ( $self, $c ) = @_;
 491
 492     my $params = map { $_ => $c->req->param($_) } qw/
 493        object_id ontology_input relationship evidence_code evidence_description
 494        evidence_with reference
 495     /;
 496
 497     my $stock_id       = $c->req->param('object_id');
 498     my $ontology_input = $c->req->param('term_name');
 499     my $relationship   = $c->req->param('relationship'); # a cvterm_id
 500     my $evidence_code  = $c->req->param('evidence_code'); # a cvterm_id
 501     my $evidence_description = $c->req->param('evidence_description') || undef; # a cvterm_id
 502     my $evidence_with  = $c->req->param('evidence_with') || undef; # a dbxref_id (type='evidence_with' value = 'dbxref_id'
 503     my $logged_user = $c->user;
 504     my $logged_person_id = $logged_user->get_object->get_sp_person_id if $logged_user;
 505
 506     my $reference = $c->req->param('reference'); # a pub_id
 507
 508     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 509     my $cvterm_rs = $schema->resultset('Cv::Cvterm');
 510     my ($pub_id) = $reference ? $reference :
 511         $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
 512
 513     #solanaceae_phenotype--SP:000001--fruit size
 514     my ($cv_name, $db_accession, $cvterm_name)  = split /--/ , $ontology_input;
 515     my ($db_name, $accession) = split ':' , $db_accession;
 516
 517     my ($cvterm) = $schema
 518         ->resultset('General::Db')
 519         ->search({ 'me.name' => $db_name, } )->search_related('dbxrefs' , { accession => $accession } )
 520         ->search_related('cvterm')->first; # should be only 1 cvterm per dbxref
 521     if (!$cvterm) {
 522         $c->stash->{rest} = { error => "no ontology term found for term $db_name : $accession" };
 523         return;
 524     }
 525     my ($stock) = $c->stash->{stock} || $schema->resultset("Stock::Stock")->find( { stock_id => $stock_id } );
 526
 527     my  $cvterm_id = $cvterm->cvterm_id;
 528     if (!$c->user) {
 529         $c->stash->{rest} = { error => 'Must be logged in for associating ontology terms! ' };
 530         return;
 531     }
 532     if ( any { $_ eq 'curator' || $_ eq 'submitter' || $_ eq 'sequencer' } $c->user->roles() ) {
 533         # if this fails, it will throw an acception and will (probably
 534         # rightly) be counted as a server error
 535         #########################################################
 536         if ($stock && $cvterm_id) {
 537             try {
 538                 #check if the stock_cvterm exists
 539                 my $s_cvterm_rs = $stock->search_related(
 540                     'stock_cvterms', { cvterm_id => $cvterm_id, pub_id => $pub_id } );
 541                 # if it exists , we need to increment the rank
 542                 my $rank = 0;
 543                 if ($s_cvterm_rs->first) {
 544                     $rank = $s_cvterm_rs->get_column('rank')->max + 1;
 545                     # now check if the evidence codes already exists
 546                     my ($rel_prop, $ev_prop, $desc_prop, $with_prop);
 547                     my $eprops = $s_cvterm_rs->search_related('stock_cvtermprops');
 548                     $rel_prop = $eprops->search( {
 549                         type_id => $cvterm_rs->search( { name => 'relationship'})->single->cvterm_id,
 550                         value => $relationship  })->first;
 551
 552                     $ev_prop = $eprops->search( {
 553                         type_id =>   $cvterm_rs->search( { name => 'evidence_code'})->single->cvterm_id,
 554                         value => $evidence_code })->first;
 555
 556                     $desc_prop = $eprops->search( {
 557                         type_id =>  $cvterm_rs->search( { name => 'evidence description'})->single->cvterm_id,
 558                         value => $evidence_description })->first if $evidence_description;
 559
 560                     $with_prop = $eprops->search( {
 561                         type_id =>  $cvterm_rs->search( { name => 'evidence_with'})->single->cvterm_id,
 562                         value => $evidence_with })->first if $evidence_with;
 563
 564                     # return error if annotation + evidence exist
 565                     if ($rel_prop && $ev_prop) {
 566                         $c->stash->{rest} = { error => "Annotation exists with these evidence codes! " };
 567                         return;
 568                     }
 569                 }
 570                 # now store a new stock_cvterm
 571                 my $s_cvterm = $stock->create_related('stock_cvterms', {
 572                     cvterm_id => $cvterm_id,
 573                     pub_id    => $pub_id,
 574                     rank      => $rank, } );
 575 #########
 576                 $s_cvterm->create_stock_cvtermprops(
 577                     { 'relationship' => $relationship } , { db_name => 'OBO_REL', cv_name =>'relationship' } ) if looks_like_number($relationship);
 578                 $s_cvterm->create_stock_cvtermprops(
 579                     { 'evidence_code' => $evidence_code } , { db_name => 'ECO', cv_name =>'evidence_code' } ) if looks_like_number($evidence_code);
 580                  $s_cvterm->create_stock_cvtermprops(
 581                      { 'evidence_description' => $evidence_description } , { cv_name =>'local', autocreate => 1 } ) if looks_like_number($evidence_description);
 582                 $s_cvterm->create_stock_cvtermprops(
 583                     { 'evidence_with' => $evidence_with  } , { cv_name =>'local' , autocreate=>1} ) if looks_like_number($evidence_with);
 584                 # store the person loading the annotation
 585                 $s_cvterm->create_stock_cvtermprops(
 586                     { 'sp_person_id' => $logged_person_id  } , { cv_name =>'local' , autocreate=>1} );
 587                 #store today's date
 588                 my $val = "now()";
 589                 $s_cvterm->create_stock_cvtermprops(
 590                     { 'create_date' =>  \$val   } , { cv_name =>'local' , autocreate=>1, allow_duplicate_values => 1} );
 591
 592                 $c->stash->{rest} = ['success'];
 593                 return;
 594             } catch {
 595                 print STDERR "***** associate_ontology failed! $_ \n\n";
 596                 $c->stash->{rest} = { error => "Failed: $_" };
 597                 # send an email to sgn bugs
 598                 $c->stash->{email} = {
 599                     to      => 'sgn-bugs@sgn.cornell.edu',
 600                     from    => 'sgn-bugs@sgn.cornell.edu',
 601                     subject => "Associate ontology failed! Stock_id = $stock_id",
 602                     body    => $_,
 603                 };
 604                 $c->forward( $c->view('Email') );
 605                 return;
 606             };
 607             # if you reached here this means associate_ontology worked. Now send an email to sgn-db-curation
 608             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";
 609             $c->stash->{email} = {
 610                 to      => 'sgn-db-curation@sgn.cornell.edu',
 611                 from    => 'www-data@sgn-vm.sgn.cornell.edu',
 612                 subject => "New ontology term loaded. Stock $stock_id",
 613                 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",
 614             };
 615             $c->forward( $c->view('Email') );
 616
 617         } else {
 618             $c->stash->{rest} = { error => 'need both valid stock_id and cvterm_id for adding an ontology term to this stock! ' };
 619         }
 620     } else {
 621         $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. ' };
 622     }
 623 }
 624
 625 sub references : Chained('/stock/get_stock') :PathPart('references') : ActionClass('REST') { }
 626
 627
 628 sub references_GET :Args(0) {
 629     my ($self, $c) = @_;
 630     my $stock = $c->stash->{stock};
 631     # get a list of references
 632     my $q =  "SELECT dbxref.dbxref_id, pub.pub_id, accession,title
 633               FROM public.stock_pub
 634               JOIN public.pub USING (pub_id)
 635               JOIN public.pub_dbxref USING (pub_id)
 636               JOIN public.dbxref USING (dbxref_id)
 637               WHERE stock_id= ?";
 638     my $sth = $c->dbc->dbh->prepare($q);
 639     $sth->execute($stock->get_stock_id);
 640     my $response_hash={};
 641     while (my ($dbxref_id, $pub_id, $accession, $title) = $sth->fetchrow_array) {
 642         $response_hash->{$accession . ": " . $title} = $pub_id ;
 643     }
 644     $c->stash->{rest} = $response_hash;
 645 }
 646
 647
 648 # nothing is returned here for now. This is just required for the integrity of the associate ontology form
 649 sub evidences : Chained('/stock/get_stock') :PathPart('evidences') : ActionClass('REST') { }
 650
 651 sub evidences_GET :Args(0) {
 652     my ($self, $c) = @_;
 653     my $stock = $c->stash->{stock};
 654     # get a list of evidences
 655     my $response_hash={};
 656
 657     $c->stash->{rest} = $response_hash;
 658 }
 659
 660 sub toggle_obsolete_annotation : Path('/ajax/stock/toggle_obsolete_annotation') : ActionClass('REST') { }
 661
 662 sub toggle_obsolete_annotation_POST :Args(0) {
 663     my ($self, $c) = @_;
 664     my $stock = $c->stash->{stock};
 665     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 666     my $obsolete_cvterm = $schema->resultset("Cv::Cvterm")->search(
 667         { name => 'obsolete',
 668           is_obsolete => 0 ,
 669         } )->single; #should be one local term
 670     my $stock_cvterm_id = $c->request->body_parameters->{id};
 671     my $obsolete = $c->request->body_parameters->{obsolete};
 672     my $response = {} ;
 673     if ($stock_cvterm_id && $c->user ) {
 674         my $stock_cvterm = $schema->resultset("Stock::StockCvterm")->find( { stock_cvterm_id => $stock_cvterm_id } );
 675         if ($stock_cvterm) {
 676             my ($prop) = $stock_cvterm->stock_cvtermprops( { type_id => $obsolete_cvterm->cvterm_id } ) if $obsolete_cvterm;
 677             if ($prop) {
 678                 $prop->update( { value => $obsolete } ) ;
 679             } else {
 680                 $stock_cvterm->create_stock_cvtermprops(
 681                     { obsolete   => $obsolete },
 682                     { autocreate => 1, cv_name => 'local'  },
 683                     );
 684             }
 685             $response->{response} = "success";
 686         }
 687         else { $response->{error} = "No stock_cvtermp found for id $stock_cvterm_id ! "; }
 688     } else { $response->{error} = 'stock_cvterm $stock_cvterm_id does not exists! ';  }
 689     $c->stash->{rest} = $response;
 690 }
 691
 692
 693 =head2 trait_autocomplete
 694
 695 Public Path: /ajax/stock/trait_autocomplete
 696
 697 Autocomplete a trait name.  Takes a single GET param,
 698 C<term>, responds with a JSON array of completions for that term.
 699 Finds only traits that exist in nd_experiment_phenotype
 700
 701 =cut
 702
 703 sub trait_autocomplete : Local : ActionClass('REST') { }
 704
 705 sub trait_autocomplete_GET :Args(0) {
 706     my ( $self, $c ) = @_;
 707
 708     my $term = $c->req->param('term');
 709     # trim and regularize whitespace
 710     $term =~ s/(^\s+|\s+)$//g;
 711     $term =~ s/\s+/ /g;
 712     my @response_list;
 713     my $q = "SELECT DISTINCT cvterm.name FROM phenotype JOIN cvterm ON cvterm_id = observable_id WHERE cvterm.name ilike ? ORDER BY cvterm.name";
 714     #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 ?";
 715     my $sth = $c->dbc->dbh->prepare($q);
 716     $sth->execute( '%'.$term.'%');
 717     while  (my ($term_name) = $sth->fetchrow_array ) {
 718         push @response_list, $term_name;
 719     }
 720     $c->stash->{rest} = \@response_list;
 721 }
 722
 723 =head2 project_autocomplete
 724
 725 Public Path: /ajax/stock/project_autocomplete
 726
 727 Autocomplete a project name.  Takes a single GET param,
 728 C<term>, responds with a JSON array of completions for that term.
 729 Finds only projects that are linked with a stock
 730
 731 =cut
 732
 733 sub project_autocomplete : Local : ActionClass('REST') { }
 734
 735 sub project_autocomplete_GET :Args(0) {
 736     my ( $self, $c ) = @_;
 737
 738     my $term = $c->req->param('term');
 739     # trim and regularize whitespace
 740     $term =~ s/(^\s+|\s+)$//g;
 741     $term =~ s/\s+/ /g;
 742     my @response_list;
 743     my $q = "SELECT  distinct project.name FROM project WHERE project.name ilike ? ORDER BY project.name LIMIT 100";
 744     my $sth = $c->dbc->dbh->prepare($q);
 745     $sth->execute( '%'.$term.'%');
 746     while  (my ($project_name) = $sth->fetchrow_array ) {
 747         push @response_list, $project_name;
 748     }
 749     $c->stash->{rest} = \@response_list;
 750 }
 751
 752 =head2 project_year_autocomplete
 753
 754 Public Path: /ajax/stock/project_year_autocomplete
 755
 756 Autocomplete a project year value.  Takes a single GET param,
 757 C<term>, responds with a JSON array of completions for that term.
 758 Finds only year projectprops that are linked with a stock
 759
 760 =cut
 761
 762 sub project_year_autocomplete : Local : ActionClass('REST') { }
 763
 764 sub project_year_autocomplete_GET :Args(0) {
 765     my ( $self, $c ) = @_;
 766
 767     my $term = $c->req->param('term');
 768     # trim and regularize whitespace
 769     $term =~ s/(^\s+|\s+)$//g;
 770     $term =~ s/\s+/ /g;
 771     my @response_list;
 772     my $q = "SELECT  distinct value FROM
 773   nd_experiment_stock JOIN
 774   nd_experiment_project USING (nd_experiment_id) JOIN
 775   projectprop USING (project_id) JOIN
 776   cvterm on cvterm_id = projectprop.type_id
 777   WHERE cvterm.name ilike ? AND value ilike ?";
 778     my $sth = $c->dbc->dbh->prepare($q);
 779     $sth->execute( '%year%' , '%'.$term.'%');
 780     while  (my ($project_name) = $sth->fetchrow_array ) {
 781         push @response_list, $project_name;
 782     }
 783     $c->stash->{rest} = \@response_list;
 784 }
 785
 786
 787 =head2 seedlot_name_autocomplete
 788
 789 Public Path: /ajax/stock/seedlot_name_autocomplete
 790
 791 Autocomplete a seedlot name.  Takes a single GET param,
 792 C<term>, responds with a JSON array of completions for that term.
 793
 794 =cut
 795
 796 sub seedlot_name_autocomplete : Local : ActionClass('REST') { }
 797
 798 sub seedlot_name_autocomplete_GET :Args(0) {
 799     my ( $self, $c ) = @_;
 800     my $term = $c->req->param('term');
 801     # trim and regularize whitespace
 802     $term =~ s/(^\s+|\s+)$//g;
 803     $term =~ s/\s+/ /g;
 804     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 805     my $seedlot_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'seedlot', 'stock_type')->cvterm_id();
 806
 807     my @response_list;
 808     my $q = "SELECT uniquename FROM stock where type_id = ? AND uniquename ilike ? LIMIT 1000";
 809     my $sth = $c->dbc->dbh->prepare($q);
 810     $sth->execute( $seedlot_cvterm_id , '%'.$term.'%');
 811     while  (my ($uniquename) = $sth->fetchrow_array ) {
 812         push @response_list, $uniquename;
 813     }
 814     $c->stash->{rest} = \@response_list;
 815 }
 816
 817 =head2 seedlot_source_autocomplete
 818
 819 Public Path: /ajax/stock/seedlot_source_autocomplete
 820
 821 Autocomplete a seedlot source name (seedlot, plot, subplot, or plant).
 822 Takes a single GET param, C<term>, responds with a JSON array of completions for that term.
 823
 824 =cut
 825
 826 sub seedlot_source_autocomplete : Local : ActionClass('REST') { }
 827
 828 sub seedlot_source_autocomplete_GET :Args(0) {
 829     my ( $self, $c ) = @_;
 830     my $term = $c->req->param('term');
 831     # trim and regularize whitespace
 832     $term =~ s/(^\s+|\s+)$//g;
 833     $term =~ s/\s+/ /g;
 834     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 835     my $seedlot_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'seedlot', 'stock_type')->cvterm_id();
 836     my $plot_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'plot', 'stock_type')->cvterm_id();
 837     my $subplot_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'subplot', 'stock_type')->cvterm_id();
 838     my $plant_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'plant', 'stock_type')->cvterm_id();
 839
 840     my @response_list;
 841     my $q = "SELECT uniquename FROM stock where type_id IN (?, ?, ?, ?) AND uniquename ilike ? LIMIT 1000";
 842     my $sth = $c->dbc->dbh->prepare($q);
 843     $sth->execute($seedlot_cvterm_id, $plot_cvterm_id, $subplot_cvterm_id, $plant_cvterm_id, '%'.$term.'%');
 844     while  (my ($uniquename) = $sth->fetchrow_array ) {
 845         push @response_list, $uniquename;
 846     }
 847     $c->stash->{rest} = \@response_list;
 848 }
 849
 850
 851 =head2 stockproperty_autocomplete
 852
 853 Public Path: /ajax/stock/stockproperty_autocomplete
 854
 855 Autocomplete a stock property. Takes GET param for term and property,
 856 C<term>, responds with a JSON array of completions for that term.
 857 Finds stockprop values that are linked with a stock
 858
 859 =cut
 860
 861 sub stockproperty_autocomplete : Local : ActionClass('REST') { }
 862
 863 sub stockproperty_autocomplete_GET :Args(0) {
 864     my ( $self, $c ) = @_;
 865     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 866     my $term = $c->req->param('term');
 867     my $cvterm_name = $c->req->param('property');
 868     # trim and regularize whitespace
 869     $term =~ s/(^\s+|\s+)$//g;
 870     $term =~ s/\s+/ /g;
 871     my $cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, $cvterm_name, 'stock_property')->cvterm_id();
 872     my @response_list;
 873     my $q = "SELECT distinct value FROM stockprop WHERE type_id=? and value ilike ? LIMIT 100";
 874     my $sth = $schema->storage->dbh->prepare($q);
 875     $sth->execute( $cvterm_id, '%'.$term.'%');
 876     while  (my ($val) = $sth->fetchrow_array ) {
 877         push @response_list, $val;
 878     }
 879     $c->stash->{rest} = \@response_list;
 880 }
 881
 882 =head2 geolocation_autocomplete
 883
 884 Public Path: /ajax/stock/geolocation_autocomplete
 885
 886 Autocomplete a geolocation description.  Takes a single GET param,
 887 C<term>, responds with a JSON array of completions for that term.
 888 Finds only locations that are linked with a stock
 889
 890 =cut
 891
 892 sub geolocation_autocomplete : Local : ActionClass('REST') { }
 893
 894 sub geolocation_autocomplete_GET :Args(0) {
 895     my ( $self, $c ) = @_;
 896
 897     my $term = $c->req->param('term');
 898     # trim and regularize whitespace
 899     $term =~ s/(^\s+|\s+)$//g;
 900     $term =~ s/\s+/ /g;
 901     my @response_list;
 902     my $q = "SELECT  distinct nd_geolocation.description FROM
 903   nd_experiment_stock JOIN
 904   nd_experiment USING (nd_experiment_id) JOIN
 905   nd_geolocation USING (nd_geolocation_id)
 906   WHERE nd_geolocation.description ilike ?";
 907     my $sth = $c->dbc->dbh->prepare($q);
 908     $sth->execute( '%'.$term.'%');
 909     while  (my ($location) = $sth->fetchrow_array ) {
 910         push @response_list, $location;
 911     }
 912     $c->stash->{rest} = \@response_list;
 913 }
 914
 915 =head2 stock_autocomplete
 916
 917  Usage:
 918  Desc:
 919  Ret:
 920  Args:
 921  Side Effects:
 922  Example:
 923
 924 =cut
 925
 926 sub stock_autocomplete : Local : ActionClass('REST') { }
 927
 928 sub stock_autocomplete_GET :Args(0) {
 929     my ($self, $c) = @_;
 930
 931     my $term = $c->req->param('term');
 932     my $stock_type_id = $c->req->param('stock_type_id');
 933
 934     $term =~ s/(^\s+|\s+)$//g;
 935     $term =~ s/\s+/ /g;
 936
 937     my $stock_type_where = '';
 938     if ($stock_type_id){
 939         $stock_type_where = " AND type_id = $stock_type_id ";
 940     }
 941
 942     my @response_list;
 943     my $q = "select distinct(uniquename) from stock where uniquename ilike ? $stock_type_where ORDER BY stock.uniquename LIMIT 100";
 944     my $sth = $c->dbc->dbh->prepare($q);
 945     $sth->execute('%'.$term.'%');
 946     while (my ($stock_name) = $sth->fetchrow_array) {
 947         push @response_list, $stock_name;
 948     }
 949
 950     #print STDERR "stock_autocomplete RESPONSELIST = ".join ", ", @response_list;
 951
 952     $c->stash->{rest} = \@response_list;
 953 }
 954
 955 =head2 accession_autocomplete
 956
 957  Usage:
 958  Desc:
 959  Ret:
 960  Args:
 961  Side Effects:
 962  Example:
 963
 964 =cut
 965
 966 sub accession_autocomplete : Local : ActionClass('REST') { }
 967
 968 sub accession_autocomplete_GET :Args(0) {
 969     my ($self, $c) = @_;
 970
 971     my $term = $c->req->param('term');
 972
 973     $term =~ s/(^\s+|\s+)$//g;
 974     $term =~ s/\s+/ /g;
 975
 976     my @response_list;
 977     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";
 978     my $sth = $c->dbc->dbh->prepare($q);
 979     $sth->execute('%'.$term.'%');
 980     while (my ($stock_name) = $sth->fetchrow_array) {
 981         push @response_list, $stock_name;
 982     }
 983
 984     #print STDERR Dumper @response_list;
 985
 986     $c->stash->{rest} = \@response_list;
 987 }
 988
 989 =head2 accession_or_cross_autocomplete
 990
 991  Usage:
 992  Desc:
 993  Ret:
 994  Args:
 995  Side Effects:
 996  Example:
 997
 998 =cut
 999
1000 sub accession_or_cross_autocomplete : Local : ActionClass('REST') { }
1001
1002 sub accession_or_cross_autocomplete_GET :Args(0) {
1003     my ($self, $c) = @_;
1004
1005     my $term = $c->req->param('term');
1006
1007     $term =~ s/(^\s+|\s+)$//g;
1008     $term =~ s/\s+/ /g;
1009
1010     my @response_list;
1011     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";
1012     my $sth = $c->dbc->dbh->prepare($q);
1013     $sth->execute('%'.$term.'%');
1014     while (my ($stock_name) = $sth->fetchrow_array) {
1015         push @response_list, $stock_name;
1016     }
1017
1018     #print STDERR Dumper @response_list;
1019
1020     $c->stash->{rest} = \@response_list;
1021 }
1022
1023 =head2 cross_autocomplete
1024
1025  Usage:
1026  Desc:
1027  Ret:
1028  Args:
1029  Side Effects:
1030  Example:
1031
1032 =cut
1033
1034 sub cross_autocomplete : Local : ActionClass('REST') { }
1035
1036 sub cross_autocomplete_GET :Args(0) {
1037     my ($self, $c) = @_;
1038
1039     my $term = $c->req->param('term');
1040
1041     $term =~ s/(^\s+|\s+)$//g;
1042     $term =~ s/\s+/ /g;
1043
1044     my @response_list;
1045     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";
1046     my $sth = $c->dbc->dbh->prepare($q);
1047     $sth->execute('%'.$term.'%');
1048     while (my ($stock_name) = $sth->fetchrow_array) {
1049         push @response_list, $stock_name;
1050     }
1051
1052     #print STDERR Dumper @response_list;
1053     $c->stash->{rest} = \@response_list;
1054 }
1055
1056 =head2 family_name_autocomplete
1057
1058  Usage:
1059  Desc:
1060  Ret:
1061  Args:
1062  Side Effects:
1063  Example:
1064
1065 =cut
1066
1067 sub family_name_autocomplete : Local : ActionClass('REST') { }
1068
1069 sub family_name_autocomplete_GET :Args(0) {
1070     my ($self, $c) = @_;
1071
1072     my $term = $c->req->param('term');
1073
1074     $term =~ s/(^\s+|\s+)$//g;
1075     $term =~ s/\s+/ /g;
1076
1077     my @response_list;
1078     my $q = "select distinct(stock.uniquename) from stock join cvterm on(type_id=cvterm_id) where stock.uniquename ilike ? and cvterm.name='family_name' ORDER BY stock.uniquename LIMIT 20";
1079     my $sth = $c->dbc->dbh->prepare($q);
1080     $sth->execute('%'.$term.'%');
1081     while (my ($stock_name) = $sth->fetchrow_array) {
1082         push @response_list, $stock_name;
1083     }
1084
1085     #print STDERR Dumper @response_list;
1086     $c->stash->{rest} = \@response_list;
1087 }
1088
1089
1090 =head2 population_autocomplete
1091
1092  Usage:
1093  Desc:
1094  Ret:
1095  Args:
1096  Side Effects:
1097  Example:
1098
1099 =cut
1100
1101 sub population_autocomplete : Local : ActionClass('REST') { }
1102
1103 sub population_autocomplete_GET :Args(0) {
1104     my ($self, $c) = @_;
1105
1106     my $term = $c->req->param('term');
1107
1108     $term =~ s/(^\s+|\s+)$//g;
1109     $term =~ s/\s+/ /g;
1110
1111     my $schema = $c->dbic_schema("Bio::Chado::Schema");
1112     my $population_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'population', 'stock_type')->cvterm_id();
1113
1114     my @response_list;
1115     my $q = "select distinct(uniquename) from stock where uniquename ilike ? and type_id=? ORDER BY stock.uniquename";
1116     my $sth = $c->dbc->dbh->prepare($q);
1117     $sth->execute('%'.$term.'%', $population_cvterm_id);
1118     while (my ($stock_name) = $sth->fetchrow_array) {
1119         push @response_list, $stock_name;
1120     }
1121
1122     #print STDERR "stock_autocomplete RESPONSELIST = ".join ", ", @response_list;
1123
1124     $c->stash->{rest} = \@response_list;
1125 }
1126
1127 =head2 accession_population_autocomplete
1128
1129  Usage:
1130  Desc:
1131  Ret:
1132  Args:
1133  Side Effects:
1134  Example:
1135
1136 =cut
1137
1138 sub accession_population_autocomplete : Local : ActionClass('REST') { }
1139
1140 sub accession_population_autocomplete_GET :Args(0) {
1141     my ($self, $c) = @_;
1142
1143     my $term = $c->req->param('term');
1144
1145     $term =~ s/(^\s+|\s+)$//g;
1146     $term =~ s/\s+/ /g;
1147
1148     my @response_list;
1149     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";
1150     my $sth = $c->dbc->dbh->prepare($q);
1151     $sth->execute('%'.$term.'%');
1152     while (my ($stock_name) = $sth->fetchrow_array) {
1153         push @response_list, $stock_name;
1154     }
1155
1156     #print STDERR "stock_autocomplete RESPONSELIST = ".join ", ", @response_list;
1157
1158     $c->stash->{rest} = \@response_list;
1159 }
1160
1161
1162 =head2 pedigree_female_parent_autocomplete
1163
1164 Public Path: /ajax/stock/pedigree_female_parent_autocomplete
1165
1166 Autocomplete a female parent associated with pedigree.
1167
1168 =cut
1169
1170 sub pedigree_female_parent_autocomplete: Local : ActionClass('REST'){}
1171
1172 sub pedigree_female_parent_autocomplete_GET : Args(0){
1173     my ($self, $c) = @_;
1174
1175     my $term = $c->req->param('term');
1176
1177     $term =~ s/(^\s+|\s+)$//g;
1178     $term =~ s/\s+/ /g;
1179     my @response_list;
1180
1181     my $q = "SELECT distinct (pedigree_female_parent.uniquename) FROM stock AS pedigree_female_parent
1182     JOIN stock_relationship ON (stock_relationship.subject_id = pedigree_female_parent.stock_id)
1183     JOIN cvterm AS cvterm1 ON (stock_relationship.type_id = cvterm1.cvterm_id) AND cvterm1.name = 'female_parent'
1184     JOIN stock AS check_type ON (stock_relationship.object_id = check_type.stock_id)
1185     JOIN cvterm AS cvterm2 ON (check_type.type_id = cvterm2.cvterm_id) AND cvterm2.name = 'accession'
1186     WHERE pedigree_female_parent.uniquename ilike ? ORDER BY pedigree_female_parent.uniquename LIMIT 100";
1187
1188     my $sth = $c->dbc->dbh->prepare($q);
1189     $sth->execute('%'.$term.'%');
1190     while (my($pedigree_female_parent) = $sth->fetchrow_array){
1191       push @response_list, $pedigree_female_parent;
1192     }
1193
1194   #print STDERR Dumper @response_list ;
1195     $c->stash->{rest} = \@response_list;
1196
1197 }
1198
1199
1200 =head2 pedigree_male_parent_autocomplete
1201
1202 Public Path: /ajax/stock/pedigree_male_parent_autocomplete
1203
1204 Autocomplete a male parent associated with pedigree.
1205
1206 =cut
1207
1208 sub pedigree_male_parent_autocomplete: Local : ActionClass('REST'){}
1209
1210 sub pedigree_male_parent_autocomplete_GET : Args(0){
1211     my ($self, $c) = @_;
1212
1213     my $term = $c->req->param('term');
1214
1215     $term =~ s/(^\s+|\s+)$//g;
1216     $term =~ s/\s+/ /g;
1217     my @response_list;
1218
1219     my $q = "SELECT distinct (pedigree_male_parent.uniquename) FROM stock AS pedigree_male_parent
1220     JOIN stock_relationship ON (stock_relationship.subject_id = pedigree_male_parent.stock_id)
1221     JOIN cvterm AS cvterm1 ON (stock_relationship.type_id = cvterm1.cvterm_id) AND cvterm1.name = 'male_parent'
1222     JOIN stock AS check_type ON (stock_relationship.object_id = check_type.stock_id)
1223     JOIN cvterm AS cvterm2 ON (check_type.type_id = cvterm2.cvterm_id) AND cvterm2.name = 'accession'
1224     WHERE pedigree_male_parent.uniquename ilike ? ORDER BY pedigree_male_parent.uniquename LIMIT 100";
1225
1226     my $sth = $c->dbc->dbh->prepare($q);
1227     $sth->execute('%'.$term.'%');
1228     while (my($pedigree_male_parent) = $sth->fetchrow_array){
1229         push @response_list, $pedigree_male_parent;
1230     }
1231
1232     $c->stash->{rest} = \@response_list;
1233
1234 }
1235
1236
1237 =head2 cross_female_parent_autocomplete
1238
1239 Public Path: /ajax/stock/cross_female_parent_autocomplete
1240
1241 Autocomplete a female parent associated with cross.
1242
1243 =cut
1244
1245 sub cross_female_parent_autocomplete: Local : ActionClass('REST'){}
1246
1247 sub cross_female_parent_autocomplete_GET : Args(0){
1248     my ($self, $c) = @_;
1249
1250     my $term = $c->req->param('term');
1251
1252     $term =~ s/(^\s+|\s+)$//g;
1253     $term =~ s/\s+/ /g;
1254     my @response_list;
1255
1256     my $q = "SELECT distinct (cross_female_parent.uniquename) FROM stock AS cross_female_parent
1257     JOIN stock_relationship ON (stock_relationship.subject_id = cross_female_parent.stock_id)
1258     JOIN cvterm AS cvterm1 ON (stock_relationship.type_id = cvterm1.cvterm_id) AND cvterm1.name = 'female_parent'
1259     JOIN stock AS check_type ON (stock_relationship.object_id = check_type.stock_id)
1260     JOIN cvterm AS cvterm2 ON (check_type.type_id = cvterm2.cvterm_id) AND cvterm2.name = 'cross'
1261     WHERE cross_female_parent.uniquename ilike ? ORDER BY cross_female_parent.uniquename LIMIT 100";
1262
1263     my $sth = $c->dbc->dbh->prepare($q);
1264     $sth->execute('%'.$term.'%');
1265     while (my($cross_female_parent) = $sth->fetchrow_array){
1266       push @response_list, $cross_female_parent;
1267     }
1268
1269   #print STDERR Dumper @response_list ;
1270     $c->stash->{rest} = \@response_list;
1271
1272 }
1273
1274
1275 =head2 cross_male_parent_autocomplete
1276
1277 Public Path: /ajax/stock/cross_male_parent_autocomplete
1278
1279 Autocomplete a male parent associated with cross.
1280
1281 =cut
1282
1283 sub cross_male_parent_autocomplete: Local : ActionClass('REST'){}
1284
1285 sub cross_male_parent_autocomplete_GET : Args(0){
1286     my ($self, $c) = @_;
1287
1288     my $term = $c->req->param('term');
1289
1290     $term =~ s/(^\s+|\s+)$//g;
1291     $term =~ s/\s+/ /g;
1292     my @response_list;
1293
1294     my $q = "SELECT distinct (cross_male_parent.uniquename) FROM stock AS cross_male_parent
1295     JOIN stock_relationship ON (stock_relationship.subject_id = cross_male_parent.stock_id)
1296     JOIN cvterm AS cvterm1 ON (stock_relationship.type_id = cvterm1.cvterm_id) AND cvterm1.name = 'male_parent'
1297     JOIN stock AS check_type ON (stock_relationship.object_id = check_type.stock_id)
1298     JOIN cvterm AS cvterm2 ON (check_type.type_id = cvterm2.cvterm_id) AND cvterm2.name = 'cross'
1299     WHERE cross_male_parent.uniquename ilike ? ORDER BY cross_male_parent.uniquename LIMIT 100";
1300
1301     my $sth = $c->dbc->dbh->prepare($q);
1302     $sth->execute('%'.$term.'%');
1303     while (my($cross_male_parent) = $sth->fetchrow_array){
1304         push @response_list, $cross_male_parent;
1305     }
1306
1307     $c->stash->{rest} = \@response_list;
1308
1309 }
1310
1311
1312 =head2 only_accession_autocomplete
1313
1314  Usage:
1315  Desc:
1316  Ret:
1317  Args:
1318  Side Effects:
1319  Example:
1320
1321 =cut
1322
1323 sub only_accession_autocomplete : Local : ActionClass('REST') { }
1324
1325 sub only_accession_autocomplete_GET :Args(0) {
1326     my ($self, $c) = @_;
1327
1328     my $term = $c->req->param('term');
1329
1330     $term =~ s/(^\s+|\s+)$//g;
1331     $term =~ s/\s+/ /g;
1332
1333     my @response_list;
1334     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 LIMIT 20";
1335     my $sth = $c->dbc->dbh->prepare($q);
1336     $sth->execute('%'.$term.'%');
1337     while (my ($stock_name) = $sth->fetchrow_array) {
1338         push @response_list, $stock_name;
1339     }
1340
1341     $c->stash->{rest} = \@response_list;
1342 }
1343
1344
1345 =head2 vector_construct_autocomplete
1346
1347  Usage:
1348  Desc:
1349  Ret:
1350  Args:
1351  Side Effects:
1352  Example:
1353
1354 =cut
1355
1356 sub vector_construct_autocomplete : Local : ActionClass('REST') { }
1357
1358 sub vector_construct_autocomplete_GET :Args(0) {
1359     my ($self, $c) = @_;
1360
1361     my $term = $c->req->param('term');
1362
1363     $term =~ s/(^\s+|\s+)$//g;
1364     $term =~ s/\s+/ /g;
1365
1366     my @response_list;
1367     my $q = "select distinct(stock.uniquename) from stock join cvterm on(type_id=cvterm_id) where stock.uniquename ilike ? and cvterm.name='vector_construct' ORDER BY stock.uniquename LIMIT 20";
1368     my $sth = $c->dbc->dbh->prepare($q);
1369     $sth->execute('%'.$term.'%');
1370     while (my ($stock_name) = $sth->fetchrow_array) {
1371         push @response_list, $stock_name;
1372     }
1373
1374     $c->stash->{rest} = \@response_list;
1375 }
1376
1377
1378 sub parents : Local : ActionClass('REST') {}
1379
1380 sub parents_GET : Path('/ajax/stock/parents') Args(0) {
1381     my $self = shift;
1382     my $c = shift;
1383
1384     my $stock_id = $c->req->param("stock_id");
1385
1386     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
1387
1388     my $female_parent_type_id = $schema->resultset("Cv::Cvterm")->find( { name=> "female_parent" } )->cvterm_id();
1389
1390     my $male_parent_type_id = $schema->resultset("Cv::Cvterm")->find( { name=> "male_parent" } )->cvterm_id();
1391
1392     my %parent_types;
1393     $parent_types{$female_parent_type_id} = "female";
1394     $parent_types{$male_parent_type_id} = "male";
1395
1396     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");
1397
1398     my @parents;
1399     while (my $p = $parent_rs->next()) {
1400         push @parents, [
1401             $p->get_column("stock_id"),
1402             $p->get_column("uniquename"),
1403         ];
1404
1405     }
1406     $c->stash->{rest} = {
1407         stock_id => $stock_id,
1408         parents => \@parents,
1409     };
1410 }
1411
1412 sub remove_stock_parent : Local : ActionClass('REST') { }
1413
1414 sub remove_parent_GET : Path('/ajax/stock/parent/remove') Args(0) {
1415     my ($self, $c) = @_;
1416
1417     my $stock_id = $c->req->param("stock_id");
1418     my $parent_id = $c->req->param("parent_id");
1419
1420     if (!$stock_id || ! $parent_id) {
1421         $c->stash->{rest} = { error => "No stock and parent specified" };
1422         return;
1423     }
1424
1425     if (! ($c->user && ($c->user->check_roles('curator') || $c->user->check_roles('submitter'))))  {
1426         $c->stash->{rest} = { error => "Log in is required, or insufficent privileges, for removing parents" };
1427         return;
1428     }
1429
1430     my $q = $c->dbic_schema("Bio::Chado::Schema")->resultset("Stock::StockRelationship")->find( { object_id => $stock_id, subject_id=> $parent_id });
1431
1432     eval {
1433         $q->delete();
1434     };
1435     if ($@) {
1436         $c->stash->{rest} = { error => $@ };
1437         return;
1438     }
1439
1440     $c->stash->{rest} = { success => 1 };
1441 }
1442
1443
1444
1445 =head2 add_stock_parent
1446
1447  Usage:
1448  Desc:
1449  Ret:
1450  Args:
1451  Side Effects:
1452  Example:
1453
1454 =cut
1455
1456 sub add_stock_parent : Local : ActionClass('REST') { }
1457
1458 sub add_stock_parent_GET :Args(0) {
1459     my ($self, $c) = @_;
1460
1461     print STDERR "Add_stock_parent function...\n";
1462     if (!$c->user()) {
1463         print STDERR "User not logged in... not associating stocks.\n";
1464         $c->stash->{rest} = {error => "You need to be logged in to add pedigree information." };
1465         return;
1466     }
1467
1468     if (!any { $_ eq "curator" || $_ eq "submitter" } ($c->user()->roles)  ) {
1469         print STDERR "User does not have sufficient privileges.\n";
1470         $c->stash->{rest} = {error =>  "you have insufficient privileges to add pedigree information." };
1471         return;
1472     }
1473
1474     my $stock_id = $c->req->param('stock_id');
1475     my $parent_name = $c->req->param('parent_name');
1476     my $parent_type = $c->req->param('parent_type');
1477
1478     my $schema = $c->dbic_schema("Bio::Chado::Schema", "sgn_chado");
1479
1480     my $cvterm_name = "";
1481     my $cross_type = "";
1482     if ($parent_type eq "male") {
1483         $cvterm_name = "male_parent";
1484     }
1485     elsif ($parent_type eq "female") {
1486         $cvterm_name = "female_parent";
1487         $cross_type = $c->req->param('cross_type');
1488     }
1489
1490     my $type_id_row = SGN::Model::Cvterm->get_cvterm_row($schema, $cvterm_name, "stock_relationship" )->cvterm_id();
1491
1492     # check if a parent of this parent_type is already associated with this stock
1493     #
1494     my $previous_parent = $schema->resultset("Stock::StockRelationship")->find({
1495         type_id => $type_id_row,
1496         object_id => $stock_id
1497     });
1498
1499     if ($previous_parent) {
1500         print STDERR "The stock ".$previous_parent->subject_id." is already associated with stock $stock_id - returning.\n";
1501         $c->stash->{rest} = { error => "A $parent_type parent with id ".$previous_parent->subject_id." is already associated with this stock. Please specify another parent." };
1502         return;
1503     }
1504
1505     print STDERR "PARENT_NAME = $parent_name STOCK_ID $stock_id  $cvterm_name\n";
1506
1507     my $stock = $schema->resultset("Stock::Stock")->find( { stock_id => $stock_id });
1508
1509    my $parent = $schema->resultset("Stock::Stock")->find( { uniquename => $parent_name } );
1510
1511
1512
1513     if (!$stock) {
1514         $c->stash->{rest} = { error => "Stock with $stock_id is not found in the database!"};
1515         return;
1516     }
1517     if (!$parent) {
1518         $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!"};
1519         return;     }
1520
1521     my $new_row = $schema->resultset("Stock::StockRelationship")->new(
1522         {
1523             subject_id => $parent->stock_id,
1524             object_id  => $stock->stock_id,
1525             type_id    => $type_id_row,
1526         value => $cross_type
1527         });
1528
1529     eval {
1530         $new_row->insert();
1531     };
1532
1533     if ($@) {
1534         $c->stash->{rest} = { error => "An error occurred: $@"};
1535     }
1536     else {
1537         $c->stash->{rest} = { error => '', };
1538     }
1539 }
1540
1541
1542
1543 sub generate_genotype_matrix : Path('/phenome/genotype/matrix/generate') :Args(1) {
1544     my $self = shift;
1545     my $c = shift;
1546     my $group = shift;
1547
1548     my $file = $c->config->{genotype_dump_file} || "/tmp/genotype_dump_file";
1549
1550     CXGN::Phenome::DumpGenotypes::dump_genotypes($c->dbc->dbh, $file);
1551
1552
1553     $c->stash->{rest}= [ 1];
1554
1555 }
1556
1557
1558 =head2 add_phenotype
1559
1560
1561 L<Catalyst::Action::REST> action.
1562
1563 Store a new phenotype and link with nd_experiment_stock
1564
1565 =cut
1566
1567
1568 sub add_phenotype :PATH('/ajax/stock/add_phenotype') : ActionClass('REST') { }
1569
1570 sub add_phenotype_GET :Args(0) {
1571     my ($self, $c) = @_;
1572     $c->stash->{rest} = { error => "Nothing here, it's a GET.." } ;
1573 }
1574
1575 sub add_phenotype_POST {
1576     my ( $self, $c ) = @_;
1577     my $response;
1578     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
1579     if (  any { $_ eq 'curator' || $_ eq 'submitter' || $_ eq 'sequencer' } $c->user->roles() ) {
1580         my $req = $c->req;
1581
1582         my $stock_id = $c->req->param('stock_id');
1583         my $project_id = $c->req->param('project_id');
1584         my $geolocation_id = $c->req->param('geolocation_id');
1585         my $observable_id = $c->req->param('observable_id');
1586         my $value = $c->req->param('value');
1587         my $date = DateTime->now;
1588         my $user =  $c->user->get_object->get_sp_person_id;
1589         try {
1590             # find the cvterm for a phenotyping experiment
1591             my $pheno_cvterm = SGN::Model::Cvterm->get_cvterm_row($schema,'phenotyping_experiment','experiment_type');
1592
1593
1594             #create the new phenotype
1595             my $phenotype = $schema->resultset("Phenotype::Phenotype")->find_or_create(
1596                 {
1597                     observable_id => $observable_id, #cvterm
1598                     value => $value ,
1599                     uniquename => "Stock: $stock_id, Observable id: $observable_id. Uploaded by web form by $user on $date" ,
1600                 });
1601             #create a new nd_experiment
1602             my $experiment = $schema->resultset('NaturalDiversity::NdExperiment')->create(
1603                 {
1604                     nd_geolocation_id => $geolocation_id,
1605                     type_id => $pheno_cvterm->cvterm_id(),
1606                 } );
1607             #link to the project
1608             $experiment->find_or_create_related('nd_experiment_projects', {
1609                 project_id => $project_id,
1610                                                 } );
1611             #link the experiment to the stock
1612             $experiment->find_or_create_related('nd_experiment_stocks' , {
1613                 stock_id => $stock_id,
1614                 type_id  =>  $pheno_cvterm->cvterm_id(),
1615                                                 });
1616             #link the phenotype with the nd_experiment
1617             my $nd_experiment_phenotype = $experiment->find_or_create_related(
1618                 'nd_experiment_phenotypes', {
1619                     phenotype_id => $phenotype->phenotype_id()
1620                 } );
1621
1622             $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" , }
1623         } catch {
1624             $response = { error => "Failed: $_" }
1625         };
1626     }  else {  $c->stash->{rest} = { error => 'user does not have a curator/sequencer/submitter account' };
1627     }
1628 }
1629
1630 =head2 action stock_members_phenotypes()
1631
1632  Usage:        /stock/<stock_id>/datatables/traits
1633  Desc:         get all the phenotypic scores associated with the stock $stock_id
1634  Ret:          json of the form
1635                { data => [  { db_name : 'A', observable: 'B', value : 'C' }, { ... }, ] }
1636  Args:
1637  Side Effects:
1638  Example:
1639
1640 =cut
1641
1642 sub stock_members_phenotypes :Chained('/stock/get_stock') PathPart('datatables/traits') Args(0) {
1643     my $self = shift;
1644     my $c = shift;
1645     #my $trait_id = shift;
1646
1647
1648     my $subject_phenotypes = $self->get_phenotypes($c);
1649
1650     # collect the data from the hashref...
1651     #
1652     my @stock_data;
1653
1654     foreach my $project (keys (%$subject_phenotypes)) {
1655         foreach my $trait (@{$subject_phenotypes->{$project}}) {
1656             push @stock_data, [
1657                 $project,
1658                 $trait->get_column("db_name").":".$trait->get_column("accession"),
1659                 $trait->get_column("observable"),
1660                 $trait->get_column("value"),
1661             ];
1662         }
1663     }
1664
1665     $c->stash->{rest} = { data => \@stock_data,
1666                           #has_members_genotypes => $has_members_genotypes
1667     };
1668
1669 }
1670
1671 sub _stock_project_phenotypes {
1672     my ($self, $schema, $bcs_stock) = @_;
1673
1674     return {} unless $bcs_stock;
1675     my $rs =  $schema->resultset("Stock::Stock")->stock_phenotypes_rs($bcs_stock);
1676     my %project_hashref;
1677     while ( my $r = $rs->next) {
1678         my $project_desc = $r->get_column('project_description');
1679         push @{ $project_hashref{ $project_desc }}, $r;
1680     }
1681     return \%project_hashref;
1682 }
1683
1684 =head2 action get_stock_trials()
1685
1686  Usage:        /stock/<stock_id>/datatables/trials
1687  Desc:         retrieves trials associated with the stock
1688  Ret:          a table in json suitable for datatables
1689  Args:
1690  Side Effects:
1691  Example:
1692
1693 =cut
1694
1695 sub get_stock_trials :Chained('/stock/get_stock') PathPart('datatables/trials') Args(0) {
1696     my $self = shift;
1697     my $c = shift;
1698
1699     my @trials = $c->stash->{stock}->get_trials();
1700
1701     my @formatted_trials;
1702     foreach my $t (@trials) {
1703         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>' ];
1704     }
1705     $c->stash->{rest} = { data => \@formatted_trials };
1706 }
1707
1708 =head2 action get_stock_breeding_programs()
1709
1710  Usage:        /stock/<stock_id>/datatables/breeding_programs
1711  Desc:         retrieves breeding programs that use this stock (accession)
1712  Ret:          a table in json suitable for datatables
1713  Args:
1714  Side Effects:
1715  Example:
1716
1717 =cut
1718
1719 sub get_stock_breeding_programs :Chained('/stock/get_stock') PathPart('datatables/breeding_programs') Args(0) {
1720     my $self = shift;
1721     my $c = shift;
1722
1723         my @breeding_programs = $c->stash->{stock}->get_breeding_programs();
1724
1725     my @formatted_programs;
1726     foreach my $t (@breeding_programs) {
1727         push @formatted_programs, [ '<a href="/breeders/program/'.$t->[0].'">'.$t->[1].'</a>' ];
1728     }
1729     $c->stash->{rest} = { data => \@formatted_programs };
1730 }
1731
1732 =head2 action get_stored_analyses()
1733
1734  Usage:        /stock/<stock_id>/datatables/stored_analyses
1735  Desc:         retrieves analyses associated with the stock (accession)
1736  Ret:          a table in json suitable for datatables
1737  Args:
1738  Side Effects:
1739  Example:
1740
1741 =cut
1742
1743 sub get_stock_stored_analyses :Chained('/stock/get_stock') PathPart('datatables/stored_analyses') Args(0) {
1744     my $self = shift;
1745     my $c = shift;
1746
1747         my @stored_analyses = $c->stash->{stock}->get_stored_analyses();
1748
1749     my @formatted_analyses;
1750     foreach my $t (@stored_analyses) {
1751         push @formatted_analyses, [ '<a href="/analyses/'.$t->[0].'">'.$t->[1].'</a>' ];
1752     }
1753     $c->stash->{rest} = { data => \@formatted_analyses };
1754 }
1755
1756 =head2 action get_shared_trials()
1757
1758  Usage:        /datatables/sharedtrials
1759  Desc:         retrieves trials associated with multiple stocks
1760  Ret:          a table in json suitable for datatables
1761  Args:         array of stock uniquenames
1762  Side Effects:
1763  Example:
1764
1765 =cut
1766
1767 sub get_shared_trials :Path('/stock/get_shared_trials') : ActionClass('REST'){
1768
1769 sub get_shared_trials_POST :Args(1) {
1770     my ($self, $c) = @_;
1771     $c->stash->{rest} = { error => "Nothing here, it's a POST.." } ;
1772 }
1773 sub get_shared_trials_GET :Args(1) {
1774
1775     my $self = shift;
1776     my $c = shift;
1777     my @stock_ids = $c->request->param( 'stock_ids[]' );
1778     my $stock_string = join ",", map { "'$_'" } (@stock_ids);
1779     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
1780     my $dbh = $c->dbc->dbh();
1781     my $bs = CXGN::BreederSearch->new( { dbh=>$dbh } );
1782
1783     my $criteria_list = [
1784                'accessions',
1785                'trials'
1786              ];
1787
1788     my $dataref = {
1789                'trials' => {
1790                            'accessions' => $stock_string
1791                          }
1792                   };
1793
1794     my $queryref = {
1795                'trials' => {
1796                            'accessions' => 1
1797                          }
1798                   };
1799
1800     my $status = $bs->test_matviews($c->config->{dbhost}, $c->config->{dbname}, $c->config->{dbuser}, $c->config->{dbpass});
1801     if ($status->{'error'}) {
1802       $c->stash->{rest} = { error => $status->{'error'}};
1803       return;
1804     }
1805     my $trial_query = $bs->metadata_query($criteria_list, $dataref, $queryref);
1806     my @shared_trials = @{$trial_query->{results}};
1807
1808     my @formatted_rows = ();
1809
1810     foreach my $stock_id (@stock_ids) {
1811              my $trials_string ='';
1812        my $stock = CXGN::Stock->new(schema => $schema, stock_id => $stock_id);
1813        my $uniquename = $stock->uniquename;
1814        $dataref = {
1815              'trials' => {
1816                          'accessions' => $stock_id
1817                        }
1818                 };
1819         $trial_query = $bs->metadata_query($criteria_list, $dataref, $queryref);
1820         my @current_trials = @{$trial_query->{results}};
1821               my $num_trials = scalar @current_trials;
1822
1823               foreach my $t (@current_trials) {
1824           print STDERR "t = " . Dumper($t);
1825           $trials_string = $trials_string . '<a href="/breeders/trial/'.$t->[0].'">'.$t->[1].'</a>,  ';
1826               }
1827               $trials_string =~ s/,\s+$//;
1828               push @formatted_rows, ['<a href="/stock/'.$stock_id.'/view">'.$uniquename.'</a>', $num_trials, $trials_string ];
1829     }
1830
1831     my $num_trials = scalar @shared_trials;
1832     if ($num_trials > 0) {
1833             my $trials_string = '';
1834             foreach my $t (@shared_trials) {
1835                $trials_string = $trials_string . '<a href="/breeders/trial/'.$t->[0].'">'.$t->[1].'</a>,  ';
1836       }
1837             $trials_string  =~ s/,\s+$//;
1838             push @formatted_rows, [ "Trials in Common", $num_trials, $trials_string];
1839     } else {
1840       push @formatted_rows, [ "Trials in Common", $num_trials, "No shared trials found."];
1841     }
1842
1843     $c->stash->{rest} = { data => \@formatted_rows, shared_trials => \@shared_trials };
1844   }
1845 }
1846
1847 =head2 action get_stock_trait_list()
1848
1849  Usage:        /stock/<stock_id>/datatables/traitlist
1850  Desc:         retrieves the list of traits assayed on the stock
1851  Ret:          json in a table format, suitable for datatables
1852  Args:
1853  Side Effects:
1854  Example:
1855
1856 =cut
1857
1858 sub get_stock_trait_list :Chained('/stock/get_stock') PathPart('datatables/traitlist') Args(0) {
1859     my $self = shift;
1860     my $c = shift;
1861
1862     my @trait_list = $c->stash->{stock}->get_trait_list();
1863
1864     my @formatted_list;
1865     foreach my $t (@trait_list) {
1866         print STDERR Dumper($t);
1867         push @formatted_list, [ '<a href="/cvterm/'.$t->[0].'/view">'.$t->[1].'</a>', $t->[2], sprintf("%3.1f", $t->[3]), sprintf("%3.1f", $t->[4]), sprintf("%.0f", $t->[5])];
1868     }
1869     print STDERR Dumper(\@formatted_list);
1870
1871     $c->stash->{rest} = { data => \@formatted_list };
1872 }
1873
1874 sub get_phenotypes_by_stock_and_trial :Chained('/stock/get_stock') PathPart('datatables/trial') Args(1) {
1875     my $self = shift;
1876     my $c = shift;
1877     my $trial_id = shift;
1878     my $stock_type = $c->stash->{stock}->get_type()->name();
1879
1880     my $q;
1881     if ($stock_type eq 'accession'){
1882         $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";
1883     } else {
1884         $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";
1885     }
1886
1887     my $h = $c->dbc->dbh->prepare($q);
1888     $h->execute($trial_id, $c->stash->{stock}->get_stock_id());
1889
1890     my @phenotypes;
1891     while (my ($stock_id, $stock_name, $cvterm_id, $cvterm_name, $avg, $stddev, $count) = $h->fetchrow_array()) {
1892         push @phenotypes, [ "<a href=\"/cvterm/$cvterm_id/view\">$cvterm_name</a>", sprintf("%.2f", $avg), sprintf("%.2f", $stddev), $count ];
1893     }
1894     $c->stash->{rest} = { data => \@phenotypes };
1895 }
1896
1897 sub get_phenotypes {
1898     my $self = shift;
1899     my $c = shift;
1900     shift;
1901     my $trait_id = shift;
1902
1903     my $stock_id = $c->stash->{stock_row}->stock_id();
1904
1905     my $schema = $c->dbic_schema("Bio::Chado::Schema");
1906     my $bcs_stock_rs = $schema->resultset("Stock::Stock")->search( { stock_id => $stock_id });
1907
1908     if (! $bcs_stock_rs) { die "The stock $stock_id does not exist in the database"; }
1909
1910     my $bcs_stock = $bcs_stock_rs->first();
1911
1912
1913     # now we have rs of stock_relationship objects. We need to find
1914     # the phenotypes of their related subjects
1915     #
1916     my $subjects = $bcs_stock->search_related('stock_relationship_objects')
1917                              ->search_related('subject');
1918     my $subject_phenotypes = $self->_stock_project_phenotypes($schema, $subjects );
1919
1920     return $subject_phenotypes;
1921 }
1922
1923 sub get_pedigree_string :Chained('/stock/get_stock') PathPart('pedigree') Args(0) {
1924     my $self = shift;
1925     my $c = shift;
1926     my $level = $c->req->param("level");
1927
1928     my $stock = CXGN::Stock->new(
1929         schema => $c->dbic_schema("Bio::Chado::Schema"),
1930         stock_id => $c->stash->{stock}->get_stock_id()
1931     );
1932     my $parents = $stock->get_pedigree_string($level);
1933     print STDERR "Parents are: ".Dumper($parents)."\n";
1934
1935     $c->stash->{rest} = { pedigree_string => $parents };
1936 }
1937
1938
1939 sub get_pedigree_string_ :Chained('/stock/get_stock') PathPart('pedigreestring') Args(0) {
1940     my $self = shift;
1941     my $c = shift;
1942     my $level = $c->req->param("level");
1943     my $stock_id = $c->stash->{stock}->get_stock_id();
1944     my $stock_name = $c->stash->{stock}->get_uniquename();
1945
1946     my $pedigree_string;
1947
1948     my %pedigree = _get_pedigree_hash($c,[$stock_id]);
1949
1950     if ($level eq "Parents") {
1951         my $mother = $pedigree{$stock_name}{'1'}{'mother'} || 'NA';
1952         my $father = $pedigree{$stock_name}{'1'}{'father'} || 'NA';
1953         $pedigree_string = "$mother/$father" ;
1954     }
1955     elsif ($level eq "Grandparents") {
1956         my $maternal_mother = $pedigree{$pedigree{$stock_name}{'1'}{'mother'}}{'2'}{'mother'} || 'NA';
1957         my $maternal_father = $pedigree{$pedigree{$stock_name}{'1'}{'mother'}}{'2'}{'father'} || 'NA';
1958         my $paternal_mother = $pedigree{$pedigree{$stock_name}{'1'}{'father'}}{'2'}{'mother'} || 'NA';
1959         my $paternal_father = $pedigree{$pedigree{$stock_name}{'1'}{'father'}}{'2'}{'father'} || 'NA';
1960         my $maternal_parent_string = "$maternal_mother/$maternal_father";
1961         my $paternal_parent_string = "$paternal_mother/$paternal_father";
1962         $pedigree_string =  "$maternal_parent_string//$paternal_parent_string";
1963     }
1964     elsif ($level eq "Great-Grandparents") {
1965         my $m_maternal_mother = $pedigree{$pedigree{$pedigree{$stock_name}{'1'}{'mother'}}{'2'}{'mother'}}{'3'}{'mother'} || 'NA';
1966         my $m_maternal_father = $pedigree{$pedigree{$pedigree{$stock_name}{'1'}{'mother'}}{'2'}{'mother'}}{'3'}{'father'} || 'NA';
1967         my $p_maternal_mother = $pedigree{$pedigree{$pedigree{$stock_name}{'1'}{'mother'}}{'2'}{'father'}}{'3'}{'mother'} || 'NA';
1968         my $p_maternal_father = $pedigree{$pedigree{$pedigree{$stock_name}{'1'}{'mother'}}{'2'}{'father'}}{'3'}{'father'} || 'NA';
1969         my $m_paternal_mother = $pedigree{$pedigree{$pedigree{$stock_name}{'1'}{'father'}}{'2'}{'mother'}}{'3'}{'mother'} || 'NA';
1970         my $m_paternal_father = $pedigree{$pedigree{$pedigree{$stock_name}{'1'}{'father'}}{'2'}{'mother'}}{'3'}{'father'} || 'NA';
1971         my $p_paternal_mother = $pedigree{$pedigree{$pedigree{$stock_name}{'1'}{'father'}}{'2'}{'father'}}{'3'}{'mother'} || 'NA';
1972         my $p_paternal_father = $pedigree{$pedigree{$pedigree{$stock_name}{'1'}{'father'}}{'2'}{'father'}}{'3'}{'father'} || 'NA';
1973         my $mm_parent_string = "$m_maternal_mother/$m_maternal_father";
1974         my $mf_parent_string = "$p_maternal_mother/$p_maternal_father";
1975         my $pm_parent_string = "$m_paternal_mother/$m_paternal_father";
1976         my $pf_parent_string = "$p_paternal_mother/$p_paternal_father";
1977         $pedigree_string =  "$mm_parent_string//$mf_parent_string///$pm_parent_string//$pf_parent_string";
1978     }
1979     $c->stash->{rest} = { pedigree_string => $pedigree_string };
1980 }
1981
1982 sub _get_pedigree_hash {
1983     my ($c, $accession_ids, $format) = @_;
1984
1985     my $placeholders = join ( ',', ('?') x @$accession_ids );
1986     my $query = "
1987         WITH RECURSIVE included_rows(child, child_id, mother, mother_id, father, father_id, type, depth, path, cycle) AS (
1988                 SELECT c.uniquename AS child,
1989                 c.stock_id AS child_id,
1990                 m.uniquename AS mother,
1991                 m.stock_id AS mother_id,
1992                 f.uniquename AS father,
1993                 f.stock_id AS father_id,
1994                 m_rel.value AS type,
1995                 1,
1996                 ARRAY[c.stock_id],
1997                 false
1998                 FROM stock c
1999                 LEFT JOIN stock_relationship m_rel ON(c.stock_id = m_rel.object_id and m_rel.type_id = (SELECT cvterm_id FROM cvterm WHERE name = 'female_parent'))
2000                 LEFT JOIN stock m ON(m_rel.subject_id = m.stock_id)
2001                 LEFT JOIN stock_relationship f_rel ON(c.stock_id = f_rel.object_id and f_rel.type_id = (SELECT cvterm_id FROM cvterm WHERE name = 'male_parent'))
2002                 LEFT JOIN stock f ON(f_rel.subject_id = f.stock_id)
2003                 WHERE c.stock_id IN ($placeholders)
2004                 GROUP BY 1,2,3,4,5,6,7,8,9,10
2005             UNION
2006                 SELECT c.uniquename AS child,
2007                 c.stock_id AS child_id,
2008                 m.uniquename AS mother,
2009                 m.stock_id AS mother_id,
2010                 f.uniquename AS father,
2011                 f.stock_id AS father_id,
2012                 m_rel.value AS type,
2013                 included_rows.depth + 1,
2014                 path || c.stock_id,
2015                 c.stock_id = ANY(path)
2016                 FROM included_rows, stock c
2017                 LEFT JOIN stock_relationship m_rel ON(c.stock_id = m_rel.object_id and m_rel.type_id = (SELECT cvterm_id FROM cvterm WHERE name = 'female_parent'))
2018                 LEFT JOIN stock m ON(m_rel.subject_id = m.stock_id)
2019                 LEFT JOIN stock_relationship f_rel ON(c.stock_id = f_rel.object_id and f_rel.type_id = (SELECT cvterm_id FROM cvterm WHERE name = 'male_parent'))
2020                 LEFT JOIN stock f ON(f_rel.subject_id = f.stock_id)
2021                 WHERE c.stock_id IN (included_rows.mother_id, included_rows.father_id) AND NOT cycle
2022                 GROUP BY 1,2,3,4,5,6,7,8,9,10
2023         )
2024         SELECT child, mother, father, type, depth
2025         FROM included_rows
2026         GROUP BY 1,2,3,4,5
2027         ORDER BY 5,1;";
2028
2029     my $sth = $c->dbc->dbh->prepare($query);
2030     $sth->execute(@$accession_ids);
2031
2032     my %pedigree;
2033     no warnings 'uninitialized';
2034     while (my ($name, $mother, $father, $cross_type, $depth) = $sth->fetchrow_array()) {
2035         $pedigree{$name}{$depth}{'mother'} = $mother;
2036         $pedigree{$name}{$depth}{'father'} = $father;
2037     }
2038     return %pedigree;
2039 }
2040
2041 sub stock_lookup : Path('/stock_lookup/') Args(2) ActionClass('REST') { }
2042
2043 sub stock_lookup_POST {
2044     my $self = shift;
2045     my $c = shift;
2046     my $lookup_from_field = shift;
2047     my $lookup_field = shift;
2048     my $value_to_lookup = $c->req->param($lookup_from_field);
2049
2050     #print STDERR $lookup_from_field;
2051     #print STDERR $lookup_field;
2052     #print STDERR $value_to_lookup;
2053
2054     my $schema = $c->dbic_schema("Bio::Chado::Schema");
2055     my $s = $schema->resultset("Stock::Stock")->find( { $lookup_from_field => $value_to_lookup } );
2056     my $value;
2057     if ($s && $lookup_field eq 'stock_id') {
2058         $value = $s->stock_id();
2059     }
2060     $c->stash->{rest} = { $lookup_from_field => $value_to_lookup, $lookup_field => $value };
2061 }
2062
2063 sub get_trial_related_stock:Chained('/stock/get_stock') PathPart('datatables/trial_related_stock') Args(0){
2064     my $self = shift;
2065     my $c = shift;
2066     my $stock_id = $c->stash->{stock_row}->stock_id();
2067
2068     my $schema = $c->dbic_schema("Bio::Chado::Schema", 'sgn_chado');
2069
2070     my $trial_related_stock = CXGN::Stock::RelatedStocks->new({dbic_schema => $schema, stock_id =>$stock_id});
2071     my $result = $trial_related_stock->get_trial_related_stock();
2072     my @stocks;
2073     my @accessions;
2074     my @crosses;
2075     my @family_names;
2076     my @plots;
2077     my @subplots;
2078     my @plants;
2079     my @tissue_samples;
2080     my @seedlots;
2081     my @others;
2082     foreach my $r (@$result){
2083         my ($stock_id, $stock_name, $cvterm_name) = @$r;
2084         my $url;
2085
2086         if ($cvterm_name eq 'cross') {
2087             $url = qq{<a href = "/cross/$stock_id">$stock_name</a>};
2088         } elsif ($cvterm_name eq 'family_name') {
2089             $url = qq{<a href = "/family/$stock_id/">$stock_name</a>};
2090         } else {
2091             $url = qq{<a href = "/stock/$stock_id/view">$stock_name</a>};
2092         }
2093
2094         if ($cvterm_name eq 'accession') {
2095             push @accessions, [$cvterm_name, $url, $stock_name];
2096         } elsif ($cvterm_name eq 'cross') {
2097             push @crosses, [$cvterm_name, $url, $stock_name];
2098         } elsif ($cvterm_name eq 'family_name') {
2099             push @family_names, [$cvterm_name, $url, $stock_name];
2100         } elsif ($cvterm_name eq 'plot') {
2101             push @plots, [$cvterm_name, $url, $stock_name];
2102         } elsif ($cvterm_name eq 'subplot') {
2103             push @subplots, [$cvterm_name, $url, $stock_name];
2104         } elsif ($cvterm_name eq 'plant') {
2105             push @plants, [$cvterm_name, $url, $stock_name];
2106         }
2107     }
2108
2109     if (scalar(@accessions) > 0) {
2110         push @stocks, @accessions;
2111     }
2112     if (scalar(@crosses) > 0) {
2113         push @stocks, @crosses;
2114     }
2115     if (scalar(@family_names) > 0) {
2116         push @stocks, @family_names;
2117     }
2118     if (scalar(@plots) > 0) {
2119         push @stocks, @plots;
2120     }
2121     if (scalar(@subplots) > 0) {
2122         push @stocks, @subplots;
2123     }
2124     if (scalar(@plants) > 0) {
2125         push @stocks, @plants;
2126     }
2127     if (scalar(@seedlots) > 0) {
2128         push @stocks, @seedlots;
2129     }
2130     if (scalar(@others) > 0) {
2131         push @stocks, @others;
2132     }
2133
2134     $c->stash->{rest}={data=>\@stocks};
2135 }
2136
2137 sub get_progenies:Chained('/stock/get_stock') PathPart('datatables/progenies') Args(0){
2138     my $self = shift;
2139     my $c = shift;
2140     my $stock_id = $c->stash->{stock_row}->stock_id();
2141
2142     my $schema = $c->dbic_schema("Bio::Chado::Schema", 'sgn_chado');
2143     my $progenies = CXGN::Stock::RelatedStocks->new({dbic_schema => $schema, stock_id =>$stock_id});
2144     my $result = $progenies->get_progenies();
2145     my @stocks;
2146     foreach my $r (@$result){
2147         my ($cvterm_name, $stock_id, $stock_name, $cross_type) = @$r;
2148
2149         if (! $cross_type) { $cross_type = 'unspecified'; }
2150
2151         push @stocks, [$cvterm_name, $cross_type, qq{<a href = "/stock/$stock_id/view">$stock_name</a>}, $stock_name ];
2152     }
2153
2154     $c->stash->{rest}={data=>\@stocks};
2155 }
2156
2157 sub get_siblings:Chained('/stock/get_stock') PathPart('datatables/siblings') Args(0){
2158     my $self = shift;
2159     my $c = shift;
2160     my $stock_id = $c->stash->{stock_row}->stock_id();
2161
2162     my $schema = $c->dbic_schema("Bio::Chado::Schema", 'sgn_chado');
2163     my $stock = CXGN::Stock->new({schema => $schema, stock_id=>$stock_id});
2164     my $parents = $stock->get_parents();
2165     my $female_parent = $parents->{'mother'};
2166     my $male_parent = $parents->{'father'};
2167
2168     my @siblings;
2169     if ($female_parent) {
2170         my $family = CXGN::Cross->get_progeny_info($schema, $female_parent, $male_parent);
2171         foreach my $sib(@$family){
2172             my ($female_parent_id, $female_parent_name, $male_parent_id, $male_parent_name, $sibling_id, $sibling_name, $cross_type) = @$sib;
2173             if ($sibling_id != $stock_id) {
2174                 push @siblings, [
2175                     qq{<a href="/stock/$sibling_id/view">$sibling_name</a>},
2176                     qq{<a href="/stock/$female_parent_id/view">$female_parent_name</a>},
2177                     qq{<a href="/stock/$male_parent_id/view">$male_parent_name</a>},
2178                     $cross_type,
2179                     $sibling_name ];
2180             }
2181         }
2182     }
2183     $c->stash->{rest}={data=>\@siblings};
2184 }
2185
2186 sub get_parents :Chained('/stock/get_stock') PathPart('datatables/parents') Args(0) {
2187     my $self = shift;
2188     my $c = shift;
2189     my $stock_id = $c->stash->{stock_row}->stock_id();
2190
2191     my $schema = $c->dbic_schema("Bio::Chado::Schema", 'sgn_chado');
2192     my $stock = CXGN::Stock->new({schema => $schema, stock_id=>$stock_id});
2193     my $parents = $stock->get_parents();
2194     my $female_parent = $parents->{'mother'};
2195     my $female_parent_id = $parents->{'mother_id'};
2196     my $male_parent = $parents->{'father'};
2197     my $male_parent_id = $parents->{'father_id'};
2198
2199     my $female_parent_link = qq { <a href="/stock/$female_parent_id/view">$female_parent</a> };
2200
2201     my $male_parent_link = qq { <a href="/stock/$male_parent_id/view">$male_parent</a> };
2202
2203     my $cross_type = $parents->{'cross_type'};
2204
2205     print STDERR "PARENTS: ".Dumper($parents);
2206     $c->stash->{rest}= { data => [ [ $female_parent_link, $male_parent_link, $cross_type ] ] };
2207
2208 }
2209
2210
2211 sub get_group_and_member:Chained('/stock/get_stock') PathPart('datatables/group_and_member') Args(0){
2212     my $self = shift;
2213     my $c = shift;
2214     my $stock_id = $c->stash->{stock_row}->stock_id();
2215
2216     my $schema = $c->dbic_schema("Bio::Chado::Schema", 'sgn_chado');
2217
2218     my $related_groups = CXGN::Stock::RelatedStocks->new({dbic_schema => $schema, stock_id =>$stock_id});
2219     my $result = $related_groups->get_group_and_member();
2220     my @group;
2221
2222     foreach my $r (@$result){
2223         my ($stock_id, $stock_name, $cvterm_name) = @$r;
2224         if ($cvterm_name eq "cross"){
2225             push @group, [qq{<a href=\"/cross/$stock_id\">$stock_name</a>}, $cvterm_name, $stock_name];
2226         } else {
2227             push @group, [qq{<a href = "/stock/$stock_id/view">$stock_name</a>}, $cvterm_name, $stock_name];
2228         }
2229     }
2230
2231     $c->stash->{rest}={data=>\@group};
2232
2233 }
2234
2235 sub get_stock_for_tissue:Chained('/stock/get_stock') PathPart('datatables/stock_for_tissue') Args(0){
2236     my $self = shift;
2237     my $c = shift;
2238     my $stock_id = $c->stash->{stock_row}->stock_id();
2239
2240     my $schema = $c->dbic_schema("Bio::Chado::Schema", 'sgn_chado');
2241
2242     my $tissue_stocks = CXGN::Stock::RelatedStocks->new({dbic_schema => $schema, stock_id =>$stock_id});
2243     my $result = $tissue_stocks->get_stock_for_tissue();
2244     my @stocks;
2245     foreach my $r (@$result){
2246
2247       my ($stock_id, $stock_name, $cvterm_name) = @$r;
2248
2249       push @stocks, [$cvterm_name, qq{<a href = "/stock/$stock_id/view">$stock_name</a>}, $stock_name];
2250     }
2251
2252     $c->stash->{rest}={data=>\@stocks};
2253
2254 }
2255
2256
2257 sub get_plot_plant_related_seedlots:Chained('/stock/get_stock') PathPart('datatables/plot_plant_related_seedlots') Args(0){
2258     my $self = shift;
2259     my $c = shift;
2260     my $stock_id = $c->stash->{stock_row}->stock_id();
2261
2262     my $schema = $c->dbic_schema("Bio::Chado::Schema", 'sgn_chado');
2263     my $progenies = CXGN::Stock::RelatedStocks->new({dbic_schema => $schema, stock_id =>$stock_id});
2264     my $result = $progenies->get_plot_plant_related_seedlots();
2265     my @stocks;
2266     foreach my $r (@$result){
2267         my ($transaction_type, $stock_type, $stock_id, $stock_name) = @$r;
2268         push @stocks, [$transaction_type, $stock_type, qq{<a href = "/breeders/seedlot/$stock_id">$stock_name</a>}, $stock_name];
2269     }
2270
2271     $c->stash->{rest}={data=>\@stocks};
2272 }
2273
2274
2275 sub get_stock_datatables_genotype_data : Chained('/stock/get_stock') :PathPart('datatables/genotype_data') : ActionClass('REST') { }
2276
2277 sub get_stock_datatables_genotype_data_GET  {
2278     my $self = shift;
2279     my $c = shift;
2280     my $limit = $c->req->param('length') || 1000;
2281     my $offset = $c->req->param('start') || 0;
2282     my $stock_id = $c->stash->{stock_row}->stock_id();
2283
2284     my $schema = $c->dbic_schema("Bio::Chado::Schema", 'sgn_chado');
2285     my $people_schema = $c->dbic_schema("CXGN::People::Schema");
2286     my $stock = CXGN::Stock->new({schema => $schema, stock_id => $stock_id});
2287     my $stock_type = $stock->type();
2288
2289     my %genotype_search_params = (
2290         bcs_schema=>$schema,
2291         people_schema=>$people_schema,
2292         cache_root=>$c->config->{cache_file_path},
2293         genotypeprop_hash_select=>[],
2294         protocolprop_top_key_select=>[],
2295         protocolprop_marker_hash_select=>[]
2296     );
2297     if ($stock_type eq 'accession') {
2298         $genotype_search_params{accession_list} = [$stock_id];
2299     } elsif ($stock_type eq 'tissue_sample') {
2300         $genotype_search_params{tissue_sample_list} = [$stock_id];
2301     }
2302     my $genotypes_search = CXGN::Genotype::Search->new(\%genotype_search_params);
2303     my $file_handle = $genotypes_search->get_cached_file_search_json($c->config->{cluster_shared_tempdir}, 1); #only gets metadata and not all genotype data!
2304
2305     my @result;
2306     my $counter = 0;
2307
2308     open my $fh, "<& :encoding(UTF-8)", $file_handle or die "Can't open output file: $!";
2309     my $header_line = <$fh>;
2310     if ($header_line) {
2311         my $marker_objects = decode_json $header_line;
2312
2313         my $start_index = $offset;
2314         my $end_index = $offset + $limit;
2315         # print STDERR Dumper [$start_index, $end_index];
2316
2317         while (my $gt_line = <$fh>) {
2318             if ($counter >= $start_index && $counter < $end_index) {
2319                 my $g = decode_json $gt_line;
2320
2321                 push @result, [
2322                     '<a href = "/breeders_toolbox/trial/'.$g->{genotypingDataProjectDbId}.'">'.$g->{genotypingDataProjectName}.'</a>',
2323                     $g->{genotypingDataProjectDescription},
2324                     $g->{analysisMethod},
2325                     $g->{genotypeDescription},
2326                     '<a href="/stock/'.$stock_id.'/genotypes?genotype_id='.$g->{genotypeDbId}.'">Download</a>'
2327                 ];
2328             }
2329             $counter++;
2330         }
2331     }
2332
2333     my $draw = $c->req->param('draw');
2334     if ($draw){
2335         $draw =~ s/\D//g; # cast to int
2336     }
2337
2338     $c->stash->{rest} = { data => \@result, draw => $draw, recordsTotal => $counter,  recordsFiltered => $counter };
2339 }
2340
2341 =head2 make_stock_obsolete
2342
2343 L<Catalyst::Action::REST> action.
2344
2345 Makes a stock entry obsolete in the database
2346
2347 =cut
2348
2349 sub stock_obsolete : Path('/stock/obsolete') : ActionClass('REST') { }
2350
2351 sub stock_obsolete_GET {
2352     my ( $self, $c ) = @_;
2353     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
2354     if (!$c->user()) {
2355         $c->stash->{rest} = { error => "Log in required for making stock obsolete." }; return;
2356     }
2357
2358     if ( !any { $_ eq 'curator' || $_ eq 'submitter' || $_ eq 'sequencer' } $c->user->roles() ) {
2359         $c->stash->{rest} = { error => 'user does not have a curator/sequencer/submitter account' };
2360         $c->detach();
2361     }
2362
2363     my $stock_id = $c->req->param('stock_id');
2364     my $is_obsolete  = $c->req->param('is_obsolete');
2365
2366         my $stock = $schema->resultset("Stock::Stock")->find( { stock_id => $stock_id } );
2367
2368     if ($stock) {
2369
2370         try {
2371             my $stock = CXGN::Stock->new({
2372                 schema=>$schema,
2373                 stock_id=>$stock_id,
2374                 is_saving=>1,
2375                 sp_person_id => $c->user()->get_object()->get_sp_person_id(),
2376                 user_name => $c->user()->get_object()->get_username(),
2377                 modification_note => "Obsolete at ".localtime,
2378                 is_obsolete => $is_obsolete
2379             });
2380             my $saved_stock_id = $stock->store();
2381
2382             my $dbh = $c->dbc->dbh();
2383             my $bs = CXGN::BreederSearch->new( { dbh=>$dbh, dbname=>$c->config->{dbname}, } );
2384             my $refresh = $bs->refresh_matviews($c->config->{dbhost}, $c->config->{dbname}, $c->config->{dbuser}, $c->config->{dbpass}, 'stockprop', 'concurrent', $c->config->{basepath});
2385
2386             $c->stash->{rest} = { message => "Stock obsoleted" };
2387         } catch {
2388             $c->stash->{rest} = { error => "Failed: $_" }
2389         };
2390     } else {
2391             $c->stash->{rest} = { error => "Not a valid stock $stock_id " };
2392         }
2393
2394     #$c->stash->{rest} = { message => 'success' };
2395 }
2396
2397
2398 sub get_accessions_with_pedigree : Path('/ajax/stock/accessions_with_pedigree') : ActionClass('REST') { }
2399
2400 sub get_accessions_with_pedigree_GET {
2401     my $self = shift;
2402     my $c = shift;
2403     my $schema = $c->dbic_schema("Bio::Chado::Schema");
2404
2405     my $result = CXGN::Cross->get_progeny_info($schema);
2406
2407     my @accessions_with_pedigree;
2408     foreach my $accession_info (@$result){
2409         my ($female_id, $female_name, $male_id, $male_name, $accession_id, $accession_name, $cross_type) =@$accession_info;
2410         push @accessions_with_pedigree, [ qq{<a href="/stock/$accession_id/view">$accession_name</a>},
2411             qq{<a href="/stock/$female_id/view">$female_name</a>},
2412             qq{<a href="/stock/$male_id/view">$male_name</a>}, $cross_type, $accession_name ];
2413     }
2414     print STDERR "ACCESSIONS =".Dumper(\@accessions_with_pedigree)."\n";
2415     $c->stash->{rest} = { data => \@accessions_with_pedigree };
2416 }
2417
2418
2419 sub get_accessions_missing_pedigree : Path('/ajax/stock/accessions_missing_pedigree') : ActionClass('REST') { }
2420
2421 sub get_accessions_missing_pedigree_GET {
2422     my $self = shift;
2423     my $c = shift;
2424     my $schema = $c->dbic_schema("Bio::Chado::Schema");
2425     my $phenome_schema = $c->dbic_schema("CXGN::Phenome::Schema");
2426     my $dbh = $c->dbc->dbh();
2427
2428     my $result = CXGN::Cross->get_accessions_missing_pedigree($schema);
2429
2430     my $stock_lookup = CXGN::Stock::StockLookup->new({ schema => $schema} );
2431     my $owners_hash = $stock_lookup->get_owner_hash_lookup();
2432
2433     my @accessions_missing_pedigree;
2434     foreach my $accession_info (@$result){
2435         my @owners = ();
2436         my $owner_link;
2437         my ($accession_id, $accession_name) =@$accession_info;
2438         my $owner_info = $owners_hash->{$accession_id};
2439         print STDERR "OWNER INFO =".Dumper($owner_info)."\n";
2440         if (defined $owner_info){
2441             my @list_of_owners = @$owner_info;
2442             foreach my $each_owner (@list_of_owners) {
2443                 my $owner_id = $each_owner->[0];
2444                 my $first_name = $each_owner->[2];
2445                 my $last_name = $each_owner->[3];
2446                 my $name = $first_name." ".$last_name;
2447                 my $each_owner_link = qq{<a href="/solpeople/personal-info.pl?sp_person_id=$owner_id">$name</a>};
2448                 push @owners, $each_owner_link,
2449             }
2450             $owner_link = join(",",@owners);
2451             print STDERR "OWNER LINK =".Dumper($owner_link)."\n";
2452
2453         }
2454         push @accessions_missing_pedigree, [ qq{<a href="/stock/$accession_id/view">$accession_name</a>}, $owner_link, $accession_name],
2455     }
2456
2457     $c->stash->{rest} = {data => \@accessions_missing_pedigree};
2458 }
2459
2460
2461 sub stock_additional_file_upload :Chained('/stock/get_stock') PathPart('upload_additional_file') Args(0) {
2462
2463     my $self = shift;
2464     my $c = shift;
2465     my $stock_id = $c->stash->{stock_row}->stock_id();
2466
2467     my $user_id;
2468     my $user_name;
2469     my $user_role;
2470     my $session_id = $c->req->param("sgn_session_id");
2471     my $schema = $c->dbic_schema("Bio::Chado::Schema");
2472
2473     if ($session_id){
2474         my $dbh = $c->dbc->dbh;
2475         my @user_info = CXGN::Login->new($dbh)->query_from_cookie($session_id);
2476         if (!$user_info[0]){
2477             $c->stash->{rest} = {error=>'You must be logged in to upload additional trials to a file!'};
2478             $c->detach();
2479         }
2480         $user_id = $user_info[0];
2481         $user_role = $user_info[1];
2482         my $p = CXGN::People::Person->new($dbh, $user_id);
2483         $user_name = $p->get_username;
2484     } else{
2485         if (!$c->user){
2486             $c->stash->{rest} = {error=>'You must be logged in to upload additional files to a trial!'};
2487             $c->detach();
2488         }
2489         $user_id = $c->user()->get_object()->get_sp_person_id();
2490         $user_name = $c->user()->get_object()->get_username();
2491         $user_role = $c->user->get_object->get_user_type();
2492     }
2493
2494     my $upload = $c->req->upload('accession_upload_additional_file');
2495     my $subdirectory = "accession_additional_file_upload";
2496     my $upload_original_name = $upload->filename();
2497     my $upload_tempfile = $upload->tempname;
2498     my $time = DateTime->now();
2499     my $timestamp = $time->ymd()."_".$time->hms();
2500
2501     ## Store uploaded temporary file in archive
2502     my $uploader = CXGN::UploadFile->new({
2503         tempfile => $upload_tempfile,
2504         subdirectory => $subdirectory,
2505         archive_path => $c->config->{archive_path},
2506         archive_filename => $upload_original_name,
2507         timestamp => $timestamp,
2508         user_id => $user_id,
2509         user_role => $user_role
2510     });
2511     my $archived_filename_with_path = $uploader->archive();
2512     my $md5 = $uploader->get_md5($archived_filename_with_path);
2513     if (!$archived_filename_with_path) {
2514         $c->stash->{rest} = {error => "Could not save file $upload_original_name in archive",};
2515         $c->detach();
2516     }
2517     unlink $upload_tempfile;
2518     my $md5checksum = $md5->hexdigest();
2519
2520     my $stock = CXGN::Stock->new({schema=>$schema,stock_id=>$stock_id});
2521     my $result = $stock->associate_uploaded_file($user_id, $archived_filename_with_path, $md5checksum, $stock_id );
2522     if ($result->{error}){
2523         $c->stash->{rest} = {error=>$result->{error}};
2524         $c->detach();
2525     }
2526
2527     $c->stash->{rest} = { success => 1, file_id => $result->{file_id} };
2528 }
2529
2530 sub get_accession_additional_file_uploaded :Chained('/stock/get_stock') PathPart('get_uploaded_additional_file') Args(0) {
2531     my $self = shift;
2532     my $c = shift;
2533
2534     if (!$c->user){
2535         $c->stash->{rest} = {error=>'You must be logged in to see uploaded additional files!'};
2536         $c->detach();
2537     }
2538
2539     my $stock_id = $c->stash->{stock_row}->stock_id();
2540     my @file_array;
2541     my %file_info;
2542
2543     my $q = "SELECT file_id, m.create_date, p.sp_person_id, p.username, basename, dirname, filetype
2544     FROM phenome.stock_file
2545     JOIN metadata.md_files using(file_id)
2546     LEFT JOIN metadata.md_metadata as m using(metadata_id)
2547     LEFT JOIN sgn_people.sp_person as p ON (p.sp_person_id=m.create_person_id)
2548     WHERE stock_id=? and m.obsolete = 0 and metadata.md_files.filetype='accession_additional_file_upload' ORDER BY file_id ASC";
2549
2550     my $h = $c->dbc->dbh()->prepare($q);
2551     $h->execute($stock_id);
2552
2553     while (my ($file_id, $create_date, $person_id, $username, $basename, $dirname, $filetype) = $h->fetchrow_array()) {
2554         $file_info{$file_id} = [$file_id, $create_date, $person_id, $username, $basename, $dirname, $filetype];
2555     }
2556     foreach (keys %file_info){
2557         push @file_array, $file_info{$_};
2558     }
2559     print STDERR "files: " . Dumper \@file_array;
2560
2561     $c->stash->{rest} = {success=>1, files=>\@file_array};
2562     return;
2563 }
2564
2565 sub obsolete_trial_additional_file_uploaded :Chained('/stock/get_stock') PathPart('obsolete_uploaded_additional_file') Args(1) {
2566     my $self = shift;
2567     my $c = shift;
2568     my $file_id = shift;
2569     my $stock_id = $c->stash->{stock_row}->stock_id();
2570
2571     if (!$c->user) {
2572             $c->stash->{rest} = { error => "You must be logged in to obsolete additional files!" };
2573             $c->detach();
2574     }
2575
2576     my $user_id = $c->user->get_object()->get_sp_person_id();
2577
2578     my @roles = $c->user->roles();
2579     my $result = $c->stash->{trial}->obsolete_uploaded_file($file_id, $stock_id, $user_id, $roles[0]);
2580
2581     if (exists($result->{errors})) {
2582             $c->stash->{rest} = { error => $result->{errors} };
2583     }
2584     else {
2585             $c->stash->{rest} = { success => 1 };
2586     }
2587
2588 }
2589
2590 =head2 accession_or_seedlot_or_population_or_vector_construct_autocomplete
2591
2592  Usage:
2593  Desc:
2594  Ret:
2595  Args:
2596  Side Effects:
2597  Example:
2598
2599 =cut
2600
2601 sub accession_or_seedlot_or_population_or_vector_construct_autocomplete : Local : ActionClass('REST') { }
2602
2603 sub accession_or_seedlot_or_population_or_vector_construct_autocomplete_GET :Args(0) {
2604     my ($self, $c) = @_;
2605
2606     my $term = $c->req->param('term');
2607
2608     $term =~ s/(^\s+|\s+)$//g;
2609     $term =~ s/\s+/ /g;
2610
2611     my @response_list;
2612     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='seedlot' or cvterm.name='population' or cvterm.name='vector_construct') ORDER BY stock.uniquename LIMIT 20";
2613     my $sth = $c->dbc->dbh->prepare($q);
2614     $sth->execute('%'.$term.'%');
2615     while (my ($stock_name) = $sth->fetchrow_array) {
2616         push @response_list, $stock_name;
2617     }
2618
2619     #print STDERR Dumper @response_list;
2620
2621     $c->stash->{rest} = \@response_list;
2622 }
2623
2624
2625 sub get_vector_related_stocks:Chained('/stock/get_stock') PathPart('datatables/vector_related_stocks') Args(0){
2626     my $self = shift;
2627     my $c = shift;
2628     my $stock_id = $c->stash->{stock_row}->stock_id();
2629
2630     my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
2631     my $schema = $c->dbic_schema("Bio::Chado::Schema", 'sgn_chado', $sp_person_id);
2632     my $progenies = CXGN::Stock::RelatedStocks->new({dbic_schema => $schema, stock_id =>$stock_id});
2633     my $result = $progenies->get_vector_related_stocks();
2634     my @related_stocks;
2635
2636     foreach my $r (@$result){
2637         my ($transformant_id, $transformant_name, $vector_id, $vector_name, $plant_id, $plant_name, $transformation_id, $transformation_name) = @$r;
2638         push @related_stocks, [qq{<a href="/stock/$transformant_id/view">$transformant_name</a>}, $vector_name, qq{<a href="/stock/$plant_id/view">$plant_name</a>}, qq{<a href="/transformation/$transformation_id">$transformation_name</a>}, $transformant_name];
2639     }
2640
2641     $c->stash->{rest}={data=>\@related_stocks};
2642 }
2643
2644
2645 1;