lib/SGN/Controller/Root.pm

   1 package SGN::Controller::Root;
   2 use Moose;
   3 use namespace::autoclean;
   4
   5 use Scalar::Util 'weaken';
   6 use CatalystX::GlobalContext ();
   7
   8 use CXGN::Login;
   9 use CXGN::People::Person;
  10 use List::MoreUtils 'uniq';
  11 use JSON;
  12
  13
  14 BEGIN { extends 'Catalyst::Controller' }
  15
  16 #
  17 # Sets the actions in this controller to be registered with no prefix
  18 # so they function identically to actions created in MyApp.pm
  19 #
  20 __PACKAGE__->config(namespace => '');
  21
  22 =head1 NAME
  23
  24 SGN::Controller::Root - Root Controller for SGN
  25
  26 =head1 DESCRIPTION
  27
  28 Web application to run the SGN web site.
  29
  30 =head1 PUBLIC ACTIONS
  31
  32 =head2 index
  33
  34 The root page (/)
  35
  36 =cut
  37
  38 sub index :Path :Args(0) {
  39     my ( $self, $c ) = @_;
  40     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
  41
  42     if ($c->config->{homepage_display_phenotype_uploads}){
  43         my @file_array;
  44         my %file_info;
  45         my $q = "SELECT file_id, m.create_date, p.sp_person_id, p.username, basename, dirname, filetype, project_id, project.name FROM nd_experiment_project JOIN project USING(project_id) JOIN nd_experiment_phenotype USING(nd_experiment_id) JOIN phenome.nd_experiment_md_files ON (nd_experiment_phenotype.nd_experiment_id=nd_experiment_md_files.nd_experiment_id) LEFT JOIN metadata.md_files using(file_id) LEFT JOIN metadata.md_metadata as m using(metadata_id) LEFT JOIN sgn_people.sp_person as p ON (p.sp_person_id=m.create_person_id) WHERE m.obsolete = 0 and NOT (metadata.md_files.filetype='generated from plot from plant phenotypes') and NOT (metadata.md_files.filetype='direct phenotyping')";
  46         my $h = $schema->storage()->dbh()->prepare($q);
  47         $h->execute();
  48
  49         while (my ($file_id, $create_date, $person_id, $username, $basename, $dirname, $filetype, $project_id, $project_name) = $h->fetchrow_array()) {
  50             $file_info{$file_id}->{project_ids}->{$project_id} = $project_name;
  51             $file_info{$file_id}->{metadata} = [$file_id, $create_date, $person_id, $username, $basename, $dirname, $filetype, $project_id];
  52         }
  53         foreach (sort {$b <=> $a} keys %file_info){
  54             push @file_array, $file_info{$_};
  55         }
  56         #print STDERR Dumper \@file_array;
  57         $c->stash->{phenotype_files} = \@file_array;
  58     }
  59
  60     my $projects = CXGN::BreedersToolbox::Projects->new( { schema=> $schema } );
  61     my $breeding_programs = $projects->get_breeding_programs();
  62     $c->stash->{locations} = decode_json $projects->get_location_geojson();
  63     $c->stash->{breeding_programs} = $breeding_programs;
  64     $c->stash->{preferred_species} = $c->config->{preferred_species};
  65     $c->stash->{timestamp} = localtime;
  66
  67     my @editable_stock_props = split ',', $c->config->{editable_stock_props};
  68     my %editable_stock_props = map { $_=>1 } @editable_stock_props;
  69     $c->stash->{editable_stock_props} = \%editable_stock_props;
  70
  71     my $genotyping_facilities = $c->config->{genotyping_facilities};
  72     my @facilities = split ',',$genotyping_facilities;
  73     $c->stash->{facilities} = \@facilities;
  74
  75     my $field_management_factors = $c->config->{management_factor_types};
  76     my @management_factor_types = split ',',$field_management_factors;
  77     $c->stash->{management_factor_types} = \@management_factor_types;
  78
  79     $c->stash->{template} = '/index.mas';
  80     $c->stash->{schema}   = $c->dbic_schema('SGN::Schema');
  81     $c->stash->{static_content_path} = $c->config->{static_content_path};
  82 }
  83
  84 =head2 default
  85
  86 Attempt to find index.pl pages, and prints standard 404 error page if
  87 nothing could be found.
  88
  89 =cut
  90
  91 sub default :Path {
  92     my ( $self, $c ) = @_;
  93
  94     return 1 if $c->forward('/redirects/find_redirect');
  95
  96     $c->throw_404;
  97 }
  98
  99 =head2 bare_mason
 100
 101 Render a bare mason component, with no autohandler wrapping.
 102 Currently used for GBrowse integration (GBrowse makes a subrequest for
 103 the mason header and footer).
 104
 105 =cut
 106
 107 sub bare_mason :Path('bare_mason') {
 108     my ( $self, $c, @args ) = @_;
 109
 110     # figure out our template path
 111     my $t = File::Spec->catfile( @args );
 112     $t .= '.mas' unless $t =~ m|\.[^/\\\.]+$|;
 113     $c->stash->{template} = $t;
 114
 115     # TODO: check that it exists
 116
 117     $c->forward('View::BareMason');
 118 }
 119
 120 =head1 PRIVATE ACTIONS
 121
 122 =head2 end
 123
 124 Attempt to render a view, if needed.
 125
 126 =cut
 127
 128 sub render : ActionClass('RenderView') { }
 129 sub end : Private {
 130     my ( $self, $c ) = @_;
 131
 132     return if @{$c->error};
 133
 134     # don't try to render a default view if this was handled by a CGI
 135     $c->forward('render') unless $c->req->path =~ /\.pl$/;
 136
 137     # enforce a default text/html content type regardless of whether
 138     # we tried to render a default view
 139     $c->res->content_type('text/html') unless $c->res->content_type;
 140
 141     if( $c->res->content_type eq 'text/html' ) {
 142         # insert any additional header html collected during rendering
 143         $c->forward('insert_collected_html');
 144
 145         # tell caches our responses vary depending on the Cookie header
 146         $c->res->headers->push_header('Vary', 'Cookie');
 147     } else {
 148         $c->log->debug("skipping JS pack insertion for page with content type ".$c->res->content_type)
 149             if $c->debug;
 150     }
 151
 152 }
 153
 154 sub insert_collected_html :Private {
 155     my ( $self, $c ) = @_;
 156
 157     $c->forward('/js/resolve_javascript_classes');
 158     $c->forward('resolve_css_paths');
 159
 160     my $b = $c->res->body;
 161     my $inserted_head_pre  = $b && $b =~ s{<!-- \s* INSERT_HEAD_PRE_HTML \s* --> }{ $self->_make_head_pre_html( $c )  }ex;
 162     my $inserted_head_post = $b && $b =~ s{<!-- \s* INSERT_HEAD_POST_HTML \s* -->}{ $self->_make_head_post_html( $c ) }ex;
 163     if( $inserted_head_pre || $inserted_head_post ) {
 164       $c->res->body( $b );
 165
 166       # we have changed the size of the body.  remove the
 167       # content-length and let catalyst recalculate the content-length
 168       # if it can
 169       $c->res->headers->remove_header('content-length');
 170
 171       delete $c->stash->{$_} for qw( add_head_html add_css_files add_js_classes );
 172   }
 173 }
 174
 175 sub _make_head_pre_html {
 176     my ( $self, $c ) = @_;
 177     return join "\n", (
 178         @{ $c->stash->{head_pre_html} || [] },
 179         ( map {
 180             qq{<link rel="stylesheet" type="text/css" href="$_" />}
 181           } @{ $c->stash->{css_uris} || [] }
 182         ),
 183     );
 184 }
 185
 186 sub _make_head_post_html {
 187     my ( $self, $c ) = @_;
 188
 189     my $head_post_html = join "\n", (
 190         @{ $c->stash->{add_head_html} || [] },
 191         ( map {
 192             qq{<script src="$_" type="text/javascript"></script>}
 193           } @{ $c->stash->{js_uris} || [] }
 194         ),
 195     );
 196
 197     return $head_post_html;
 198 }
 199
 200 =head2 auto
 201
 202 Run for every request to the site.
 203
 204 =cut
 205
 206 sub auto : Private {
 207     my ($self, $c) = @_;
 208     CatalystX::GlobalContext->set_context( $c );
 209     $c->stash->{c} = $c;
 210     weaken $c->stash->{c};
 211
 212     # gluecode for logins
 213     #
 214     unless( $c->config->{'disable_login'} ) {
 215         my $dbh = $c->dbc->dbh;
 216         if ( my $sp_person_id = CXGN::Login->new( $dbh )->has_session ) {
 217
 218             my $sp_person = CXGN::People::Person->new( $dbh, $sp_person_id);
 219
 220             $c->authenticate({
 221                 username => $sp_person->get_username(),
 222                 password => $sp_person->get_password(),
 223             });
 224         }
 225     }
 226
 227     return 1;
 228 }
 229
 230
 231 =head2 resolve_css_paths
 232
 233     Compiles list of CSS files added by mason/import_css.mas
 234
 235 =cut
 236
 237 sub resolve_css_paths :Private {
 238     my ( $self, $c ) = @_;
 239
 240     my $files = $c->stash->{css_paths}
 241         or return;
 242
 243     my @files = uniq @{$files}; #< do not sort, load order might be important
 244     # assume paths are relative to /static/css/ if they are not absolute paths or urls
 245     for (@files) {
 246         s!^([^/])!/static/css/$1! if !(/^(.*?:\/)/);
 247     }
 248
 249     $c->stash->{css_uris} = \@files;
 250 }
 251
 252
 253 ############# helper methods ##########
 254
 255 sub _find_cgi_action {
 256     my ($self,$c,$path) = @_;
 257
 258     $path =~ s!/+!/!g;
 259      my $cgi = $c->controller('CGI')
 260          or return;
 261
 262     my $index_action = $cgi->cgi_action_for( $path )
 263         or return;
 264
 265     $c->log->debug("found CGI index action '$index_action'") if $c->debug;
 266
 267     return $index_action;
 268 }
 269
 270 =head1 AUTHOR
 271
 272 Robert Buels, Jonathan "Duke" Leto
 273
 274 =head1 LICENSE
 275
 276 This library is free software. You can redistribute it and/or modify
 277 it under the same terms as Perl itself.
 278
 279 =cut
 280
 281 __PACKAGE__->meta->make_immutable;
 282
 283 1;