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