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