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