lib/SGN/Controller/BreedersToolbox.pm

   1
   2 package SGN::Controller::BreedersToolbox;
   3
   4 use Moose;
   5
   6 use CXGN::Trial::TrialLayout;
   7 use URI::FromHash 'uri';
   8 use CXGN::BreedersToolbox::Projects;
   9
  10 BEGIN { extends 'Catalyst::Controller'; }
  11
  12
  13 sub manage_breeding_programs : Path("/breeders/manage_programs") :Args(0) {
  14     my $self = shift;
  15     my $c = shift;
  16
  17     if (!$c->user()) {
  18
  19         # redirect to login page
  20         $c->res->redirect( uri( path => '/solpeople/login.pl', query => { goto_url => $c->req->uri->path_query } ) );
  21         return;
  22     }
  23
  24     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
  25
  26     my $projects = CXGN::BreedersToolbox::Projects->new( { schema=> $schema } );
  27
  28     my $breeding_programs = $projects->get_breeding_programs();
  29
  30     $c->stash->{breeding_programs} = $breeding_programs;
  31
  32     $c->stash->{template} = '/breeders_toolbox/breeding_programs.mas';
  33
  34
  35 }
  36
  37 sub manage_trials : Path("/breeders/trials") Args(0) {
  38     my $self = shift;
  39     my $c = shift;
  40
  41     if (!$c->user()) {
  42
  43         # redirect to login page
  44         $c->res->redirect( uri( path => '/solpeople/login.pl', query => { goto_url => $c->req->uri->path_query } ) );
  45         return;
  46     }
  47
  48     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
  49
  50     my $projects = CXGN::BreedersToolbox::Projects->new( { schema=> $schema } );
  51
  52     my $breeding_projects = $projects->get_breeding_programs();
  53
  54     my %trials_by_breeding_project = ();
  55
  56     foreach my $bp (@$breeding_projects) {
  57         $trials_by_breeding_project{$bp->[1]}= $projects->get_trials_by_breeding_program($bp->[0]);
  58     }
  59
  60     $trials_by_breeding_project{'Other'} = $projects->get_trials_by_breeding_program();
  61
  62     $c->stash->{locations} = $self->get_locations($c);
  63
  64     $c->stash->{trials_by_breeding_project} = \%trials_by_breeding_project; #$self->get_projects($c);
  65
  66     $c->stash->{template} = '/breeders_toolbox/manage_projects.mas';
  67 }
  68
  69 sub manage_accessions : Path("/breeders/accessions") Args(0) {
  70     my $self = shift;
  71     my $c = shift;
  72
  73     if (!$c->user()) {
  74         # redirect to login page
  75         #
  76         $c->res->redirect( uri( path => '/solpeople/login.pl', query => { goto_url => $c->req->uri->path_query } ) );
  77         return;
  78     }
  79
  80     $c->stash->{accessions} = ();
  81
  82     $c->stash->{template} = '/breeders_toolbox/manage_accessions.mas';
  83
  84 }
  85
  86
  87 sub manage_locations : Path("/breeders/locations") Args(0) {
  88     my $self = shift;
  89     my $c = shift;
  90
  91     if (!$c->user()) {
  92
  93         # redirect to login page
  94         #
  95         $c->res->redirect( uri( path => '/solpeople/login.pl', query => { goto_url => $c->req->uri->path_query } ) );
  96         return;
  97     }
  98
  99     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 100     my $bp = CXGN::BreedersToolbox::Projects->new( { schema=>$schema });
 101     my $breeding_programs = $bp->get_breeding_programs();
 102     my $locations = {};
 103     foreach my $b (@$breeding_programs) {
 104         $locations->{$b->[1]} = $bp->get_locations_by_breeding_program($b->[0]);
 105     }
 106     $locations->{'Other'} = $bp->get_locations_by_breeding_program();
 107
 108     $c->stash->{user_id} = $c->user()->get_object()->get_sp_person_id();
 109
 110     $c->stash->{locations} = $locations;
 111
 112     $c->stash->{template} = '/breeders_toolbox/manage_locations.mas';
 113 }
 114
 115 sub manage_crosses : Path("/breeders/crosses") Args(0) {
 116     my $self = shift;
 117     my $c = shift;
 118
 119     if (!$c->user()) {
 120
 121         # redirect to login page
 122         #
 123         $c->res->redirect( uri( path => '/solpeople/login.pl', query => { goto_url => $c->req->uri->path_query } ) );
 124         return;
 125     }
 126     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 127     my $bp = CXGN::BreedersToolbox::Projects->new( { schema=>$schema });
 128     my $breeding_programs = $bp->get_breeding_programs();
 129
 130     $c->stash->{user_id} = $c->user()->get_object()->get_sp_person_id();
 131
 132     $c->stash->{locations} = $self->get_locations($c);
 133
 134     #$c->stash->{projects} = $self->get_projects($c);
 135
 136     $c->stash->{programs} = $breeding_programs;;
 137
 138     $c->stash->{roles} = $c->user()->roles();
 139
 140     $c->stash->{cross_populations} = $self->get_crosses($c);
 141
 142     $c->stash->{template} = '/breeders_toolbox/manage_crosses.mas';
 143
 144 }
 145
 146 sub manage_phenotyping :Path("/breeders/phenotyping") Args(0) {
 147     my $self =shift;
 148     my $c = shift;
 149
 150     if (!$c->user()) {
 151         $c->res->redirect( uri( path => '/solpeople/login.pl', query => { goto_url => $c->req->uri->path_query } ) );
 152         return;
 153     }
 154
 155     my $data = $self->get_phenotyping_data($c);
 156
 157     $c->stash->{phenotype_files} = $data->{file_info};
 158     $c->stash->{deleted_phenotype_files} = $data->{deleted_file_info};
 159
 160     $c->stash->{template} = '/breeders_toolbox/manage_phenotyping.mas';
 161
 162
 163 }
 164
 165 sub breeder_home :Path("/breeders/home") Args(0) {
 166     my ($self , $c) = @_;
 167
 168
 169     if (!$c->user()) {
 170
 171         # redirect to login page
 172         $c->res->redirect( uri( path => '/solpeople/login.pl', query => { goto_url => $c->req->uri->path_query } ) );
 173         return;
 174     }
 175
 176     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 177
 178     $c->stash->{projects} = $self->get_projects($c);
 179
 180     # get roles
 181     #
 182     my @roles = $c->user->roles();
 183     $c->stash->{roles}=\@roles;
 184
 185     $c->stash->{cross_populations} = $self->get_crosses($c);
 186
 187     $c->stash->{stockrelationships} = $self->get_stock_relationships($c);
 188
 189     my $locations = $self->get_locations($c);
 190
 191     # get uploaded phenotype files
 192     #
 193
 194     my $data = $self->get_phenotyping_data($c);
 195
 196
 197
 198     $c->stash->{phenotype_files} = $data->{file_info};
 199     $c->stash->{deleted_phenotype_files} = $data->{deleted_file_info};
 200
 201     $c->stash->{template} = '/breeders_toolbox/home.mas';
 202 }
 203
 204
 205 sub breeder_search : Path('/breeder_search/') :Args(0) {
 206     my ($self, $c) = @_;
 207
 208     $c->stash->{template} = '/breeders_toolbox/breeder_search.mas';
 209
 210 }
 211
 212 # sub trial_info : Path('/breeders_toolbox/trial') Args(1) {
 213 #   my $self = shift;
 214 #   my $c = shift;
 215
 216 #   my $trial_id = shift;
 217
 218
 219
 220 #   if (!$c->user()) {
 221 #     $c->stash->{template} = '/generic_message.mas';
 222 #     $c->stash->{message}  = 'You must be logged in to access this page.';
 223 #     return;
 224 #   }
 225 #   my $dbh = $c->dbc->dbh();
 226
 227 #   my $h = $dbh->prepare("SELECT project.name FROM project WHERE project_id=?");
 228 #   $h->execute($trial_id);
 229
 230 #   my ($name) = $h->fetchrow_array();
 231
 232 #   $c->stash->{trial_name} = $name;
 233
 234 #   $h = $dbh->prepare("SELECT distinct(nd_geolocation.nd_geolocation_id), nd_geolocation.description, count(*) FROM nd_geolocation JOIN nd_experiment USING(nd_geolocation_id) JOIN nd_experiment_project USING (nd_experiment_id) JOIN project USING (project_id) WHERE project_id=? GROUP BY nd_geolocation_id, nd_geolocation.description");
 235 #   $h->execute($trial_id);
 236
 237 #   my @location_data = ();
 238 #   while (my ($id, $desc, $count) = $h->fetchrow_array()) {
 239 #     push @location_data, [$id, $desc, $count];
 240 #   }
 241
 242 #   $c->stash->{location_data} = \@location_data;
 243
 244 #   $h = $dbh->prepare("SELECT distinct(cvterm.name), count(*) FROM cvterm JOIN phenotype ON (cvterm_id=cvalue_id) JOIN nd_experiment_phenotype USING(phenotype_id) JOIN nd_experiment_project USING(nd_experiment_id) WHERE project_id=? GROUP BY cvterm.name");
 245
 246 #   $h->execute($trial_id);
 247
 248 #   my @phenotype_data;
 249 #   while (my ($trait, $count) = $h->fetchrow_array()) {
 250 #     push @phenotype_data, [$trait, $count];
 251 #   }
 252 #   $c->stash->{phenotype_data} = \@phenotype_data;
 253
 254 #   $h = $dbh->prepare("SELECT distinct(projectprop.value) FROM projectprop WHERE project_id=? AND type_id=(SELECT cvterm_id FROM cvterm WHERE name='project year')");
 255 #   $h->execute($trial_id);
 256
 257 #   my @years;
 258 #   while (my ($year) = $h->fetchrow_array()) {
 259 #     push @years, $year;
 260 #   }
 261
 262
 263 #   $c->stash->{years} = \@years;
 264
 265 #   $c->stash->{plot_data} = [];
 266
 267 #   $c->stash->{template} = '/breeders_toolbox/trial.mas';
 268 # }
 269
 270 sub get_locations : Private {
 271     my $self = shift;
 272     my $c= shift;
 273
 274     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 275
 276     my @rows = $schema->resultset('NaturalDiversity::NdGeolocation')->all();
 277
 278     my $type_id = $schema->resultset('Cv::Cvterm')->search( { 'name'=>'plot' })->first->cvterm_id;
 279
 280
 281     my @locations = ();
 282     foreach my $row (@rows) {
 283         my $plot_count = "SELECT count(*) from stock join cvterm on(type_id=cvterm_id) join nd_experiment_stock using(stock_id) join nd_experiment using(nd_experiment_id)   where cvterm.name='plot' and nd_geolocation_id=?"; # and sp_person_id=?";
 284         my $sh = $c->dbc->dbh->prepare($plot_count);
 285         $sh->execute($row->nd_geolocation_id); #, $c->user->get_object->get_sp_person_id);
 286
 287         my ($count) = $sh->fetchrow_array();
 288
 289         print STDERR "PLOTS: $count\n";
 290
 291         #if ($count > 0) {
 292
 293                 push @locations,  [ $row->nd_geolocation_id,
 294                                     $row->description,
 295                                     $row->latitude,
 296                                     $row->longitude,
 297                                     $row->altitude,
 298                                     $count, # number of experiments TBD
 299
 300                 ];
 301     }
 302     return \@locations;
 303
 304 }
 305
 306 # sub get_projects : Private {
 307 #     my $self = shift;
 308 #     my $c = shift;
 309
 310 #     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 311
 312
 313 #    # get breeding programs
 314 #     #
 315
 316 #     my $bp_rows = ();
 317 #     # get projects
 318 #     #
 319 #     my @projects = ();
 320 #     foreach my $bp (@bp_rows) {
 321 #       my @project_rows = $schema->resultset('Project::Project')->search( { }, { join => 'project_relationship', { join => 'project' }}) ;
 322
 323
 324 #       foreach my $row (@project_rows) {
 325 #           push @projects, [ $row->project_id, $row->name, $row->description ];
 326
 327 #       }
 328 #     }
 329 #     return \@projects;
 330 # }
 331
 332 sub get_crosses : Private {
 333     my $self = shift;
 334     my $c = shift;
 335
 336     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 337
 338     # get crosses
 339     #
 340     my $cross_cvterm = $schema->resultset("Cv::Cvterm")->find(
 341         { name   => 'cross',
 342         });
 343     my @cross_populations = ();
 344
 345     if ($cross_cvterm) {
 346
 347       my @cross_population_stocks = $schema->resultset("Stock::Stock")->search(
 348                                                                                { type_id => $cross_cvterm->cvterm_id,
 349                                                                                } );
 350       foreach my $cross_pop (@cross_population_stocks) {
 351         push @cross_populations, [$cross_pop->name,$cross_pop->stock_id];
 352       }
 353     }
 354     return  \@cross_populations;
 355 }
 356
 357
 358 sub get_stock_relationships : Private {
 359     my $self = shift;
 360     my $c = shift;
 361
 362     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 363
 364     my $stockrel = $schema->resultset("Cv::Cvterm")->create_with(
 365         { name   => 'cross',
 366           cv     => 'stock relationship',
 367           db     => 'null',
 368           dbxref => 'cross',
 369         });
 370
 371
 372
 373     #my $stockrel_type_id = $schema->resultset('Cv::Cvterm')->search( { 'name'=>'cross' })->first->cvterm_id;
 374
 375     my @rows = $schema->resultset('Stock::StockRelationship')->search( {type_id => $stockrel->cvterm_id });
 376
 377     my @stockrelationships = ();
 378
 379         foreach my $row (@rows) {
 380             push @stockrelationships, [$row->type_id];
 381         }
 382
 383     push @stockrelationships, ["example"];
 384
 385  return \@stockrelationships;
 386
 387 }
 388
 389 sub get_phenotyping_data : Private {
 390     my $self = shift;
 391     my $c = shift;
 392
 393     my $metadata_schema = $c->dbic_schema("CXGN::Metadata::Schema");
 394
 395     my $file_info = [];
 396     my $deleted_file_info = [];
 397
 398      my $metadata_rs = $metadata_schema->resultset("MdMetadata")->search( { create_person_id => $c->user()->get_object->get_sp_person_id(), obsolete => 0 }, { order_by => 'create_date' } );
 399
 400     while (my $md_row = ($metadata_rs->next())) {
 401         my $file_rs = $metadata_schema->resultset("MdFiles")->search( { metadata_id => $md_row->metadata_id() } );
 402
 403         if (!$md_row->obsolete) {
 404             while (my $file_row = $file_rs->next()) {
 405                 push @$file_info, { basename => $file_row->basename,
 406                                     dirname  => $file_row->dirname,
 407                                     file_type => $file_row->filetype,
 408                                     md5checksum => $file_row->md5checksum,
 409                                     create_date => $md_row->create_date,
 410                 };
 411             }
 412         }
 413         else {
 414             while (my $file_row = $file_rs->next()) {
 415                 push @$deleted_file_info, { basename => $file_row->basename,
 416                                             dirname => $file_row->dirname,
 417                                             file_type => $file_row->filetype,
 418                                             md5checksum => $file_row->md5checksum,
 419                                             create_date => $md_row->create_date,
 420                 };
 421             }
 422         }
 423     }
 424
 425     my $data = { phenotype_files => $file_info,
 426                  deleted_phenotype_files => $deleted_file_info,
 427     };
 428     return $data;
 429
 430
 431 }
 432
 433 1;