lib/SGN/Controller/BreedersToolbox.pm

   1
   2 package SGN::Controller::BreedersToolbox;
   3
   4 use Moose;
   5
   6 use Data::Dumper;
   7 use SGN::Controller::AJAX::List;
   8 use CXGN::List::Transform;
   9 use CXGN::BreedersToolbox::Projects;
  10 use CXGN::BreedersToolbox::Accessions;
  11 use SGN::Model::Cvterm;
  12 use URI::FromHash 'uri';
  13 use Spreadsheet::WriteExcel;
  14 use Spreadsheet::Read;
  15 use File::Slurp qw | read_file |;
  16 use File::Temp;
  17 use CXGN::Trial::TrialLayout;
  18 use Try::Tiny;
  19 use File::Basename qw | basename dirname|;
  20 use File::Spec::Functions;
  21
  22 BEGIN { extends 'Catalyst::Controller'; }
  23
  24 sub manage_breeding_programs : Path("/breeders/manage_programs") :Args(0) {
  25     my $self = shift;
  26     my $c = shift;
  27
  28     if (!$c->user()) {
  29
  30         # redirect to login page
  31         $c->res->redirect( uri( path => '/solpeople/login.pl', query => { goto_url => $c->req->uri->path_query } ) );
  32         return;
  33     }
  34
  35     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
  36
  37     my $projects = CXGN::BreedersToolbox::Projects->new( { schema=> $schema } );
  38
  39     my $breeding_programs = $projects->get_breeding_programs();
  40
  41     $c->stash->{breeding_programs} = $breeding_programs;
  42     $c->stash->{user} = $c->user();
  43
  44     $c->stash->{template} = '/breeders_toolbox/breeding_programs.mas';
  45
  46
  47 }
  48
  49 sub manage_trials : Path("/breeders/trials") Args(0) {
  50     my $self = shift;
  51     my $c = shift;
  52
  53     if (!$c->user()) {
  54
  55         # redirect to login page
  56         $c->res->redirect( uri( path => '/solpeople/login.pl', query => { goto_url => $c->req->uri->path_query } ) );
  57         return;
  58     }
  59
  60     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
  61
  62     my $projects = CXGN::BreedersToolbox::Projects->new( { schema=> $schema } );
  63
  64     my $breeding_programs = $projects->get_breeding_programs();
  65
  66     # use get_all_locations, as other calls for locations can be slow
  67     #
  68     $c->stash->{locations} = $projects->get_all_locations();
  69
  70     $c->stash->{breeding_programs} = $breeding_programs;
  71
  72     $c->stash->{template} = '/breeders_toolbox/manage_projects.mas';
  73 }
  74
  75 sub manage_accessions : Path("/breeders/accessions") Args(0) {
  76     my $self = shift;
  77     my $c = shift;
  78     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
  79
  80     if (!$c->user()) {
  81         # redirect to login page
  82         #
  83         $c->res->redirect( uri( path => '/solpeople/login.pl', query => { goto_url => $c->req->uri->path_query } ) );
  84         return;
  85     }
  86
  87     my $ac = CXGN::BreedersToolbox::Accessions->new( { schema=>$schema });
  88
  89     my $accessions = $ac->get_all_accessions($c);
  90     # my $populations = $ac->get_all_populations($c);
  91
  92     $c->stash->{accessions} = $accessions;
  93     #$c->stash->{population_groups} = $populations;
  94     $c->stash->{preferred_species} = $c->config->{preferred_species};
  95     $c->stash->{template} = '/breeders_toolbox/manage_accessions.mas';
  96
  97 }
  98
  99
 100 sub manage_locations : Path("/breeders/locations") Args(0) {
 101     my $self = shift;
 102     my $c = shift;
 103
 104     if (!$c->user()) {
 105
 106         # redirect to login page
 107         #
 108         $c->res->redirect( uri( path => '/solpeople/login.pl', query => { goto_url => $c->req->uri->path_query } ) );
 109         return;
 110     }
 111
 112     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 113     my $bp = CXGN::BreedersToolbox::Projects->new( { schema=>$schema });
 114     my $breeding_programs = $bp->get_breeding_programs();
 115     my $locations = {};
 116     foreach my $b (@$breeding_programs) {
 117         $locations->{$b->[1]} = $bp->get_locations_by_breeding_program($b->[0]);
 118     }
 119     $locations->{'Other'} = $bp->get_locations_by_breeding_program();
 120
 121     $c->stash->{user_id} = $c->user()->get_object()->get_sp_person_id();
 122
 123     print STDERR "Locations: " . Dumper($locations);
 124
 125     $c->stash->{locations} = $locations;
 126
 127     $c->stash->{template} = '/breeders_toolbox/manage_locations.mas';
 128 }
 129
 130 sub manage_nurseries : Path("/breeders/nurseries") Args(0) {
 131     my $self = shift;
 132     my $c = shift;
 133
 134     if (!$c->user()) {
 135
 136         # redirect to login page
 137         #
 138         $c->res->redirect( uri( path => '/solpeople/login.pl', query => { goto_url => $c->req->uri->path_query } ) );
 139         return;
 140     }
 141     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 142     my $bp = CXGN::BreedersToolbox::Projects->new( { schema=>$schema });
 143     my $breeding_programs = $bp->get_breeding_programs();
 144
 145     $c->stash->{user_id} = $c->user()->get_object()->get_sp_person_id();
 146
 147     $c->stash->{locations} = $bp->get_all_locations($c);
 148
 149     #$c->stash->{projects} = $self->get_projects($c);
 150
 151     $c->stash->{programs} = $breeding_programs;
 152
 153     $c->stash->{roles} = $c->user()->roles();
 154
 155     $c->stash->{nurseries} = $self->get_nurseries($c);
 156
 157     $c->stash->{template} = '/breeders_toolbox/manage_nurseries.mas';
 158
 159 }
 160
 161 sub manage_crosses : Path("/breeders/nurseries_and_crosses") Args(0) {
 162     my $self = shift;
 163     my $c = shift;
 164
 165     if (!$c->user()) {
 166
 167         # redirect to login page
 168         #
 169         $c->res->redirect( uri( path => '/solpeople/login.pl', query => { goto_url => $c->req->uri->path_query } ) );
 170         return;
 171     }
 172     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 173     my $bp = CXGN::BreedersToolbox::Projects->new( { schema=>$schema });
 174     my $breeding_programs = $bp->get_breeding_programs();
 175
 176     $c->stash->{user_id} = $c->user()->get_object()->get_sp_person_id();
 177
 178     $c->stash->{locations} = $bp->get_all_locations($c);
 179
 180     #$c->stash->{projects} = $self->get_projects($c);
 181
 182     $c->stash->{programs} = $breeding_programs;
 183
 184     $c->stash->{roles} = $c->user()->roles();
 185
 186     $c->stash->{cross_populations} = $self->get_crosses($c);
 187
 188     $c->stash->{template} = '/breeders_toolbox/manage_crosses.mas';
 189
 190 }
 191
 192 sub manage_phenotyping :Path("/breeders/phenotyping") Args(0) {
 193     my $self =shift;
 194     my $c = shift;
 195
 196     if (!$c->user()) {
 197         $c->res->redirect( uri( path => '/solpeople/login.pl', query => { goto_url => $c->req->uri->path_query } ) );
 198         return;
 199     }
 200
 201     my $data = $self->get_phenotyping_data($c);
 202
 203     $c->stash->{phenotype_files} = $data->{phenotype_files};
 204     $c->stash->{deleted_phenotype_files} = $data->{deleted_phenotype_files};
 205
 206     $c->stash->{template} = '/breeders_toolbox/manage_phenotyping.mas';
 207
 208 }
 209
 210 sub manage_phenotyping_download : Path("/breeders/phenotyping/download") Args(1) {
 211     my $self =shift;
 212     my $c = shift;
 213     my $file_id = shift;
 214
 215     my $metadata_schema = $c->dbic_schema('CXGN::Metadata::Schema');
 216     my $file_row = $metadata_schema->resultset("MdFiles")->find({file_id => $file_id});
 217     my $file_destination =  catfile($file_row->dirname, $file_row->basename);
 218     #print STDERR "\n\n\nfile name:".$file_row->basename."\n";
 219     my $contents = read_file($file_destination);
 220     my $file_name = $file_row->basename;
 221     $c->res->content_type('Application/trt');
 222     $c->res->header('Content-Disposition', qq[attachment; filename="$file_name"]);
 223     $c->res->body($contents);
 224 }
 225
 226 sub manage_phenotyping_view : Path("/breeders/phenotyping/view") Args(1) {
 227     my $self =shift;
 228     my $c = shift;
 229     my $file_id = shift;
 230
 231     my $metadata_schema = $c->dbic_schema('CXGN::Metadata::Schema');
 232     my $file_row = $metadata_schema->resultset("MdFiles")->find({file_id => $file_id});
 233     my $file_destination =  catfile($file_row->dirname, $file_row->basename);
 234     #print STDERR "\n\n\nfile name:".$file_row->basename."\n";
 235     my @contents = ReadData ($file_destination);
 236     #print STDERR Dumper \@contents;
 237     my $file_name = $file_row->basename;
 238     $c->stash->{file_content} = \@contents;
 239     $c->stash->{filename} = $file_name;
 240     $c->stash->{template} = '/breeders_toolbox/view_file.mas';
 241 }
 242
 243 sub make_cross_form :Path("/stock/cross/new") :Args(0) {
 244     my ($self, $c) = @_;
 245     $c->stash->{template} = '/breeders_toolbox/new_cross.mas';
 246     if ($c->user()) {
 247       my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 248       # get projects
 249       my @rows = $schema->resultset('Project::Project')->all();
 250       my @projects = ();
 251       foreach my $row (@rows) {
 252         push @projects, [ $row->project_id, $row->name, $row->description ];
 253       }
 254       $c->stash->{project_list} = \@projects;
 255       @rows = $schema->resultset('NaturalDiversity::NdGeolocation')->all();
 256       my @locations = ();
 257       foreach my $row (@rows) {
 258         push @locations,  [ $row->nd_geolocation_id,$row->description ];
 259       }
 260       $c->stash->{locations} = \@locations;
 261
 262     }
 263     else {
 264       $c->res->redirect( uri( path => '/solpeople/login.pl', query => { goto_url => $c->req->uri->path_query } ) );
 265       return;
 266     }
 267 }
 268
 269
 270 sub make_cross :Path("/stock/cross/generate") :Args(0) {
 271     my ($self, $c) = @_;
 272     $c->stash->{template} = '/breeders_toolbox/progeny_from_crosses.mas';
 273     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 274     my $cross_name = $c->req->param('cross_name');
 275     $c->stash->{cross_name} = $cross_name;
 276     my $trial_id = $c->req->param('trial_id');
 277     $c->stash->{trial_id} = $trial_id;
 278     #my $location = $c->req->param('location_id');
 279     my $maternal = $c->req->param('maternal');
 280     my $paternal = $c->req->param('paternal');
 281     my $prefix = $c->req->param('prefix');
 282     my $suffix = $c->req->param('suffix');
 283     my $progeny_number = $c->req->param('progeny_number');
 284     my $visible_to_role = $c->req->param('visible_to_role');
 285
 286     if (! $c->user()) { # redirect
 287         $c->res->redirect( uri( path => '/solpeople/login.pl', query => { goto_url => $c->req->uri->path_query } ) );
 288         return;
 289     }
 290
 291
 292     #check that progeny number is an integer less than maximum allowed
 293     my $maximum_progeny_number = 1000;
 294     if ((! $progeny_number =~ m/^\d+$/) or ($progeny_number > $maximum_progeny_number)){
 295       #redirect to error page?
 296       return;
 297     }
 298
 299     #check that parent names are not blank
 300     if ($maternal eq "" or $paternal eq "") {
 301       return;
 302     }
 303
 304     #check that parents exist in the database
 305     if (! $schema->resultset("Stock::Stock")->find({name=>$maternal,})){
 306       return;
 307     }
 308     if (! $schema->resultset("Stock::Stock")->find({name=>$paternal,})){
 309       return;
 310     }
 311
 312     #check that cross name does not already exist
 313     if ($schema->resultset("Stock::Stock")->find({name=>$cross_name})){
 314       return;
 315     }
 316
 317     #check that progeny do not already exist
 318     if ($schema->resultset("Stock::Stock")->find({name=>$prefix.$cross_name.$suffix."-1",})){
 319       return;
 320     }
 321
 322     my $organism = $schema->resultset("Organism::Organism")->find_or_create(
 323     {
 324         genus   => 'Manihot',
 325         species => 'Manihot esculenta',
 326     } );
 327     my $organism_id = $organism->organism_id();
 328
 329     my $accession_cvterm = SGN::Model::Cvterm->get_cvterm_row($schema, 'accession', 'stock_type');
 330
 331     my $population_cvterm = $schema->resultset("Cv::Cvterm")->find(
 332       { name   => 'population',
 333     });
 334
 335
 336     my $female_parent_stock = $schema->resultset("Stock::Stock")->find(
 337         { name       => $maternal,
 338         } );
 339
 340     my $male_parent_stock = $schema->resultset("Stock::Stock")->find(
 341             { name       => $paternal,
 342             } );
 343
 344     my $population_stock = $schema->resultset("Stock::Stock")->find_or_create(
 345             { organism_id => $organism_id,
 346               name       => $cross_name,
 347               uniquename => $cross_name,
 348               type_id => $population_cvterm->cvterm_id,
 349             } );
 350       my $female_parent =  SGN::Model::Cvterm->get_cvterm_row($schema, 'female_parent',  'stock_relationship');
 351
 352       my $male_parent =  SGN::Model::Cvterm->get_cvterm_row($schema, 'male_parent', 'stock_relationship');
 353
 354
 355       my $population_members =  SGN::Model::Cvterm->get_cvterm_row($schema,  'cross_relationship','stock_relationship');
 356
 357
 358     my $visible_to_role_cvterm =  SGN::Model::Cvterm->get_cvterm_row($schema,  'visible_to_role', 'local');
 359
 360     my $increment = 1;
 361     while ($increment < $progeny_number + 1) {
 362         $increment = sprintf "%03d", $increment;
 363         my $stock_name = $prefix.$cross_name."_".$increment.$suffix;
 364       my $accession_stock = $schema->resultset("Stock::Stock")->create(
 365             { organism_id => $organism_id,
 366               name       => $stock_name,
 367               uniquename => $stock_name,
 368               type_id     => $accession_cvterm->cvterm_id,
 369             } );
 370       $accession_stock->find_or_create_related('stock_relationship_objects', {
 371                 type_id => $female_parent->cvterm_id(),
 372                 object_id => $accession_stock->stock_id(),
 373                 subject_id => $female_parent_stock->stock_id(),
 374                                                   } );
 375       $accession_stock->find_or_create_related('stock_relationship_objects', {
 376                 type_id => $male_parent->cvterm_id(),
 377                 object_id => $accession_stock->stock_id(),
 378                 subject_id => $male_parent_stock->stock_id(),
 379                                                   } );
 380       $accession_stock->find_or_create_related('stock_relationship_objects', {
 381                 type_id => $population_members->cvterm_id(),
 382                 object_id => $accession_stock->stock_id(),
 383                 subject_id => $population_stock->stock_id(),
 384                                                   } );
 385       if ($visible_to_role ne "") {
 386         my $accession_stock_prop = $schema->resultset("Stock::Stockprop")->find_or_create(
 387                { type_id =>$visible_to_role_cvterm->cvterm_id(),
 388                  value => $visible_to_role,
 389                  stock_id => $accession_stock->stock_id()
 390                  });
 391       }
 392       $increment++;
 393
 394     }
 395     if ($@) {
 396     }
 397 }
 398
 399 sub selection_index : Path("/selection/index") :Args(0) {
 400     my $self = shift;
 401     my $c = shift;
 402
 403     if (!$c->user()) {
 404
 405         # redirect to login page
 406         $c->res->redirect( uri( path => '/solpeople/login.pl', query => { goto_url => $c->req->uri->path_query } ) );
 407         return;
 408     }
 409
 410 #    my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 411
 412   #  my $projects = CXGN::BreedersToolbox::Projects->new( { schema=> $schema } );
 413
 414 #    my $breeding_programs = $projects->get_breeding_programs();
 415
 416   #  $c->stash->{breeding_programs} = $breeding_programs;
 417     $c->stash->{user} = $c->user();
 418
 419     $c->stash->{template} = '/breeders_toolbox/selection_index.mas';
 420
 421
 422 }
 423
 424
 425 sub breeder_home :Path("/breeders/home") Args(0) {
 426     my ($self , $c) = @_;
 427
 428
 429     if (!$c->user()) {
 430
 431         # redirect to login page
 432         $c->res->redirect( uri( path => '/solpeople/login.pl', query => { goto_url => $c->req->uri->path_query } ) );
 433         return;
 434     }
 435
 436     # my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 437     # my $bp = CXGN::BreedersToolbox::Projects->new( { schema=>$schema });
 438     # my $breeding_programs = $bp->get_breeding_programs();
 439
 440     # $c->stash->{programs} = $breeding_programs;
 441     # $c->stash->{breeding_programs} = $breeding_programs;
 442
 443     # # my $locations_by_breeding_program;
 444     # # foreach my $b (@$breeding_programs) {
 445     # #     $locations_by_breeding_program->{$b->[1]} = $bp->get_locations_by_breeding_program($b->[0]);
 446     # # }
 447     # # $locations_by_breeding_program->{'Other'} = $bp->get_locations_by_breeding_program();
 448
 449     # $c->stash->{locations_by_breeding_program} = ""; #$locations_by_breeding_program;
 450
 451     # # get roles
 452     # #
 453     # my @roles = $c->user->roles();
 454     # $c->stash->{roles}=\@roles;
 455
 456     # $c->stash->{cross_populations} = $self->get_crosses($c);
 457
 458     # $c->stash->{stockrelationships} = $self->get_stock_relationships($c);
 459
 460     # my $locations = $bp->get_locations($c);
 461
 462     # $c->stash->{locations} = $locations;
 463     # # get uploaded phenotype files
 464     # #
 465
 466     # my $data = $self->get_phenotyping_data($c);
 467
 468     # $c->stash->{phenotype_files} = $data->{file_info};
 469     # $c->stash->{deleted_phenotype_files} = $data->{deleted_file_info};
 470
 471
 472     $c->stash->{template} = '/breeders_toolbox/home.mas';
 473 }
 474
 475
 476 sub breeder_search : Path('/breeders/search/') :Args(0) {
 477     my ($self, $c) = @_;
 478
 479     $c->stash->{template} = '/breeders_toolbox/breeder_search_page.mas';
 480
 481 }
 482
 483
 484 sub get_crosses : Private {
 485     my $self = shift;
 486     my $c = shift;
 487
 488     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 489
 490     # get crosses
 491     #
 492     my $stock_type_cv = $schema->resultset("Cv::Cv")->find( {name=>'stock_type'});
 493     my $cross_cvterm = $schema->resultset("Cv::Cvterm")->find(
 494         { name   => 'cross',
 495           cv_id => $stock_type_cv->cv_id(),
 496         });
 497     my @cross_populations = ();
 498
 499     if ($cross_cvterm) {
 500
 501       my @cross_population_stocks = $schema->resultset("Stock::Stock")->search(
 502                                                                                { type_id => $cross_cvterm->cvterm_id, is_obsolete => 'f'
 503                                                                                } );
 504       foreach my $cross_pop (@cross_population_stocks) {
 505         push @cross_populations, [$cross_pop->name,$cross_pop->stock_id];
 506       }
 507     }
 508     return  \@cross_populations;
 509 }
 510
 511
 512
 513 sub get_phenotyping_data : Private {
 514     my $self = shift;
 515     my $c = shift;
 516
 517     my $metadata_schema = $c->dbic_schema("CXGN::Metadata::Schema");
 518
 519     my $file_info = [];
 520     my $deleted_file_info = [];
 521
 522      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' } );
 523
 524     print STDERR "RETRIEVED ".$metadata_rs->count()." METADATA ENTRIES...\n";
 525
 526     while (my $md_row = ($metadata_rs->next())) {
 527         my $file_rs = $metadata_schema->resultset("MdFiles")->search( { metadata_id => $md_row->metadata_id() } );
 528
 529         if (!$md_row->obsolete) {
 530             while (my $file_row = $file_rs->next()) {
 531                 push @$file_info, { file_id => $file_row->file_id(),
 532                                     basename => $file_row->basename,
 533                                     dirname  => $file_row->dirname,
 534                                     file_type => $file_row->filetype,
 535                                     md5checksum => $file_row->md5checksum,
 536                                     create_date => $md_row->create_date,
 537                 };
 538             }
 539         }
 540         else {
 541             while (my $file_row = $file_rs->next()) {
 542                 push @$deleted_file_info, { file_id => $file_row->file_id(),
 543                                             basename => $file_row->basename,
 544                                             dirname => $file_row->dirname,
 545                                             file_type => $file_row->filetype,
 546                                             md5checksum => $file_row->md5checksum,
 547                                             create_date => $md_row->create_date,
 548                 };
 549             }
 550         }
 551     }
 552
 553     my $data = { phenotype_files => $file_info,
 554                  deleted_phenotype_files => $deleted_file_info,
 555     };
 556     return $data;
 557
 558
 559 }
 560
 561 sub manage_genotyping : Path("/breeders/genotyping") Args(0) {
 562     my $self = shift;
 563     my $c = shift;
 564
 565     if (!$c->user()) {
 566         # redirect to login page
 567         $c->res->redirect( uri( path => '/solpeople/login.pl', query => { goto_url => $c->req->uri->path_query } ) );
 568         return;
 569     }
 570
 571     my $schema = $c->dbic_schema('Bio::Chado::Schema');
 572
 573     my $projects = CXGN::BreedersToolbox::Projects->new( { schema=> $schema } );
 574
 575     my $breeding_programs = $projects->get_breeding_programs();
 576
 577     my %genotyping_trials_by_breeding_project = ();
 578
 579     foreach my $bp (@$breeding_programs) {
 580         $genotyping_trials_by_breeding_project{$bp->[1]}= $projects->get_genotyping_trials_by_breeding_program($bp->[0]);
 581     }
 582
 583     $genotyping_trials_by_breeding_project{'Other'} = $projects->get_genotyping_trials_by_breeding_program();
 584
 585     $c->stash->{locations} = $projects->get_all_locations($c);
 586
 587     $c->stash->{genotyping_trials_by_breeding_project} = \%genotyping_trials_by_breeding_project;
 588
 589     $c->stash->{breeding_programs} = $breeding_programs;
 590
 591
 592     $c->stash->{template} = '/breeders_toolbox/manage_genotyping.mas';
 593 }
 594
 595
 596 1;