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     $c->stash->{locations} = $locations;
 124
 125     $c->stash->{template} = '/breeders_toolbox/manage_locations.mas';
 126 }
 127
 128 sub manage_crosses : Path("/breeders/crosses") Args(0) {
 129     my $self = shift;
 130     my $c = shift;
 131
 132     if (!$c->user()) {
 133
 134         # redirect to login page
 135         #
 136         $c->res->redirect( uri( path => '/solpeople/login.pl', query => { goto_url => $c->req->uri->path_query } ) );
 137         return;
 138     }
 139     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 140     my $bp = CXGN::BreedersToolbox::Projects->new( { schema=>$schema });
 141     my $breeding_programs = $bp->get_breeding_programs();
 142
 143     $c->stash->{user_id} = $c->user()->get_object()->get_sp_person_id();
 144
 145     $c->stash->{locations} = $bp->get_all_locations($c);
 146
 147     #$c->stash->{projects} = $self->get_projects($c);
 148
 149     $c->stash->{programs} = $breeding_programs;
 150
 151     $c->stash->{roles} = $c->user()->roles();
 152
 153     $c->stash->{cross_populations} = $self->get_crosses($c);
 154
 155     $c->stash->{template} = '/breeders_toolbox/manage_crosses.mas';
 156
 157 }
 158
 159 sub manage_phenotyping :Path("/breeders/phenotyping") Args(0) {
 160     my $self =shift;
 161     my $c = shift;
 162
 163     if (!$c->user()) {
 164         $c->res->redirect( uri( path => '/solpeople/login.pl', query => { goto_url => $c->req->uri->path_query } ) );
 165         return;
 166     }
 167
 168     my $data = $self->get_phenotyping_data($c);
 169
 170     $c->stash->{phenotype_files} = $data->{phenotype_files};
 171     $c->stash->{deleted_phenotype_files} = $data->{deleted_phenotype_files};
 172
 173     $c->stash->{template} = '/breeders_toolbox/manage_phenotyping.mas';
 174
 175 }
 176
 177 sub manage_phenotyping_download : Path("/breeders/phenotyping/download") Args(1) {
 178     my $self =shift;
 179     my $c = shift;
 180     my $file_id = shift;
 181
 182     my $metadata_schema = $c->dbic_schema('CXGN::Metadata::Schema');
 183     my $file_row = $metadata_schema->resultset("MdFiles")->find({file_id => $file_id});
 184     my $file_destination =  catfile($file_row->dirname, $file_row->basename);
 185     #print STDERR "\n\n\nfile name:".$file_row->basename."\n";
 186     my $contents = read_file($file_destination);
 187     my $file_name = $file_row->basename;
 188     $c->res->content_type('Application/trt');
 189     $c->res->header('Content-Disposition', qq[attachment; filename="$file_name"]);
 190     $c->res->body($contents);
 191 }
 192
 193 sub manage_phenotyping_view : Path("/breeders/phenotyping/view") Args(1) {
 194     my $self =shift;
 195     my $c = shift;
 196     my $file_id = shift;
 197
 198     my $metadata_schema = $c->dbic_schema('CXGN::Metadata::Schema');
 199     my $file_row = $metadata_schema->resultset("MdFiles")->find({file_id => $file_id});
 200     my $file_destination =  catfile($file_row->dirname, $file_row->basename);
 201     #print STDERR "\n\n\nfile name:".$file_row->basename."\n";
 202     my @contents = ReadData ($file_destination);
 203     #print STDERR Dumper \@contents;
 204     my $file_name = $file_row->basename;
 205     $c->stash->{file_content} = \@contents;
 206     $c->stash->{filename} = $file_name;
 207     $c->stash->{template} = '/breeders_toolbox/view_file.mas';
 208 }
 209
 210 sub make_cross_form :Path("/stock/cross/new") :Args(0) {
 211     my ($self, $c) = @_;
 212     $c->stash->{template} = '/breeders_toolbox/new_cross.mas';
 213     if ($c->user()) {
 214       my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 215       # get projects
 216       my @rows = $schema->resultset('Project::Project')->all();
 217       my @projects = ();
 218       foreach my $row (@rows) {
 219         push @projects, [ $row->project_id, $row->name, $row->description ];
 220       }
 221       $c->stash->{project_list} = \@projects;
 222       @rows = $schema->resultset('NaturalDiversity::NdGeolocation')->all();
 223       my @locations = ();
 224       foreach my $row (@rows) {
 225         push @locations,  [ $row->nd_geolocation_id,$row->description ];
 226       }
 227       $c->stash->{locations} = \@locations;
 228
 229     }
 230     else {
 231       $c->res->redirect( uri( path => '/solpeople/login.pl', query => { goto_url => $c->req->uri->path_query } ) );
 232       return;
 233     }
 234 }
 235
 236
 237 sub make_cross :Path("/stock/cross/generate") :Args(0) {
 238     my ($self, $c) = @_;
 239     $c->stash->{template} = '/breeders_toolbox/progeny_from_crosses.mas';
 240     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 241     my $cross_name = $c->req->param('cross_name');
 242     $c->stash->{cross_name} = $cross_name;
 243     my $trial_id = $c->req->param('trial_id');
 244     $c->stash->{trial_id} = $trial_id;
 245     #my $location = $c->req->param('location_id');
 246     my $maternal = $c->req->param('maternal');
 247     my $paternal = $c->req->param('paternal');
 248     my $prefix = $c->req->param('prefix');
 249     my $suffix = $c->req->param('suffix');
 250     my $progeny_number = $c->req->param('progeny_number');
 251     my $visible_to_role = $c->req->param('visible_to_role');
 252
 253     if (! $c->user()) { # redirect
 254         $c->res->redirect( uri( path => '/solpeople/login.pl', query => { goto_url => $c->req->uri->path_query } ) );
 255         return;
 256     }
 257
 258
 259     #check that progeny number is an integer less than maximum allowed
 260     my $maximum_progeny_number = 1000;
 261     if ((! $progeny_number =~ m/^\d+$/) or ($progeny_number > $maximum_progeny_number)){
 262       #redirect to error page?
 263       return;
 264     }
 265
 266     #check that parent names are not blank
 267     if ($maternal eq "" or $paternal eq "") {
 268       return;
 269     }
 270
 271     #check that parents exist in the database
 272     if (! $schema->resultset("Stock::Stock")->find({name=>$maternal,})){
 273       return;
 274     }
 275     if (! $schema->resultset("Stock::Stock")->find({name=>$paternal,})){
 276       return;
 277     }
 278
 279     #check that cross name does not already exist
 280     if ($schema->resultset("Stock::Stock")->find({name=>$cross_name})){
 281       return;
 282     }
 283
 284     #check that progeny do not already exist
 285     if ($schema->resultset("Stock::Stock")->find({name=>$prefix.$cross_name.$suffix."-1",})){
 286       return;
 287     }
 288
 289     my $organism = $schema->resultset("Organism::Organism")->find_or_create(
 290     {
 291         genus   => 'Manihot',
 292         species => 'Manihot esculenta',
 293     } );
 294     my $organism_id = $organism->organism_id();
 295
 296     my $accession_cvterm = SGN::Model::Cvterm->get_cvterm_row($schema, 'accession', 'stock_type');
 297
 298     my $population_cvterm = $schema->resultset("Cv::Cvterm")->find(
 299       { name   => 'population',
 300     });
 301
 302
 303     my $female_parent_stock = $schema->resultset("Stock::Stock")->find(
 304         { name       => $maternal,
 305         } );
 306
 307     my $male_parent_stock = $schema->resultset("Stock::Stock")->find(
 308             { name       => $paternal,
 309             } );
 310
 311     my $population_stock = $schema->resultset("Stock::Stock")->find_or_create(
 312             { organism_id => $organism_id,
 313               name       => $cross_name,
 314               uniquename => $cross_name,
 315               type_id => $population_cvterm->cvterm_id,
 316             } );
 317       my $female_parent =  SGN::Model::Cvterm->get_cvterm_row($schema, 'female_parent',  'stock_relationship');
 318
 319       my $male_parent =  SGN::Model::Cvterm->get_cvterm_row($schema, 'male_parent', 'stock_relationship');
 320
 321
 322       my $population_members =  SGN::Model::Cvterm->get_cvterm_row($schema,  'cross_relationship','stock_relationship');
 323
 324
 325     my $visible_to_role_cvterm =  SGN::Model::Cvterm->get_cvterm_row($schema,  'visible_to_role', 'local');
 326
 327     my $increment = 1;
 328     while ($increment < $progeny_number + 1) {
 329         $increment = sprintf "%03d", $increment;
 330         my $stock_name = $prefix.$cross_name."_".$increment.$suffix;
 331       my $accession_stock = $schema->resultset("Stock::Stock")->create(
 332             { organism_id => $organism_id,
 333               name       => $stock_name,
 334               uniquename => $stock_name,
 335               type_id     => $accession_cvterm->cvterm_id,
 336             } );
 337       $accession_stock->find_or_create_related('stock_relationship_objects', {
 338                 type_id => $female_parent->cvterm_id(),
 339                 object_id => $accession_stock->stock_id(),
 340                 subject_id => $female_parent_stock->stock_id(),
 341                                                   } );
 342       $accession_stock->find_or_create_related('stock_relationship_objects', {
 343                 type_id => $male_parent->cvterm_id(),
 344                 object_id => $accession_stock->stock_id(),
 345                 subject_id => $male_parent_stock->stock_id(),
 346                                                   } );
 347       $accession_stock->find_or_create_related('stock_relationship_objects', {
 348                 type_id => $population_members->cvterm_id(),
 349                 object_id => $accession_stock->stock_id(),
 350                 subject_id => $population_stock->stock_id(),
 351                                                   } );
 352       if ($visible_to_role ne "") {
 353         my $accession_stock_prop = $schema->resultset("Stock::Stockprop")->find_or_create(
 354                { type_id =>$visible_to_role_cvterm->cvterm_id(),
 355                  value => $visible_to_role,
 356                  stock_id => $accession_stock->stock_id()
 357                  });
 358       }
 359       $increment++;
 360
 361     }
 362     if ($@) {
 363     }
 364 }
 365
 366
 367
 368
 369 sub breeder_home :Path("/breeders/home") Args(0) {
 370     my ($self , $c) = @_;
 371
 372
 373     if (!$c->user()) {
 374
 375         # redirect to login page
 376         $c->res->redirect( uri( path => '/solpeople/login.pl', query => { goto_url => $c->req->uri->path_query } ) );
 377         return;
 378     }
 379
 380     # my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 381     # my $bp = CXGN::BreedersToolbox::Projects->new( { schema=>$schema });
 382     # my $breeding_programs = $bp->get_breeding_programs();
 383
 384     # $c->stash->{programs} = $breeding_programs;
 385     # $c->stash->{breeding_programs} = $breeding_programs;
 386
 387     # # my $locations_by_breeding_program;
 388     # # foreach my $b (@$breeding_programs) {
 389     # #     $locations_by_breeding_program->{$b->[1]} = $bp->get_locations_by_breeding_program($b->[0]);
 390     # # }
 391     # # $locations_by_breeding_program->{'Other'} = $bp->get_locations_by_breeding_program();
 392
 393     # $c->stash->{locations_by_breeding_program} = ""; #$locations_by_breeding_program;
 394
 395     # # get roles
 396     # #
 397     # my @roles = $c->user->roles();
 398     # $c->stash->{roles}=\@roles;
 399
 400     # $c->stash->{cross_populations} = $self->get_crosses($c);
 401
 402     # $c->stash->{stockrelationships} = $self->get_stock_relationships($c);
 403
 404     # my $locations = $bp->get_locations($c);
 405
 406     # $c->stash->{locations} = $locations;
 407     # # get uploaded phenotype files
 408     # #
 409
 410     # my $data = $self->get_phenotyping_data($c);
 411
 412     # $c->stash->{phenotype_files} = $data->{file_info};
 413     # $c->stash->{deleted_phenotype_files} = $data->{deleted_file_info};
 414
 415
 416     $c->stash->{template} = '/breeders_toolbox/home.mas';
 417 }
 418
 419
 420 sub breeder_search : Path('/breeders/search/') :Args(0) {
 421     my ($self, $c) = @_;
 422
 423     $c->stash->{template} = '/breeders_toolbox/breeder_search_page.mas';
 424
 425 }
 426
 427
 428 sub get_crosses : Private {
 429     my $self = shift;
 430     my $c = shift;
 431
 432     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 433
 434     # get crosses
 435     #
 436     my $stock_type_cv = $schema->resultset("Cv::Cv")->find( {name=>'stock_type'});
 437     my $cross_cvterm = $schema->resultset("Cv::Cvterm")->find(
 438         { name   => 'cross',
 439           cv_id => $stock_type_cv->cv_id(),
 440         });
 441     my @cross_populations = ();
 442
 443     if ($cross_cvterm) {
 444
 445       my @cross_population_stocks = $schema->resultset("Stock::Stock")->search(
 446                                                                                { type_id => $cross_cvterm->cvterm_id, is_obsolete => 'f'
 447                                                                                } );
 448       foreach my $cross_pop (@cross_population_stocks) {
 449         push @cross_populations, [$cross_pop->name,$cross_pop->stock_id];
 450       }
 451     }
 452     return  \@cross_populations;
 453 }
 454
 455
 456
 457 sub get_phenotyping_data : Private {
 458     my $self = shift;
 459     my $c = shift;
 460
 461     my $metadata_schema = $c->dbic_schema("CXGN::Metadata::Schema");
 462
 463     my $file_info = [];
 464     my $deleted_file_info = [];
 465
 466      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' } );
 467
 468     print STDERR "RETRIEVED ".$metadata_rs->count()." METADATA ENTRIES...\n";
 469
 470     while (my $md_row = ($metadata_rs->next())) {
 471         my $file_rs = $metadata_schema->resultset("MdFiles")->search( { metadata_id => $md_row->metadata_id() } );
 472
 473         if (!$md_row->obsolete) {
 474             while (my $file_row = $file_rs->next()) {
 475                 push @$file_info, { file_id => $file_row->file_id(),
 476                                     basename => $file_row->basename,
 477                                     dirname  => $file_row->dirname,
 478                                     file_type => $file_row->filetype,
 479                                     md5checksum => $file_row->md5checksum,
 480                                     create_date => $md_row->create_date,
 481                 };
 482             }
 483         }
 484         else {
 485             while (my $file_row = $file_rs->next()) {
 486                 push @$deleted_file_info, { file_id => $file_row->file_id(),
 487                                             basename => $file_row->basename,
 488                                             dirname => $file_row->dirname,
 489                                             file_type => $file_row->filetype,
 490                                             md5checksum => $file_row->md5checksum,
 491                                             create_date => $md_row->create_date,
 492                 };
 493             }
 494         }
 495     }
 496
 497     my $data = { phenotype_files => $file_info,
 498                  deleted_phenotype_files => $deleted_file_info,
 499     };
 500     return $data;
 501
 502
 503 }
 504
 505 sub manage_genotyping : Path("/breeders/genotyping") Args(0) {
 506     my $self = shift;
 507     my $c = shift;
 508
 509     if (!$c->user()) {
 510         # redirect to login page
 511         $c->res->redirect( uri( path => '/solpeople/login.pl', query => { goto_url => $c->req->uri->path_query } ) );
 512         return;
 513     }
 514
 515     my $schema = $c->dbic_schema('Bio::Chado::Schema');
 516
 517     my $projects = CXGN::BreedersToolbox::Projects->new( { schema=> $schema } );
 518
 519     my $breeding_programs = $projects->get_breeding_programs();
 520
 521     my %genotyping_trials_by_breeding_project = ();
 522
 523     foreach my $bp (@$breeding_programs) {
 524         $genotyping_trials_by_breeding_project{$bp->[1]}= $projects->get_genotyping_trials_by_breeding_program($bp->[0]);
 525     }
 526
 527     $genotyping_trials_by_breeding_project{'Other'} = $projects->get_genotyping_trials_by_breeding_program();
 528
 529     $c->stash->{locations} = $projects->get_all_locations($c);
 530
 531     $c->stash->{genotyping_trials_by_breeding_project} = \%genotyping_trials_by_breeding_project;
 532
 533     $c->stash->{breeding_programs} = $breeding_programs;
 534
 535
 536     $c->stash->{template} = '/breeders_toolbox/manage_genotyping.mas';
 537 }
 538
 539
 540 1;