lib/SGN/Controller/Stock.pm

   1 package SGN::Controller::Stock;
   2
   3 =head1 NAME
   4
   5 SGN::Controller::Stock - Catalyst controller for pages dealing with
   6 stocks (e.g. accession, population, etc.)
   7
   8 =cut
   9
  10 use Moose;
  11 use namespace::autoclean;
  12 use YAML::Any qw/LoadFile/;
  13
  14 use URI::FromHash 'uri';
  15 use List::Compare;
  16 use File::Temp qw / tempfile /;
  17 use File::Slurp;
  18 use JSON::Any;
  19 use JSON;
  20
  21 use CXGN::Chado::Stock;
  22 use SGN::View::Stock qw/stock_link stock_organisms stock_types breeding_programs /;
  23 use Bio::Chado::NaturalDiversity::Reports;
  24 use SGN::Model::Cvterm;
  25 use Data::Dumper;
  26 use CXGN::Chado::Publication;
  27 use CXGN::Genotype::DownloadFactory;
  28
  29 BEGIN { extends 'Catalyst::Controller' }
  30 with 'Catalyst::Component::ApplicationAttribute';
  31
  32 has 'schema' => (
  33     is       => 'rw',
  34     isa      => 'DBIx::Class::Schema',
  35     lazy_build => 1,
  36 );
  37 sub _build_schema {
  38     shift->_app->dbic_schema( 'Bio::Chado::Schema', 'sgn_chado' )
  39 }
  40
  41 has 'default_page_size' => (
  42     is      => 'ro',
  43     default => 20,
  44 );
  45
  46 =head1 PUBLIC ACTIONS
  47
  48
  49 =head2 stock search using jQuery data tables
  50
  51 =cut
  52
  53 sub stock_search :Path('/search/stocks') Args(0) {
  54     my ($self, $c ) = @_;
  55     my @editable_stock_props = split ',',$c->get_conf('editable_stock_props');
  56     $c->stash(
  57         template => '/search/stocks.mas',
  58
  59         stock_types => stock_types($self->schema),
  60         organisms   => stock_organisms($self->schema) ,
  61         sp_person_autocomplete_uri => '/ajax/people/autocomplete',
  62         trait_autocomplete_uri     => '/ajax/stock/trait_autocomplete',
  63         onto_autocomplete_uri      => '/ajax/cvterm/autocomplete',
  64         trait_db_name              => $c->get_conf('trait_ontology_db_name'),
  65         breeding_programs          => breeding_programs($self->schema),
  66     editable_stock_props => \@editable_stock_props
  67         );
  68
  69 }
  70
  71
  72 =head2 search DEPRECATED
  73
  74 Public path: /stock/search
  75
  76 Display a stock search form, or handle stock searching.
  77
  78 =cut
  79
  80 sub search :Path('/stock/search') Args(0) {
  81     my ( $self, $c ) = @_;
  82     $c->stash(
  83         template => '/search/stocks.mas',
  84
  85         stock_types => stock_types($self->schema),
  86         organisms   => stock_organisms($self->schema) ,
  87         sp_person_autocomplete_uri => $c->uri_for( '/ajax/people/autocomplete' ),
  88         trait_autocomplete_uri     => $c->uri_for('/ajax/stock/trait_autocomplete'),
  89         onto_autocomplete_uri      => $c->uri_for('/ajax/cvterm/autocomplete'),
  90         trait_db_name              => $c->get_conf('trait_ontology_db_name'),
  91         breeding_programs          => breeding_programs($self->schema),
  92         );
  93     #my $results = $c->req->param('search_submitted') ? $self->_make_stock_search_rs($c) : undef;
  94     #my $form = HTML::FormFu->new(LoadFile($c->path_to(qw{forms stock stock_search.yaml})));
  95     #my $trait_db_name = $c->get_conf('trait_ontology_db_name');
  96     #$c->stash(
  97     #    template                   => '/search/phenotypes/stock.mas',
  98     #    request                    => $c->req,
  99     #    form                       => $form,
 100     #    form_opts                  => { stock_types => stock_types($self->schema), organisms => stock_organisms($self->schema)} ,
 101     #    results                    => $results,
 102     #    sp_person_autocomplete_uri => $c->uri_for( '/ajax/people/autocomplete' ),
 103     #    trait_autocomplete_uri     => $c->uri_for('/ajax/stock/trait_autocomplete'),
 104     #    onto_autocomplete_uri      => $c->uri_for('/ajax/cvterm/autocomplete'),
 105         #trait_db_name              => $trait_db_name,
 106         #pagination_link_maker      => sub {
 107         #    return uri( query => { %{$c->req->params} , page => shift } );
 108         #},
 109         #);
 110 }
 111
 112 =head2 new_stock
 113
 114 Public path: /stock/0/new
 115
 116 Create a new stock.
 117
 118 Chained off of L</get_stock> below.
 119
 120 =cut
 121
 122 sub new_stock : Chained('get_stock') PathPart('new') Args(0) {
 123     my ( $self, $c ) = @_;
 124     $c->stash(
 125         template => '/stock/new_stock.mas',
 126
 127         stockref => {
 128             action    => "new",
 129             stock_id  => 0 ,
 130             stock     => $c->stash->{stock},
 131             schema    => $self->schema,
 132         },
 133         );
 134 }
 135
 136 =head2 view_stock
 137
 138 Public path: /stock/<stock_id>/view
 139
 140 View a stock's detail page.
 141
 142 Chained off of L</get_stock> below.
 143
 144 =cut
 145
 146 our $time;
 147
 148 sub view_stock : Chained('get_stock') PathPart('view') Args(0) {
 149     my ( $self, $c, $action) = @_;
 150
 151      if (!$c->user()) {
 152
 153         my $url = '/' . $c->req->path;
 154         $c->res->redirect("/user/login?goto_url=$url");
 155
 156     } else {
 157         $time = time();
 158
 159         if( $c->stash->{stock_row} ) {
 160             $c->forward('get_stock_extended_info');
 161         }
 162
 163         my $logged_user = $c->user;
 164         my $person_id = $logged_user->get_object->get_sp_person_id if $logged_user;
 165         my $user_role = 1 if $logged_user;
 166         my $curator   = $logged_user->check_roles('curator') if $logged_user;
 167         my $submitter = $logged_user->check_roles('submitter') if $logged_user;
 168         my $sequencer = $logged_user->check_roles('sequencer') if $logged_user;
 169
 170         my $dbh = $c->dbc->dbh;
 171
 172         ##################
 173
 174         ###Check if a stock page can be printed###
 175
 176         my $stock = $c->stash->{stock};
 177         my $stock_id = $stock ? $stock->get_stock_id : undef ;
 178
 179     if (!$stock_id) {
 180         $c->stash->{message} = "The requested stock does not exist or has been deleted.";
 181         $c->stash->{template} = 'generic_message.mas';
 182         return;
 183     }
 184
 185         my $stock_type = $stock->get_object_row ? $stock->get_object_row->type->name : undef ;
 186         my $type = 1 if $stock_type && !$stock_type=~ m/population/;
 187         # print message if stock_id is not valid
 188         unless ( ( $stock_id =~ m /^\d+$/ ) || ($action eq 'new' && !$stock_id) ) {
 189             $c->throw_404( "No stock/accession exists for that identifier." );
 190         }
 191         unless ( $stock->get_object_row || !$stock_id && $action && $action eq 'new' ) {
 192             $c->throw_404( "No stock/accession exists for that identifier." );
 193         }
 194
 195         print STDERR "Checkpoint 2: Elapsed ".(time() - $time)."\n";
 196
 197         my $props = $self->_stockprops($stock);
 198         # print message if the stock is visible only to certain user roles
 199         my @logged_user_roles = $logged_user->roles if $logged_user;
 200         my @prop_roles = @{ $props->{visible_to_role} } if  ref($props->{visible_to_role} );
 201         my $lc = List::Compare->new( {
 202             lists    => [\@logged_user_roles, \@prop_roles],
 203             unsorted => 1,
 204                                      } );
 205         my @intersection = $lc->get_intersection;
 206         if ( !$curator && @prop_roles  && !@intersection) { # if there is no match between user roles and stock visible_to_role props
 207             # $c->throw(is_client_error => 0,
 208             #           title             => 'Restricted page',
 209             #           message           => "Stock $stock_id is not visible to your user!",
 210             #           developer_message => 'only logged in users of certain roles can see this stock' . join(',' , @prop_roles),
 211             #           notify            => 0,   #< does not send an error email
 212             #     );
 213
 214             $c->stash->{template} = "generic_message.mas";
 215             $c->stash->{message}  = "You do not have sufficient privileges to view the page of stock with database id $stock_id. You may need to log in to view this page.";
 216             return;
 217         }
 218
 219         print STDERR "Checkpoint 3: Elapsed ".(time() - $time)."\n";
 220
 221         # print message if the stock is obsolete
 222         my $obsolete = $stock->get_is_obsolete();
 223         if ( $obsolete  && !$curator ) {
 224             #$c->throw(is_client_error => 0,
 225             #          title             => 'Obsolete stock',
 226             #          message           => "Stock $stock_id is obsolete!",
 227             #          developer_message => 'only curators can see obsolete stock',
 228             #          notify            => 0,   #< does not send an error email
 229             #    );
 230
 231             $c->stash->{template} = "generic_message.mas";
 232             $c->stash->{message}  = "The stock with database id $stock_id has been deleted. It can no longer be viewed.";
 233             return;
 234         }
 235         # print message if stock_id does not exist
 236         if ( !$stock && $action ne 'new' && $action ne 'store' ) {
 237             $c->throw_404('No stock exists for this identifier');
 238         }
 239
 240         ####################
 241         my $is_owner;
 242         my $owner_ids = $c->stash->{owner_ids} || [] ;
 243         my $editor_info = $self->_stock_editor_info($stock);
 244         if ( $stock && ($curator || $person_id && ( grep /^$person_id$/, @$owner_ids ) ) ) {
 245             $is_owner = 1;
 246         }
 247         my $dbxrefs = $self->_dbxrefs($stock);
 248         my $pubs = $self->_stock_pubs($stock);
 249         my $image_ids = $self->_stock_images($stock, $type);
 250         my $related_image_ids = $self->_related_stock_images($stock, $type);
 251         my $cview_tmp_dir = $c->tempfiles_subdir('cview');
 252
 253         my $barcode_tempuri  = $c->tempfiles_subdir('image');
 254         my $barcode_tempdir = $c->get_conf('basepath')."/$barcode_tempuri";
 255
 256         my $editable_stockprops = $c->get_conf('editable_stock_props');
 257         $editable_stockprops .= ",PUI,organization";
 258     my $editable_vectorprops = $c->get_conf('editable_vector_props');
 259
 260         print STDERR "Checkpoint 4: Elapsed ".(time() - $time)."\n";
 261         ################
 262         $c->stash(
 263             template => '/stock/index.mas',
 264
 265             stockref => {
 266                 action    => $action,
 267                 stock_id  => $stock_id ,
 268                 user      => $user_role,
 269                 curator   => $curator,
 270                 submitter => $submitter,
 271                 sequencer => $sequencer,
 272                 person_id => $person_id,
 273                 stock     => $stock,
 274                 schema    => $self->schema,
 275                 dbh       => $dbh,
 276                 is_owner  => $is_owner,
 277                 owners    => $owner_ids,
 278                 editor_info => $editor_info,
 279                 props     => $props,
 280                 dbxrefs   => $dbxrefs,
 281                 pubs      => $pubs,
 282                 members_phenotypes => $c->stash->{members_phenotypes},
 283                 direct_phenotypes  => $c->stash->{direct_phenotypes},
 284                 has_qtl_data   => $c->stash->{has_qtl_data},
 285                 cview_tmp_dir  => $cview_tmp_dir,
 286                 cview_basepath => $c->get_conf('basepath'),
 287                 image_ids      => $image_ids,
 288                 related_image_ids => $related_image_ids,
 289                 allele_count   => $c->stash->{allele_count},
 290                 ontology_count => $c->stash->{ontology_count},
 291                 has_pedigree => $c->stash->{has_pedigree},
 292                 has_descendants => $c->stash->{has_descendants},
 293                 trait_ontology_db_name => $c->get_conf('trait_ontology_db_name'),
 294                 editable_stock_props   => $editable_stockprops,
 295                 editable_vector_props   => $editable_vectorprops,
 296             },
 297             locus_add_uri  => $c->uri_for( '/ajax/stock/associate_locus' ),
 298             cvterm_add_uri => $c->uri_for( '/ajax/stock/associate_ontology'),
 299             barcode_tempdir  => $barcode_tempdir,
 300             barcode_tempuri   => $barcode_tempuri,
 301             identifier_prefix => $c->config->{identifier_prefix},
 302             );
 303     }
 304 }
 305
 306
 307 =head2 view_by_organism_name
 308
 309 Public Path: /stock/view_by_organism/$organism/$name
 310 Path Params:
 311     organism = organism name (abbreviation, genus, species, common name)
 312     name = stock unique name
 313
 314 Search for stock(s) matching the organism query and the stock unique name.
 315 If 1 match is found, display the stock detail page.  Display an error for
 316 0 matches and a list of matches when multiple stocks are found.
 317
 318 =cut
 319
 320 sub view_by_organism_name : Path('/stock/view_by_organism') Args(2) {
 321     my ($self, $c, $organism_query, $stock_query) = @_;
 322     $self->search_stock($c, $organism_query, $stock_query);
 323 }
 324
 325
 326 =head2 view_by_name
 327
 328 Public Path: /stock/view_by_name/$name
 329 Path Params:
 330     name = stock unique name
 331
 332 Search for stock(s) matching the stock unique name.
 333 If 1 match is found, display the stock detail page.  Display an error for
 334 0 matches and a list of matches when multiple stocks are found.
 335
 336 =cut
 337
 338 sub view_by_name : Path('/stock/view_by_name') Args(1) {
 339     my ($self, $c, $stock_query) = @_;
 340     $self->search_stock($c, undef, $stock_query);
 341 }
 342
 343
 344 =head1 PRIVATE ACTIONS
 345
 346 =head2 download_phenotypes
 347
 348 =cut
 349
 350
 351 sub download_phenotypes : Chained('get_stock') PathPart('phenotypes') Args(0) {
 352     my ($self, $c) = @_;
 353     my $stock = $c->stash->{stock_row};
 354     my $stock_id = $stock->stock_id;
 355     if ($stock_id) {
 356         #my $tmp_dir = $c->get_conf('basepath') . "/" . $c->get_conf('stock_tempfiles');
 357         #my $file_cache = Cache::File->new( cache_root => $tmp_dir  );
 358         #$file_cache->purge();
 359         #my $key = "stock_" . $stock_id . "_phenotype_data";
 360         #my $phen_file = $file_cache->get($key);
 361         #my $filename = $tmp_dir . "/stock_" . $stock_id . "_phenotypes.csv";
 362
 363         my $results = [];# listref for recursive subject stock_phenotypes resultsets
 364         #recursively get the stock_id and the ids of its subjects from stock_relationship
 365         my $stock_rs = $self->schema->resultset("Stock::Stock")->search( { stock_id => $stock_id } );
 366         $results =  $self->schema->resultset("Stock::Stock")->recursive_phenotypes_rs($stock_rs, $results);
 367         my $report = Bio::Chado::NaturalDiversity::Reports->new;
 368         my $d = $report->phenotypes_by_trait($results);
 369
 370         my @info  = split(/\n/ , $d);
 371         my @data;
 372         foreach (@info) {
 373             push @data, [ split(/\t/) ] ;
 374         }
 375         $c->stash->{'csv'}={ data => \@data};
 376         $c->forward("View::Download::CSV");
 377         #stock    repeat        experiment      year    SP:0001 SP:0002
 378     }
 379 }
 380
 381
 382 =head2 download_genotypes
 383
 384 =cut
 385
 386
 387 sub download_genotypes : Chained('get_stock') PathPart('genotypes') Args(0) {
 388     my ($self, $c) = @_;
 389
 390     if (! $c->user()) {
 391         $c->res->redirect( uri( path => '/user/login', query => { goto_url => $c->req->uri->path_query } ) );
 392         return;
 393     }
 394
 395
 396     my $stock_row = $c->stash->{stock_row};
 397     my $stock_id = $stock_row->stock_id;
 398     my $stock_name = $stock_row->uniquename;
 399     my $genotype_id = $c->req->param('genotype_id') ? [$c->req->param('genotype_id')] : undef;
 400     my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
 401
 402     if (!$genotype_id) {
 403
 404         my $referer = $c->req->referer;
 405         my $message = "<p>Genotype data download for the stock is missing an associated genotype id. <br/>"
 406             .  "<a href=\"$referer\">[ Go back ]</a></p>";
 407
 408         $c->stash->{message} = $message;
 409         $c->stash->{template} = "/generic_message.mas";
 410
 411     } else {
 412         my $schema = $c->dbic_schema("Bio::Chado::Schema", "sgn_chado", $sp_person_id);
 413         my $people_schema = $c->dbic_schema("CXGN::People::Schema", undef, $sp_person_id);
 414
 415         my $dl_token = $c->req->param("gbs_download_token") || "no_token";
 416         my $dl_cookie = "download".$dl_token;
 417
 418         my $stock = CXGN::Stock->new({schema => $schema, stock_id => $stock_id});
 419         my $stock_type = $stock->type();
 420
 421         if ($stock_id) {
 422             my %genotype_download_factory = (
 423                 bcs_schema=>$schema,
 424                 people_schema=>$people_schema,
 425                 cache_root_dir=>$c->config->{cache_file_path},
 426                 markerprofile_id_list=>$genotype_id,
 427                 #genotype_data_project_list=>$genotype_data_project_list,
 428                 #marker_name_list=>['S80_265728', 'S80_265723'],
 429                 #limit=>$limit,
 430                 #offset=>$offset
 431                 );
 432
 433             if ($stock_type eq 'accession') {
 434                 $genotype_download_factory{accession_list} = [$stock_id];
 435             }
 436             elsif ($stock_type eq 'tissue_sample') {
 437                 $genotype_download_factory{tissue_sample_list} = [$stock_id];
 438             }
 439
 440             my $geno = CXGN::Genotype::DownloadFactory->instantiate(
 441                 'VCF',    #can be either 'VCF' or 'GenotypeMatrix'
 442                 \%genotype_download_factory
 443                 );
 444             my $file_handle = $geno->download(
 445                 $c->config->{cluster_shared_tempdir},
 446                 $c->config->{backend},
 447                 $c->config->{cluster_host},
 448                 $c->config->{'web_cluster_queue'},
 449                 $c->config->{basepath}
 450                 );
 451
 452             $c->res->content_type("application/text");
 453             $c->res->cookies->{$dl_cookie} = {
 454                 value => $dl_token,
 455                 expires => '+1m',
 456             };
 457             $c->res->header('Content-Disposition', qq[attachment; filename="BreedBaseGenotypesDownload.vcf"]);
 458             $c->res->body($file_handle);
 459         }
 460     }
 461
 462 }
 463
 464 sub chr_sort {
 465     no warnings 'uninitialized';
 466     my @a = split "\t", $a;
 467     my @b = split "\t", $b;
 468
 469     my $a_chr;
 470     my $a_coord;
 471     my $b_chr;
 472     my $b_coord;
 473
 474     if ($a[1] =~ /^[A-Za-z]+(\d+)[_-](\d+)$/) {
 475         $a_chr = $1;
 476         $a_coord = $2;
 477     }
 478
 479     if ($b[1] =~ /[A-Za-z]+(\d+)[_-](\d+)/) {
 480         $b_chr = $1;
 481         $b_coord = $2;
 482     }
 483
 484     if ($a_chr eq $b_chr) {
 485         return $a_coord <=> $b_coord;
 486     }
 487     else {
 488         return $a_chr <=> $b_chr;
 489     }
 490 }
 491
 492 =head2 get_stock
 493
 494 Chain root for fetching a stock object to operate on.
 495
 496 Path part: /stock/<stock_id>
 497
 498 =cut
 499
 500 sub get_stock : Chained('/')  PathPart('stock')  CaptureArgs(1) {
 501     my ($self, $c, $stock_id) = @_;
 502
 503     $c->stash->{stock}     = CXGN::Chado::Stock->new($self->schema, $stock_id);
 504     $c->stash->{stock_row} = $self->schema->resultset('Stock::Stock')
 505                                   ->find({ stock_id => $stock_id });
 506 }
 507
 508 # Search for stock by organism name (optional) and uniquename
 509 # Display stock detail page for 1 match, error messages for 0 or multiple matches
 510 sub search_stock : Private {
 511     my ( $self, $c, $organism_query, $stock_query ) = @_;
 512     my $rs = $self->schema->resultset('Stock::Stock');
 513
 514     my $matches;
 515     my $count = 0;
 516
 517     # Search by name and organism
 518     if ( defined($organism_query) && defined($stock_query) ) {
 519         $matches = $rs->search({
 520                 'UPPER(uniquename)' => uc($stock_query),
 521                 -or => [
 522                     'UPPER(organism.abbreviation)' => uc($organism_query),
 523                     'UPPER(organism.genus)' => uc($organism_query),
 524                     'UPPER(organism.species)' => uc($organism_query),
 525                     'UPPER(organism.common_name)' => {'like', '%' . uc($organism_query) .'%'}
 526                 ],
 527                 is_obsolete => 'false'
 528             },
 529             {join => 'organism'}
 530         );
 531         $count = $matches->count;
 532     }
 533
 534     # Search by name
 535     elsif ( defined($stock_query) ) {
 536         $matches = $rs->search({
 537                 'UPPER(uniquename)' => uc($stock_query),
 538                 is_obsolete => 'false'
 539             },
 540             {join => 'organism'}
 541         );
 542         $count = $matches->count;
 543     }
 544
 545
 546     # NO MATCH FOUND
 547     if ( $count == 0 ) {
 548         $c->stash->{template} = "generic_message.mas";
 549         $c->stash->{message} = "<strong>No Matching Stock Found</strong> ($stock_query $organism_query)<br />You can view and search for stocks from the <a href='/search/stocks'>Stock Search Page</a>";
 550     }
 551
 552     # MULTIPLE MATCHES FOUND
 553     elsif ( $count > 1 ) {
 554         my $list = "<ul>";
 555         while (my $stock = $matches->next) {
 556             my $stock_id = $stock->stock_id;
 557             my $stock_name = $stock->uniquename;
 558             my $species_name = $stock->organism->species;
 559             my $url = "/stock/$stock_id/view";
 560             $list.="<li><a href='$url'>$stock_name ($species_name)</li>";
 561         }
 562         $list.="</ul>";
 563         $c->stash->{template} = "generic_message.mas";
 564         $c->stash->{message} = "<strong>Multiple Stocks Found</strong><br />" . $list;
 565     }
 566
 567     # 1 MATCH FOUND - FORWARD TO VIEW STOCK
 568     else {
 569         my $stock_id = $matches->first->stock_id;
 570         $c->stash->{stock}     = CXGN::Chado::Stock->new($self->schema, $stock_id);
 571         $c->stash->{stock_row} = $self->schema->resultset('Stock::Stock')
 572                                   ->find({ stock_id => $stock_id });
 573         $c->forward('view_stock');
 574     }
 575 }
 576
 577 #add the stockcvterms to the stash. Props are a hashref of lists.
 578 sub get_stock_cvterms : Private {
 579     my ( $self, $c ) = @_;
 580     my $stock = $c->stash->{stock};
 581     my $stock_cvterms = $stock ? $self->_stock_cvterms($stock, $c) : undef;
 582     $c->stash->{stock_cvterms} = $stock_cvterms;
 583 }
 584
 585 sub get_stock_allele_ids : Private {
 586     my ( $self, $c ) = @_;
 587     my $stock = $c->stash->{stock};
 588     my $allele_ids = $stock ? $self->_stock_allele_ids($stock) : undef;
 589     $c->stash->{allele_ids} = $allele_ids;
 590     my $count = $allele_ids ? scalar( @$allele_ids ) : undef;
 591     $c->stash->{allele_count} = $count ;
 592 }
 593
 594 sub get_stock_owner_ids : Private {
 595     my ( $self, $c ) = @_;
 596     my $stock = $c->stash->{stock};
 597     my $owner_ids = $stock ? $self->_stock_owner_ids($stock) : undef;
 598     $c->stash->{owner_ids} = $owner_ids;
 599 }
 600
 601 sub get_stock_has_pedigree : Private {
 602     my ( $self, $c ) = @_;
 603     my $stock = $c->stash->{stock};
 604     my $has_pedigree = $stock ? $self->_stock_has_pedigree($stock) : undef;
 605     $c->stash->{has_pedigree} = $has_pedigree;
 606 }
 607
 608 sub get_stock_has_descendants : Private {
 609     my ( $self, $c ) = @_;
 610     my $stock = $c->stash->{stock};
 611     my $has_descendants = $stock ? $self->_stock_has_descendants($stock) : undef;
 612     $c->stash->{has_descendants} = $has_descendants;
 613 }
 614
 615 sub get_stock_extended_info : Private {
 616     my ( $self, $c ) = @_;
 617     $c->forward('get_stock_cvterms');
 618
 619     $c->forward('get_stock_allele_ids');
 620     $c->forward('get_stock_owner_ids');
 621     $c->forward('get_stock_has_pedigree');
 622     $c->forward('get_stock_has_descendants');
 623
 624     # look up the stock again, this time prefetching a lot of data about its related stocks
 625     $c->stash->{stock_row} = $self->schema->resultset('Stock::Stock')
 626                                   ->find({ stock_id => $c->stash->{stock_row}->stock_id },
 627                                          { prefetch => {
 628                                              'stock_relationship_objects' => [ { 'subject' => 'type' }, 'type'],
 629                                            },
 630                                          },
 631                                         );
 632
 633     my $stock = $c->stash->{stock};
 634
 635     #add the stock_dbxrefs to the stash. Dbxrefs are hashref of lists.
 636     # keys are db-names , values are lists of Bio::Chado::Schema::General::Dbxref objects
 637     my $dbxrefs  = $stock ?  $self->_stock_dbxrefs($stock) : undef ;
 638     $c->stash->{stock_dbxrefs} = $dbxrefs;
 639
 640     my $cvterms  = $stock ?  $self->_stock_cvterms($stock, $c) : undef ;
 641     $c->stash->{stock_cvterms} = $cvterms;
 642     my $stock_rs = ( $c->stash->{stock_row})->search_related('stock_relationship_subjects')
 643         ->search_related('subject');
 644
 645     my $direct_phenotypes  = $stock ? $self->_stock_project_phenotypes($self->schema->resultset("Stock::Stock")->search_rs({ stock_id => $c->stash->{stock_row}->stock_id } ) ) : undef;
 646     $c->stash->{direct_phenotypes} = $direct_phenotypes;
 647
 648     my ($members_phenotypes, $has_members_genotypes)  = (undef, undef); #$stock ? $self->_stock_members_phenotypes( $c->stash->{stock_row} ) : undef;
 649     $c->stash->{members_phenotypes} = $members_phenotypes;
 650
 651     my $stock_type;
 652     $stock_type = $stock->get_object_row->type->name if $stock->get_object_row;
 653     if ( ( grep { /^$stock_type/ } ('f2 population', 'backcross population') ) &&  $members_phenotypes && $has_members_genotypes ) { $c->stash->{has_qtl_data} = 1 ; }
 654 }
 655
 656 ############## HELPER METHODS ######################3
 657
 658 # assembles a DBIC resultset for the search based on the submitted
 659 # form values
 660 sub _make_stock_search_rs {
 661     my ( $self, $c ) = @_;
 662
 663     my $rs = $self->schema->resultset('Stock::Stock');
 664
 665     if( my $name = $c->req->param('stock_name') ) {
 666         # trim and regularize whitespace
 667         $name =~ s/(^\s+|\s+)$//g;
 668         $name =~ s/\s+/ /g;
 669
 670         $rs = $rs->search({ 'me.is_obsolete' => 'false',
 671             -or => [
 672                  'lower(me.name)' => { like => '%'.lc( $name ).'%' } ,
 673                  'lower(me.uniquename)' => { like => '%'.lc( $name ).'%' },
 674                  -and => [
 675                      'lower(type.name)' => { like =>'%synonym%' },
 676                      'lower(stockprops.value)' => { like =>'%'.lc( $name ).'%' },
 677                  ],
 678                 ],
 679                           } ,
 680                {  join =>  { 'stockprops' =>  'type'  }  ,
 681                   columns => [ qw/stock_id uniquename type_id organism_id / ],
 682                   distinct => 1
 683                }
 684             );
 685     }
 686     if( my $type = $c->req->param('stock_type') ) {
 687         $self->_validate_pair($c,'type_id',$type);
 688         $rs = $rs->search({ 'me.type_id' => $type });
 689     }
 690     if( my $organism = $c->req->param('organism') ) {
 691         $self->_validate_pair( $c, 'organism_id', $organism );
 692         $rs = $rs->search({ 'organism_id' => $organism });
 693     }
 694     if ( my $description = $c->req->param('description') ) {
 695         $self->_validate_pair($c, 'description');
 696         $rs = $rs->search( {
 697             -or => [
 698                  'lower(me.description)' => { like => '%'.lc( $description ).'%' } ,
 699                  'lower(stockprops.value)' => { like =>'%'.lc( $description ).'%' },
 700                 ],
 701                            } ,
 702                 {  join =>  { 'stockprops' =>  'type'  }  ,
 703                    columns => [ qw/stock_id uniquename type_id organism_id / ],
 704                    distinct => 1
 705                 }
 706             );
 707     }
 708     if ( my $editor = $c->req->param('person') ) {
 709         $self->_validate_pair( $c, 'person') ;
 710         $editor =~ s/,/ /g;
 711         $editor =~ s/\s+/ /g;
 712
 713         my $person_ids = $c->dbc->dbh->selectcol_arrayref(<<'', undef, $editor);
 714 SELECT sp_person_id FROM sgn_people.sp_person
 715     WHERE ( first_name || ' ' || last_name ) like '%' || ? || '%'
 716
 717         if (@$person_ids) {
 718             my $bindstr = join ',', map '?', @$person_ids;
 719             my $stock_ids =  $c->dbc->dbh->selectcol_arrayref(
 720                 "SELECT stock_id FROM phenome.stock_owner
 721     WHERE sp_person_id IN ($bindstr)",
 722                 undef,
 723                 @$person_ids,
 724                 );
 725             $rs = $rs->search({ 'me.stock_id' => { '-in' => $stock_ids } } );
 726          } else {
 727              $rs = $rs->search({ name => '' });
 728          }
 729     }
 730     if ( my $trait = $c->req->param('trait') ) {
 731         $rs = $rs->search( { 'observable.name' => $trait },
 732                      { join => { nd_experiment_stocks => { nd_experiment => {'nd_experiment_phenotypes' => {'phenotype' => 'observable' }}}},
 733                        columns => [ qw/stock_id uniquename type_id organism_id / ],
 734                        distinct => 1
 735                      } );
 736     }
 737     if ( my $min = $c->req->param('min_limit') ) {
 738         if ( $min =~ /^\d+$/ ) {
 739             $rs = $rs->search( { 'cast(phenotype.value as numeric) ' => { '>=' => $min }  },
 740                                { join => { nd_experiment_stocks => { nd_experiment => {'nd_experiment_phenotypes' => 'phenotype' }}},
 741                                  columns => [ qw/stock_id uniquename type_id organism_id / ],
 742                                  distinct => 1
 743                                } );
 744         }
 745     }
 746     if ( my $max = $c->req->param('max_limit') ) {
 747         if ( $max =~ /^\d+$/ ) {
 748             $rs = $rs->search( { 'cast(phenotype.value as numeric) ' => { '<=' => $max }  },
 749                                { join => { nd_experiment_stocks => { nd_experiment => {'nd_experiment_phenotypes' => 'phenotype' }}},
 750                                  columns => [ qw/stock_id uniquename type_id organism_id / ],
 751                                  distinct => 1
 752                                } );
 753         }
 754     }
 755     # this is for direct annotations in stock_cvterm
 756     if ( my $ontology = $c->req->param('onto') ) {
 757         my ($cv_name, $full_accession, $cvterm_name) = split(/--/ , $ontology);
 758         my ($db_name, $accession) = split(/:/, $full_accession);
 759         my $cvterm;
 760         my (@cvterm_ids, @children_ids);
 761         if ($db_name && $accession) {
 762             ($cvterm) = $self->schema->resultset("General::Db")->
 763                 search( { 'me.name' => $db_name })->
 764                 search_related('dbxrefs', { accession => $accession } )->
 765                 search_related('cvterm');
 766             @cvterm_ids = ( $cvterm->cvterm_id );
 767             @children_ids = $cvterm->recursive_children->get_column('cvterm_id')->all;
 768         } else {
 769             my $cvterms = $self->schema->resultset("Cv::Cvterm")->
 770                 search( { lc('name') => { 'LIKE' => lc($ontology) } });
 771             while ( my $term =  $cvterms->next ) {
 772                 push @cvterm_ids ,   $term->cvterm_id ;
 773                 push @children_ids , $term->recursive_children->get_column('cvterm_id')->all;
 774             }
 775         }
 776         push ( @children_ids, @cvterm_ids ) ;
 777         $rs = $rs->search( {
 778             'stock_cvterms.cvterm_id' => { -in =>  \@children_ids },
 779             -or => [
 780                 'stock_cvtermprops.value' => { '!=' => '1' },
 781                 'stock_cvtermprops.value' => undef,
 782                 ],
 783                 -or => [
 784                 lc('type.name')       => { 'NOT LIKE' => lc('obsolete') },
 785                 'type.name'           =>  undef,
 786                 ],
 787                            },
 788                            { join => { stock_cvterms => { 'stock_cvtermprops' => 'type' } },
 789                              columns => [ qw/stock_id uniquename type_id organism_id / ],
 790                              distinct => 1
 791                            } );
 792     }
 793     ###search for stocks involved in nd_experiments (phenotyping and genotyping)
 794     if ( my $project = $c->req->param('project') ) {
 795         $rs = $rs->search(
 796             {
 797                 'lower(project.name)' => { -like  => lc($project) },
 798             },
 799             { join => { nd_experiment_stocks => { nd_experiment => { 'nd_experiment_projects' => 'project' } } },
 800               columns => [ qw/stock_id uniquename type_id organism_id / ],
 801               distinct => 1
 802             } );
 803     }
 804     if ( my $location = $c->req->param('location') ) {
 805         $rs = $rs->search(
 806             {
 807                 'lower(nd_geolocation.description)' => { -like  => lc($location) },
 808             },
 809             { join => { nd_experiment_stocks => { nd_experiment => 'nd_geolocation' } },
 810               columns => [ qw/stock_id uniquename type_id organism_id / ],
 811               distinct => 1
 812             } );
 813     }
 814     if ( my $year = $c->req->param('year') ) {
 815         $rs = $rs->search(
 816             {
 817                 'lower(projectprops.value)' => { -like  => lc($year) },
 818             },
 819             { join => { nd_experiment_stocks => { nd_experiment => { 'nd_experiment_projects' => { 'project' => 'projectprops' } } } },
 820               columns => [ qw/stock_id uniquename type_id organism_id / ],
 821               distinct => 1
 822             } );
 823     }
 824
 825     #########
 826     ##########
 827     if ( my $has_image = $c->req->param('has_image') ) {
 828     }
 829     if ( my $has_locus = $c->req->param('has_locus') ) {
 830     }
 831     # page number and page size, and order by name
 832     $rs = $rs->search( undef, {
 833         page => $c->req->param('page')  || 1,
 834         rows => $c->req->param('page_size') || $self->default_page_size,
 835         order_by => 'uniquename',
 836                        });
 837     return $rs;
 838 }
 839
 840
 841 sub _stockprops {
 842     my ($self,$stock) = @_;
 843
 844     my $bcs_stock = $stock->get_object_row();
 845     my $properties ;
 846     if ($bcs_stock) {
 847         my $stockprops = $bcs_stock->search_related("stockprops");
 848         while ( my $prop =  $stockprops->next ) {
 849             push @{ $properties->{$prop->type->name} } ,   $prop->value ;
 850         }
 851     }
 852     return $properties;
 853 }
 854
 855
 856 sub _dbxrefs {
 857     my ($self,$stock) = @_;
 858     my $bcs_stock = $stock->get_object_row;
 859     my $dbxrefs ;
 860     if ($bcs_stock) {
 861         my $stock_dbxrefs = $bcs_stock->search_related("stock_dbxrefs");
 862         while ( my $sdbxref =  $stock_dbxrefs->next ) {
 863             my $url = $sdbxref->dbxref->db->urlprefix . $sdbxref->dbxref->db->url;
 864             my $accession = $sdbxref->dbxref->accession;
 865             $url = $url ? qq |<a href = "$url/$accession">$accession</a>| : $accession ;
 866             push @{ $dbxrefs->{$sdbxref->dbxref->db->name} } , $sdbxref->dbxref;
 867         }
 868     }
 869     return $dbxrefs;
 870 }
 871
 872 # this sub gets all phenotypes measured directly on this stock and
 873 # stores it in a hashref as { project_name => [ BCS::Phenotype::Phenotype, ... ]
 874
 875 sub _stock_project_phenotypes {
 876     my ($self, $bcs_stock) = @_;
 877
 878     return {} unless $bcs_stock;
 879     my $rs =  $self->schema->resultset("Stock::Stock")->stock_phenotypes_rs($bcs_stock);
 880     my %project_hashref;
 881     while ( my $r = $rs->next) {
 882         my $project_desc = $r->get_column('project_description');
 883         push @{ $project_hashref{ $project_desc }}, $r;
 884     }
 885     return \%project_hashref;
 886 }
 887
 888 # this sub gets all phenotypes measured on all subjects of this stock.
 889 # Subjects are in stock_relationship
 890 sub _stock_members_phenotypes {
 891     my ($self, $bcs_stock) = @_;
 892     return unless $bcs_stock;
 893     my %phenotypes;
 894     my ($has_members_genotypes) = $bcs_stock->result_source->schema->storage->dbh->selectrow_array( <<'', undef, $bcs_stock->stock_id );
 895
 896     # now we have rs of stock_relationship objects. We need to find
 897     # the phenotypes of their related subjects
 898     my $subjects = $bcs_stock->search_related('stock_relationship_objects')
 899                              ->search_related('subject');
 900     my $subject_phenotypes = $self->_stock_project_phenotypes($subjects );
 901     return ( $subject_phenotypes, $has_members_genotypes );
 902 }
 903
 904 ###########
 905 # this sub gets all genotypes measured directly on this stock and
 906 # stores it in a hashref as { project_name => [ BCS::Genotype::Genotype, ... ]
 907
 908 sub _stock_project_genotypes {
 909     my ($self, $bcs_stock) = @_;
 910     return {} unless $bcs_stock;
 911
 912     # hash of experiment_id => project(s) desc
 913     my %project_descriptions =
 914         map { $_->nd_experiment_id => join( ', ', map $_->project->description, $_->nd_experiment_projects ) }
 915         $bcs_stock->search_related('nd_experiment_stocks')
 916                   ->search_related('nd_experiment',
 917                                    {},
 918                                    { prefetch => { 'nd_experiment_projects' => 'project' } },
 919                                    );
 920     my $experiments = $bcs_stock->search_related('nd_experiment_stocks')
 921                                 ->search_related('nd_experiment',
 922                                                  {},
 923                                                  { prefetch => { nd_experiment_genotypes => 'genotype' } },
 924                                                 );
 925     my %genotypes;
 926     my $project_desc;
 927
 928     while (my $exp = $experiments->next) {
 929         # there should be one project linked to the experiment ?
 930         my @gen = map $_->genotype, $exp->nd_experiment_genotypes;
 931         $project_desc = $project_descriptions{ $exp->nd_experiment_id };
 932         #or die "no project found for exp ".$exp->nd_experiment_id;
 933         push @{ $genotypes{ $project_desc }}, @gen if scalar(@gen);
 934     }
 935     return \%genotypes;
 936 }
 937
 938 ##############
 939
 940 sub _stock_dbxrefs {
 941     my ($self,$stock) = @_;
 942     my $bcs_stock = $stock->get_object_row;
 943     # hash of arrays. Keys are db names , values are lists of StockDbxref objects
 944     my $sdbxrefs ;
 945     if ($bcs_stock) {
 946         my $stock_dbxrefs = $bcs_stock->search_related("stock_dbxrefs");
 947         while ( my $sdbxref =  $stock_dbxrefs->next ) {
 948             push @{ $sdbxrefs->{$sdbxref->dbxref->db->name} } , $sdbxref;
 949         }
 950     }
 951     return $sdbxrefs;
 952 }
 953
 954 sub _stock_cvterms {
 955     my ($self,$stock, $c) = @_;
 956     my $bcs_stock = $stock->get_object_row;
 957     # hash of arrays. Keys are db names , values are lists of StockCvterm objects
 958     my $scvterms ;
 959     my $count;
 960     if ($bcs_stock) {
 961         my $stock_cvterms = $bcs_stock->search_related("stock_cvterms");
 962         while ( my $scvterm =  $stock_cvterms->next ) {
 963             $count++;
 964             push @{ $scvterms->{$scvterm->cvterm->dbxref->db->name} } , $scvterm;
 965         }
 966     }
 967     $c->stash->{ontology_count} = $count ;
 968     return $scvterms;
 969 }
 970
 971 # each stock may be linked with publications, each publication may have several dbxrefs
 972 sub _stock_pubs {
 973     my ($self, $stock) = @_;
 974     my $bcs_stock = $stock->get_object_row;
 975     my @pubs ;
 976     if ($bcs_stock) {
 977         my $stock_pubs = $bcs_stock->search_related("stock_pubs");
 978         while (my $spub = $stock_pubs->next ) {
 979             my $pub_id = $spub->pub_id;
 980             my $cxgn_pub = CXGN::Chado::Publication->new( $self->schema->storage->dbh(), $pub_id);
 981             push @pubs, $cxgn_pub;
 982         }
 983     }
 984     return \@pubs;
 985 }
 986
 987 sub _stock_images {
 988     my ($self, $stock) = @_;
 989     my @ids;
 990     my $q = "select distinct image_id, cvterm.name, stock_image.display_order FROM phenome.stock_image JOIN stock USING(stock_id) JOIN cvterm ON(type_id=cvterm_id) WHERE stock_id = ? ORDER BY stock_image.display_order ASC";
 991     my $h = $self->schema->storage->dbh()->prepare($q);
 992     $h->execute($stock->get_stock_id);
 993     while (my ($image_id, $stock_type) = $h->fetchrow_array()){
 994         push @ids, [$image_id, $stock_type];
 995     }
 996     return \@ids;
 997 }
 998
 999 sub _related_stock_images {
1000     my ($self, $stock) = @_;
1001     my @ids;
1002     my $q = "select distinct image_id, cvterm.name FROM phenome.stock_image JOIN stock USING(stock_id) JOIN cvterm ON(type_id=cvterm_id) WHERE stock_id IN (SELECT subject_id FROM stock_relationship WHERE object_id = ? ) OR stock_id IN (SELECT object_id FROM stock_relationship WHERE subject_id = ? )";
1003     my $h = $self->schema->storage->dbh()->prepare($q);
1004     $h->execute($stock->get_stock_id, $stock->get_stock_id);
1005     while (my ($image_id, $stock_type) = $h->fetchrow_array()){
1006         push @ids, [$image_id, $stock_type];
1007     }
1008     return \@ids;
1009 }
1010
1011 sub _stock_allele_ids {
1012     my ($self, $stock) = @_;
1013     my $ids = $stock->get_schema->storage->dbh->selectcol_arrayref
1014         ( "SELECT allele_id FROM phenome.stock_allele WHERE stock_id=? ",
1015           undef,
1016           $stock->get_stock_id
1017         );
1018     return $ids;
1019 }
1020
1021 sub _stock_owner_ids {
1022     my ($self,$stock) = @_;
1023     my $ids = $stock->get_schema->storage->dbh->selectcol_arrayref
1024         ("SELECT sp_person_id FROM phenome.stock_owner WHERE stock_id = ? ",
1025          undef,
1026          $stock->get_stock_id
1027         );
1028     return $ids;
1029 }
1030
1031 sub _stock_editor_info {
1032     my ($self,$stock) = @_;
1033     my @owner_info;
1034     my $q = "SELECT sp_person_id, md_metadata.create_date, md_metadata.modification_note FROM phenome.stock_owner JOIN metadata.md_metadata USING(metadata_id) WHERE stock_id = ? ";
1035     my $h = $stock->get_schema->storage->dbh()->prepare($q);
1036     $h->execute($stock->get_stock_id);
1037     while (my ($sp_person_id, $timestamp, $modification_note) = $h->fetchrow_array){
1038         push @owner_info, [$sp_person_id, $timestamp, $modification_note];
1039     }
1040     return \@owner_info;
1041 }
1042
1043 sub _stock_has_pedigree {
1044   my ($self, $stock) = @_;
1045   my $bcs_stock = $stock->get_object_row;
1046   my $cvterm_female_parent = SGN::Model::Cvterm->get_cvterm_row($self->schema, 'female_parent', 'stock_relationship');
1047
1048   my $cvterm_male_parent = SGN::Model::Cvterm->get_cvterm_row($self->schema, 'male_parent', 'stock_relationship');
1049
1050   my $stock_relationships = $bcs_stock->search_related("stock_relationship_objects",undef,{ prefetch => ['type','subject'] });
1051   my $female_parent_relationship = $stock_relationships->find({type_id => $cvterm_female_parent->cvterm_id()});
1052   my $male_parent_relationship = $stock_relationships->find({type_id => $cvterm_male_parent->cvterm_id()});
1053   if ($female_parent_relationship || $male_parent_relationship) {
1054     return 1;
1055   } else {
1056     return 0;
1057   }
1058 }
1059
1060 sub _stock_has_descendants {
1061   my ($self, $stock) = @_;
1062   my $bcs_stock = $stock->get_object_row;
1063   my $cvterm_female_parent = SGN::Model::Cvterm->get_cvterm_row($self->schema,'female_parent', 'stock_relationship');
1064
1065   my $cvterm_male_parent = SGN::Model::Cvterm->get_cvterm_row($self->schema, 'male_parent', 'stock_relationship');
1066
1067   my $descendant_relationships = $bcs_stock->search_related("stock_relationship_subjects",undef,{ prefetch => ['type','object'] });
1068   if ($descendant_relationships) {
1069       return $descendant_relationships->count();
1070  # while (my $descendant_relationship = $descendant_relationships->next) {
1071  #      my $descendant_stock_id = $descendant_relationship->object_id();
1072  #      #if ($descendant_stock_id && (($descendant_relationship->type_id() == $cvterm_female_parent->cvterm_id()) || ($descendant_relationship->type_id() == $cvterm_male_parent->cvterm_id()))) {
1073  #      if ($descendant_stock_id) {
1074  #      return 1;
1075       } else {
1076         return 0;
1077       }
1078    # }
1079   #}
1080 }
1081
1082 sub _validate_pair {
1083     my ($self,$c,$key,$value) = @_;
1084     $c->throw( is_client_error => 1, public_message => "$value is not a valid value for $key" )
1085         if ($key =~ m/_id$/ and $value !~ m/\d+/);
1086 }
1087
1088
1089
1090
1091 __PACKAGE__->meta->make_immutable;