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 stocks (e.g. accession, poopulation, etc.)
   6
   7 =cut
   8
   9 use Moose;
  10 use namespace::autoclean;
  11 use YAML::Any qw/LoadFile/;
  12
  13 use URI::FromHash 'uri';
  14
  15 use CXGN::Chado::Stock;
  16 use SGN::View::Stock qw/stock_link stock_organisms stock_types/;
  17
  18 has 'schema' => (
  19     is       => 'rw',
  20     isa      => 'DBIx::Class::Schema',
  21     required => 0,
  22 );
  23
  24 has 'default_page_size' => (
  25     is      => 'ro',
  26     default => 20,
  27 );
  28
  29
  30 BEGIN { extends 'Catalyst::Controller' }
  31 with 'Catalyst::Component::ApplicationAttribute';
  32
  33 sub _validate_pair {
  34     my ($self,$c,$key,$value) = @_;
  35     $c->throw( is_client_error => 1, public_message => "$value is not a valid value for $key" )
  36         if ($key =~ m/_id$/ and $value !~ m/\d+/);
  37 }
  38
  39 sub search :Path('/stock/search') Args(0) {
  40     my ( $self, $c ) = @_;
  41     $self->schema( $c->dbic_schema('Bio::Chado::Schema','sgn_chado') );
  42
  43     my $results = $c->req->param('search_submitted') ? $self->_make_stock_search_rs($c) : undef;
  44     my $form = HTML::FormFu->new(LoadFile($c->path_to(qw{forms stock stock_search.yaml})));
  45
  46     $c->stash(
  47         template                   => '/stock/search.mas',
  48         request                    => $c->req,
  49         form                       => $form,
  50         form_opts                  => { stock_types => stock_types($self->schema), organisms => stock_organisms($self->schema)} ,
  51         results                    => $results,
  52         sp_person_autocomplete_uri => $c->uri_for( '/ajax/people/autocomplete' ),
  53         trait_autocomplete_uri     => $c->uri_for('/ajax/stock/trait_autocomplete'),
  54         pagination_link_maker      => sub {
  55             return uri( query => { %{$c->req->params} , page => shift } );
  56         },
  57     );
  58 }
  59
  60
  61 # assembles a DBIC resultset for the search based on the submitted
  62 # form values
  63 sub _make_stock_search_rs {
  64     my ( $self, $c ) = @_;
  65
  66     my $rs = $self->schema->resultset('Stock::Stock');
  67
  68     if( my $name = $c->req->param('stock_name') ) {
  69         # trim and regularize whitespace
  70         $name =~ s/(^\s+|\s+)$//g;
  71         $name =~ s/\s+/ /g;
  72
  73         $rs = $rs->search({
  74             -or => [
  75                  'lower(me.name)' => { like => '%'.lc( $name ).'%' } ,
  76                  'lower(uniquename)' => { like => '%'.lc( $name ).'%' },
  77                  -and => [
  78                      'lower(type.name)' => { like =>'%synonym%' },
  79                      'lower(value)' => { like =>'%'.lc( $name ).'%' },
  80                  ],
  81                 ],
  82                           } ,
  83                {  join =>  { 'stockprops' =>  'type'  }  ,
  84                   columns => [ qw/stock_id uniquename type_id organism_id / ],
  85                   distinct => 1
  86                }
  87             );
  88     }
  89     if( my $type = $c->req->param('stock_type') ) {
  90         $self->_validate_pair($c,'type_id',$type);
  91         $rs = $rs->search({ 'me.type_id' => $type });
  92     }
  93     if( my $organism = $c->req->param('organism') ) {
  94         $self->_validate_pair( $c, 'organism_id', $organism );
  95         $rs = $rs->search({ 'organism_id' => $organism });
  96     }
  97     if ( my $editor = $c->req->param('person') ) {
  98         $self->_validate_pair( $c, 'person') ;
  99         my ($first_name, $last_name) = split ',' , $editor ;
 100         $first_name  =~ s/\s//g;
 101         $last_name  =~ s/\s//g;
 102
 103         my $query = "SELECT sp_person_id FROM sgn_people.sp_person
 104                      WHERE first_name = ? AND last_name = ?";
 105         my $sth = $c->dbc->dbh->prepare($query);
 106         $sth->execute($first_name, $last_name);
 107         my ($sp_person_id) = $sth->fetchrow_array ;
 108         if ($sp_person_id) {
 109             $rs = $rs->search( {
 110                 'type.name' => 'sp_person_id',
 111                 'stockprops.value' => $sp_person_id, } ,
 112                                { join => { stockprops =>['type'] } },
 113                 ) ; # if no person_id, rs should be empty
 114         } else { $rs = $rs->search( { name=> '' } , ); }
 115     }
 116     if ( my $trait = $c->req->param('trait') ) {
 117         $rs = $rs->search( { 'observable.name' => $trait },
 118                      { join => { nd_experiment_stocks => { nd_experiment => {'nd_experiment_phenotypes' => {'phenotype' => 'observable' }}}},
 119                        columns => [ qw/stock_id uniquename type_id organism_id / ],
 120                        distinct => 1
 121                      } );
 122     }
 123     if ( my $min = $c->req->param('min_limit') ) {
 124         $rs = $rs->search( { 'cast(phenotype.value as numeric) ' => { '>=' => $min }  },
 125                            { join => { nd_experiment_stocks => { nd_experiment => {'nd_experiment_phenotypes' => 'phenotype' }}},
 126                              columns => [ qw/stock_id uniquename type_id organism_id / ],
 127                              distinct => 1
 128                            } );
 129     }
 130     if ( my $max = $c->req->param('max_limit') ) {
 131         $rs = $rs->search( { 'cast(phenotype.value as numeric) ' => { '<=' => $max }  },
 132                            { join => { nd_experiment_stocks => { nd_experiment => {'nd_experiment_phenotypes' => 'phenotype' }}},
 133                              columns => [ qw/stock_id uniquename type_id organism_id / ],
 134                              distinct => 1
 135                            } );
 136     }
 137     # this is for direct annotations in stock_cvterm
 138     if ( my $ontology = $c->req->param('ontology') ) {
 139     }
 140     if ( my $has_image = $c->req->param('has_image') ) {
 141     }
 142     if ( my $has_locus = $c->req->param('has_locus') ) {
 143     }
 144     # page number and page size, and order by name
 145     $rs = $rs->search( undef, {
 146         page => $c->req->param('page')  || 1,
 147         rows => $c->req->param('page_size') || $self->default_page_size,
 148         order_by => 'uniquename',
 149                        });
 150     return $rs;
 151 }
 152
 153
 154 # sub view_id :Path('/stock/view/id') :Args(1) {
 155 #     my ( $self, $c , $stock_id) = @_;
 156
 157 #     $self->schema( $c->dbic_schema( 'Bio::Chado::Schema', 'sgn_chado' ) );
 158 #     $self->_view_stock($c, 'view', $stock_id);
 159 # }
 160
 161
 162 sub new_stock :Chained('get_stock') : PathPart('new') :Args(0) {
 163     my ( $self, $c ) = @_;
 164     $c->stash(
 165         template => '/stock/index.mas',
 166
 167         stockref => {
 168             action    => "new",
 169             stock_id  => 0 ,
 170             stock     => $c->stash->{stock},
 171             schema    => $self->schema,
 172         },
 173         );
 174 }
 175
 176
 177 sub view_stock :Chained('get_stock') :PathPart('view') :Args(0) {
 178     my ( $self, $c, $action) = @_;
 179     my $logged_user = $c->user;
 180     my $person_id = $logged_user->get_object->get_sp_person_id if $logged_user;
 181     my $curator = $logged_user->check_roles('curator') if $logged_user;
 182     my $submitter = $logged_user->check_roles('submitter') if $logged_user;
 183     my $sequencer = $logged_user->check_roles('sequencer') if $logged_user;
 184
 185     my $dbh = $c->dbc->dbh;
 186
 187     ##################
 188
 189     ###Check if a stock page can be printed###
 190
 191     my $stock = $c->stash->{stock};
 192     my $stock_id = $stock ? $stock->get_stock_id : undef ;
 193
 194     # print message if stock_id is not valid
 195     unless ( ( $stock_id =~ m /^\d+$/ ) || ($action eq 'new' && !$stock_id) ) {
 196         $c->throw_404( "No stock/accession exists for identifier $stock_id" );
 197     }
 198     if (  !$stock->get_object_row  || ($action ne 'new' && !$stock_id) ) {
 199         $c->throw_404( "No stock/accession exists for identifier $stock_id" );
 200     }
 201
 202     # print message if the stock is obsolete
 203     my $obsolete = $stock->get_is_obsolete();
 204     if ( $obsolete  && !$curator ) {
 205         $c->throw(is_client_error => 0,
 206                   title             => 'Obsolete stock',
 207                   message           => "Stock $stock_id is obsolete!",
 208                   developer_message => 'only curators can see obsolete stock',
 209                   notify            => 0,   #< does not send an error email
 210             );
 211     }
 212     # print message if stock_id does not exist
 213     if ( !$stock && $action ne 'new' && $action ne 'store' ) {
 214         $c->throw_404('No stock exists for this identifier');
 215     }
 216
 217     ####################
 218     my $props = $self->_stockprops($stock);
 219     my $is_owner;
 220     my $owner_ids = $props->{sp_person_id} || [] ;
 221     if ( $stock && ($curator || $person_id && ( grep /^$person_id$/, @$owner_ids ) ) ) {
 222         $is_owner = 1;
 223     }
 224     my $dbxrefs = $self->_dbxrefs($stock);
 225     my $pubs = $self->_stock_pubs($stock);
 226
 227     my $cview_tmp_dir = $c->tempfiles_subdir('cview');
 228 ################
 229     $c->stash(
 230         template => '/stock/index.mas',
 231
 232         stockref => {
 233             action    => $action,
 234             stock_id  => $stock_id ,
 235             curator   => $curator,
 236             submitter => $submitter,
 237             sequencer => $sequencer,
 238             person_id => $person_id,
 239             stock     => $stock,
 240             schema    => $self->schema,
 241             dbh       => $dbh,
 242             is_owner  => $is_owner,
 243             props     => $props,
 244             dbxrefs   => $dbxrefs,
 245             owners    => $owner_ids,
 246             pubs      => $pubs,
 247             members_phenotypes => $c->stash->{members_phenotypes},
 248             direct_phenotypes  => $c->stash->{direct_phenotypes},
 249             has_qtl_data   => $c->stash->{has_qtl_data},
 250             cview_tmp_dir  => $cview_tmp_dir,
 251             cview_basepath => $c->get_conf('basepath'),
 252         },
 253         locus_add_uri  => $c->uri_for( '/ajax/stock/associate_locus' ),
 254         cvterm_add_uri => $c->uri_for( '/ajax/stock/associate_ontology')
 255         );
 256 }
 257
 258 sub _stockprops {
 259     my ($self,$stock) = @_;
 260
 261
 262     my $stockprops = $stock->get_object_row()->search_related("stockprops");
 263
 264     my $properties ;
 265     while ( my $prop =  $stockprops->next ) {
 266         push @{ $properties->{$prop->type->name} } ,   $prop->value ;
 267     }
 268     return $properties;
 269 }
 270
 271
 272 sub _dbxrefs {
 273     my ($self,$stock) = @_;
 274
 275     my $stock_dbxrefs = $stock->get_object_row()->search_related("stock_dbxrefs");
 276
 277     my $dbxrefs ;
 278     while ( my $sdbxref =  $stock_dbxrefs->next ) {
 279         my $url = $sdbxref->dbxref->db->urlprefix . $sdbxref->dbxref->db->url;
 280
 281         my $accession = $sdbxref->dbxref->accession;
 282         $url = $url ? qq |<a href = "$url/$accession">$accession</a>| : $accession ;
 283         push @{ $dbxrefs->{$sdbxref->dbxref->db->name} } , $sdbxref->dbxref;
 284     }
 285     return $dbxrefs;
 286 }
 287
 288 sub _stock_nd_experiments {
 289     my ($self, $stock) = @_;
 290
 291     my $nd_experiments = $stock->get_object_row->nd_experiment_stocks->search_related('nd_experiment');
 292     return $nd_experiments;
 293 }
 294
 295 # this sub gets all phenotypes measured directly on this stock and stores
 296 # it in a hashref of keys = project name , values = list of BCS::Phenotype::Phenotype objects
 297 sub _stock_project_phenotypes {
 298     my ($self, $stock) = @_;
 299     my $nd_experiments = $self->_stock_nd_experiments($stock);
 300     my %phenotypes;
 301
 302     while (my $exp = $nd_experiments->next) {
 303         my $geolocation = $exp->nd_geolocation;
 304         # there should be one project linked to the experiment ?
 305         my $project = $exp->nd_experiment_projects->search_related('project')->first;
 306         my @ph = $exp->nd_experiment_phenotypes->search_related('phenotype')->all;
 307
 308         push(@{$phenotypes{$project->description}}, @ph);
 309     }
 310     return \%phenotypes;
 311 }
 312
 313 # this sub gets all phenotypes measured on all subjects of this stock.
 314 # Subjects are in stock_relationship
 315 sub _stock_members_phenotypes {
 316     my ($self, $stock) = @_;
 317     my %phenotypes;
 318     my $has_members_genotypes;
 319     my $objects = $stock->get_object_row->stock_relationship_objects ;
 320     # now we have rs of stock_relationship objects. We need to find the phenotypes of their related subjects
 321     while (my $object = $objects->next ) {
 322
 323         my $subject = $object->subject;
 324         my $subject_stock = CXGN::Chado::Stock->new($self->schema, $subject->stock_id);
 325         my $subject_phenotype_ref = $self->_stock_project_phenotypes($subject_stock);
 326         $has_members_genotypes = 1 if $self->_stock_genotypes($subject_stock);
 327         my %subject_phenotypes = %$subject_phenotype_ref;
 328         foreach my $key (keys %subject_phenotypes) {
 329             push(@{$phenotypes{$key} } , @{$subject_phenotypes{$key} } );
 330         }
 331     }
 332     return \%phenotypes, $has_members_genotypes;
 333 }
 334
 335 sub _stock_dbxrefs {
 336     my ($self,$stock) = @_;
 337
 338     my $stock_dbxrefs = $stock->get_object_row()->search_related("stock_dbxrefs");
 339     # hash of arrays. Keys are db names , values are lists of StockDbxref objects
 340     my $sdbxrefs ;
 341     while ( my $sdbxref =  $stock_dbxrefs->next ) {
 342         push @{ $sdbxrefs->{$sdbxref->dbxref->db->name} } , $sdbxref;
 343     }
 344     return $sdbxrefs;
 345 }
 346
 347 sub _stock_cvterms {
 348     my ($self,$stock) = @_;
 349
 350     my $stock_cvterms = $stock->get_object_row()->search_related("stock_cvterms");
 351     # hash of arrays. Keys are db names , values are lists of StockCvterm objects
 352     my $scvterms ;
 353     while ( my $scvterm =  $stock_cvterms->next ) {
 354         push @{ $scvterms->{$scvterm->cvterm->dbxref->db->name} } , $scvterm;
 355     }
 356     return $scvterms;
 357 }
 358
 359 # each stock may be linked with publications, each publication may have several dbxrefs
 360 sub _stock_pubs {
 361     my ($self, $stock) = @_;
 362     my $stock_pubs = $stock->get_object_row()->search_related("stock_pubs");
 363     my $pubs ;
 364     while (my $spub = $stock_pubs->next ) {
 365         my $pub = $spub->pub;
 366         my $pub_dbxrefs = $pub->pub_dbxrefs;
 367         while (my $pub_dbxref = $pub_dbxrefs->next ) {
 368             $pubs->{$pub_dbxref->dbxref->db->name . ":" .  $pub_dbxref->dbxref->accession } = $pub ;
 369         }
 370     }
 371     return $pubs;
 372 }
 373
 374 sub _stock_genotypes {
 375     my ($self, $stock) = @_;
 376     my $dbh = $stock->get_schema->storage->dbh;
 377     my $q = "SELECT genotype_id FROM phenome.genotype WHERE stock_id = ?";
 378     my $sth = $dbh->prepare($q);
 379     $sth->execute($stock->get_stock_id);
 380     my @genotypes;
 381     while (my ($genotype_id) = $sth->fetchrow_array ) {
 382         push @genotypes, $genotype_id;
 383     }
 384     return \@genotypes;
 385 }
 386
 387
 388 sub get_stock :Chained('/') :PathPart('stock') :CaptureArgs(1) {
 389     my ($self, $c, $stock_id) = @_;
 390
 391     $self->schema( $c->dbic_schema( 'Bio::Chado::Schema', 'sgn_chado' ) );
 392     $c->stash->{stock} = CXGN::Chado::Stock->new($self->schema, $stock_id);
 393
 394     #add the stockprops to the stash. Props are a hashref of lists.
 395     # keys are the cvterm name (prop type) and values  are the prop values.
 396     my $stock = $c->stash->{stock};
 397     my $properties = $stock ?  $self->_stockprops($stock) : undef ;
 398     $c->stash->{stockprops} = $properties;
 399
 400     #add the stock_dbxrefs to the stash. Dbxrefs are hashref of lists.
 401     # keys are db-names , values are lists of Bio::Chado::Schema::General::Dbxref objects
 402     my $dbxrefs  = $stock ?  $self->_stock_dbxrefs($stock) : undef ;
 403     $c->stash->{stock_dbxrefs} = $dbxrefs;
 404
 405     my $cvterms  = $stock ?  $self->_stock_cvterms($stock) : undef ;
 406     $c->stash->{stock_cvterms} = $cvterms;
 407
 408     my $direct_phenotypes  = $stock ? $self->_stock_project_phenotypes($stock) : undef;
 409     $c->stash->{direct_phenotypes} = $direct_phenotypes;
 410
 411     my ($members_phenotypes, $has_members_genotypes)  = $stock ? $self->_stock_members_phenotypes($stock) : undef;
 412     $c->stash->{members_phenotypes} = $members_phenotypes;
 413
 414     my $stock_type = $stock->get_object_row->type->name;
 415     if ( ( grep { /^$stock_type/ } ('f2 population', 'backcross population') ) &&  $members_phenotypes && $has_members_genotypes ) { $c->stash->{has_qtl_data} = 1 ; }
 416
 417 }
 418
 419 ######
 420 1;
 421 ######