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 use CXGN::People::Roles;
  22 use CXGN::Trial::TrialLayout;
  23 use CXGN::Genotype::Search;
  24 use CXGN::Trial;
  25
  26
  27 BEGIN { extends 'Catalyst::Controller'; }
  28
  29 sub manage_breeding_programs : Path("/breeders/manage_programs") :Args(0) {
  30     my $self = shift;
  31     my $c = shift;
  32
  33     if (!$c->user()) {
  34
  35         # redirect to login page
  36         $c->res->redirect( uri( path => '/user/login', query => { goto_url => $c->req->uri->path_query } ) );
  37         return;
  38     }
  39
  40     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
  41
  42     my $projects = CXGN::BreedersToolbox::Projects->new( { schema=> $schema } );
  43
  44     my $breeding_programs = $projects->get_breeding_programs();
  45
  46     $c->stash->{breeding_programs} = $breeding_programs;
  47     $c->stash->{user} = $c->user();
  48
  49     $c->stash->{template} = '/breeders_toolbox/breeding_programs.mas';
  50
  51
  52 }
  53
  54 sub manage_trials : Path("/breeders/trials") Args(0) {
  55     my $self = shift;
  56     my $c = shift;
  57
  58     if (!$c->user()) {
  59
  60         # redirect to login page
  61         $c->res->redirect( uri( path => '/user/login', query => { goto_url => $c->req->uri->path_query } ) );
  62         return;
  63     }
  64
  65     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
  66
  67     my $projects = CXGN::BreedersToolbox::Projects->new( { schema=> $schema } );
  68
  69     my @editable_stock_props = split ',', $c->config->{editable_stock_props};
  70     my %editable_stock_props = map { $_=>1 } @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
  79     my $breeding_programs = $projects->get_breeding_programs();
  80     my @breeding_programs = @$breeding_programs;
  81     my @roles = $c->user->roles();
  82
  83     #Add true false field to breeding program array indicating whether program is linked to current user
  84     foreach my $role (@roles) {
  85         for (my $i=0; $i < scalar @breeding_programs; $i++) {
  86             if ($role eq $breeding_programs[$i][1]){
  87                 $breeding_programs[$i][3] = 1;
  88             } else {
  89                 $breeding_programs[$i][3] = 0;
  90             }
  91         }
  92     }
  93
  94     #print STDERR "Breeding programs are ".Dumper(@breeding_programs);
  95     my $field_management_factors = $c->config->{management_factor_types};
  96     my @management_factor_types = split ',',$field_management_factors;
  97
  98     my $design_type_string = $c->config->{design_types};
  99     my @design_types = split ',',$design_type_string;
 100
 101     $c->stash->{design_types} = \@design_types;
 102     $c->stash->{management_factor_types} = \@management_factor_types;
 103     $c->stash->{editable_stock_props} = \%editable_stock_props;
 104     $c->stash->{editable_stock_props_definitions} = \%def_hash;
 105     $c->stash->{preferred_species} = $c->config->{preferred_species};
 106     $c->stash->{timestamp} = localtime;
 107
 108     my $locations = $projects->get_all_locations_by_breeding_program();
 109
 110     #print STDERR "Locations are ".Dumper($locations)."\n";
 111
 112     $c->stash->{locations} = $locations;
 113
 114     $c->stash->{breeding_programs} = \@breeding_programs;
 115
 116     $c->stash->{template} = '/breeders_toolbox/manage_projects.mas';
 117 }
 118
 119 sub manage_accessions : Path("/breeders/accessions") Args(0) {
 120     my $self = shift;
 121     my $c = shift;
 122     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 123     my $list_id = $c->req->param('list_id') || ''; #If a list_id is given in the URL, then the add accessions process will automatically begin with that list.
 124
 125     if (!$c->user()) {
 126         # redirect to login page
 127         #
 128         $c->res->redirect( uri( path => '/user/login', query => { goto_url => $c->req->uri->path_query } ) );
 129         return;
 130     }
 131
 132     my $ac = CXGN::BreedersToolbox::Accessions->new( { schema=>$schema });
 133
 134     my $accessions = $ac->get_all_accessions($c);
 135     # my $populations = $ac->get_all_populations($c);
 136
 137     my @editable_stock_props = split ',', $c->config->{editable_stock_props};
 138     my %editable_stock_props = map { $_=>1 } @editable_stock_props;
 139
 140     my @editable_stock_props_definitions = split ',', $c->config->{editable_stock_props_definitions};
 141     my %def_hash;
 142     foreach (@editable_stock_props_definitions) {
 143         my @term_def = split ':', $_;
 144         $def_hash{$term_def[0]} = $term_def[1];
 145     }
 146
 147     $c->stash->{accessions} = $accessions;
 148     $c->stash->{list_id} = $list_id;
 149     #$c->stash->{population_groups} = $populations;
 150     $c->stash->{preferred_species} = $c->config->{preferred_species};
 151     $c->stash->{editable_stock_props} = \%editable_stock_props;
 152     $c->stash->{editable_stock_props_definitions} = \%def_hash;
 153     # $c->stash->{email_address} = $c->user->get_object->get_contact_email();
 154     $c->stash->{show_grafting_interface} = $c->config->{show_grafting_interface};
 155     $c->stash->{template} = '/breeders_toolbox/manage_accessions.mas';
 156 }
 157
 158 sub manage_roles : Path("/breeders/manage_roles") Args(0) {
 159     my $self = shift;
 160     my $c = shift;
 161
 162     if (!$c->user()) {
 163         $c->res->redirect( uri( path => '/user/login', query => { goto_url => $c->req->uri->path_query } ) );
 164         return;
 165     }
 166
 167     $c->stash->{is_curator} = $c->user->check_roles("curator");
 168
 169     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 170     my $person_roles = CXGN::People::Roles->new({ bcs_schema=>$schema });
 171     my $ascii_chars = 1;
 172     my $breeding_programs = $person_roles->get_breeding_program_roles($ascii_chars);
 173
 174     $c->stash->{roles} = $breeding_programs;
 175     $c->stash->{template} = '/breeders_toolbox/manage_roles.mas';
 176 }
 177
 178 sub manage_tissue_samples : Path("/breeders/samples") Args(0) {
 179     my $self = shift;
 180     my $c = shift;
 181
 182     if (!$c->user()) {
 183         $c->res->redirect( uri( path => '/user/login', query => { goto_url => $c->req->uri->path_query } ) );
 184         return;
 185     }
 186     my $genotyping_facilities = $c->config->{genotyping_facilities};
 187     my @facilities = split ',',$genotyping_facilities;
 188
 189     my $sampling_facilities = $c->config->{sampling_facilities};
 190     my @sampling_facilities = split ',',$sampling_facilities;
 191
 192     $c->stash->{facilities} = \@facilities;
 193     $c->stash->{sampling_facilities} = \@sampling_facilities;
 194     $c->stash->{user_id} = $c->user()->get_object()->get_sp_person_id();
 195     $c->stash->{template} = '/breeders_toolbox/manage_samples.mas';
 196 }
 197
 198
 199 sub manage_locations : Path("/breeders/locations") Args(0) {
 200     my $self = shift;
 201     my $c = shift;
 202
 203     if (!$c->user()) {
 204
 205         # redirect to login page
 206         #
 207         $c->res->redirect( uri( path => '/user/login', query => { goto_url => $c->req->uri->path_query } ) );
 208         return;
 209     }
 210
 211     $c->stash->{user_id} = $c->user()->get_object()->get_sp_person_id();
 212
 213     $c->stash->{template} = '/breeders_toolbox/manage_locations.mas';
 214 }
 215
 216 sub manage_nurseries : Path("/breeders/nurseries") Args(0) {
 217     my $self = shift;
 218     my $c = shift;
 219
 220     if (!$c->user()) {
 221
 222         # redirect to login page
 223         #
 224         $c->res->redirect( uri( path => '/user/login', query => { goto_url => $c->req->uri->path_query } ) );
 225         return;
 226     }
 227     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 228     my $bp = CXGN::BreedersToolbox::Projects->new( { schema=>$schema });
 229     my $breeding_programs = $bp->get_breeding_programs();
 230
 231     $c->stash->{user_id} = $c->user()->get_object()->get_sp_person_id();
 232
 233     $c->stash->{locations} = $bp->get_all_locations($c);
 234
 235     #$c->stash->{projects} = $self->get_projects($c);
 236
 237     $c->stash->{programs} = $breeding_programs;
 238
 239     $c->stash->{roles} = $c->user()->roles();
 240
 241     $c->stash->{nurseries} = $self->get_nurseries($c);
 242
 243     $c->stash->{template} = '/breeders_toolbox/manage_nurseries.mas';
 244
 245 }
 246
 247 sub manage_crosses : Path("/breeders/crosses") Args(0) {
 248     my $self = shift;
 249     my $c = shift;
 250
 251     if (!$c->user()) {
 252
 253         # redirect to login page
 254         #
 255         $c->res->redirect( uri( path => '/user/login', query => { goto_url => $c->req->uri->path_query } ) );
 256         return;
 257     }
 258     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 259     my $bp = CXGN::BreedersToolbox::Projects->new( { schema=>$schema });
 260     my $breeding_programs = $bp->get_breeding_programs();
 261
 262     my $crossingtrial = CXGN::BreedersToolbox::Projects->new( { schema=>$schema });
 263     my $crossing_trials = $crossingtrial->get_crossing_trials();
 264
 265     $c->stash->{user_id} = $c->user()->get_object()->get_sp_person_id();
 266
 267
 268     my @breeding_programs = @$breeding_programs;
 269     my @roles = $c->user->roles();
 270
 271     foreach my $role (@roles) {
 272         for (my $i=0; $i < scalar @breeding_programs; $i++) {
 273             if ($role eq $breeding_programs[$i][1]){
 274                 $breeding_programs[$i][3] = 1;
 275             } else {
 276                 $breeding_programs[$i][3] = 0;
 277             }
 278         }
 279     }
 280
 281     my $locations = $crossingtrial->get_all_locations_by_breeding_program();
 282
 283     my $odk_service = $c->config->{odk_crossing_data_service_name};
 284
 285     $c->stash->{odk_service} = $odk_service;
 286
 287     $c->stash->{locations} = $locations;
 288
 289     $c->stash->{programs} = \@breeding_programs;
 290
 291     $c->stash->{crossing_trials} = $crossing_trials;
 292
 293     $c->stash->{roles} = $c->user()->roles();
 294
 295     $c->stash->{template} = '/breeders_toolbox/manage_crosses.mas';
 296
 297 }
 298
 299 sub manage_phenotyping :Path("/breeders/phenotyping") Args(0) {
 300     my $self =shift;
 301     my $c = shift;
 302
 303     if (!$c->user()) {
 304         $c->res->redirect( uri( path => '/user/login', query => { goto_url => $c->req->uri->path_query } ) );
 305         return;
 306     }
 307
 308     my @file_types = ( 'spreadsheet phenotype file', 'direct phenotyping', 'trial_additional_file_upload', 'brapi observations', 'tablet phenotype file' );
 309     my $data = $self->get_file_data($c, \@file_types);
 310
 311     $c->stash->{phenotype_files} = $data->{files};
 312     $c->stash->{deleted_phenotype_files} = $data->{deleted_files};
 313
 314     $c->stash->{template} = '/breeders_toolbox/manage_phenotyping.mas';
 315
 316 }
 317
 318 sub manage_nirs :Path("/breeders/nirs") Args(0) {
 319     my $self =shift;
 320     my $c = shift;
 321
 322     if (!$c->user()) {
 323         $c->res->redirect( uri( path => '/user/login', query => { goto_url => $c->req->uri->path_query } ) );
 324         return;
 325     }
 326
 327     my @file_types = ( 'nirs spreadsheet' );
 328     my $all_data = $self->get_file_data($c, \@file_types, 1);
 329     my $data = $self->get_file_data($c, \@file_types, 0);
 330
 331     my $sampling_facilities = $c->config->{sampling_facilities};
 332     my @sampling_facilities = split ',',$sampling_facilities;
 333
 334     $c->stash->{sampling_facilities} = \@sampling_facilities;
 335     $c->stash->{nirs_files} = $data->{files};
 336     $c->stash->{deleted_nirs_files} = $data->{deleted_files};
 337     $c->stash->{all_nirs_files} = $all_data->{files};
 338     $c->stash->{all_deleted_nirs_files} = $all_data->{deleted_files};
 339
 340     $c->stash->{template} = '/breeders_toolbox/manage_nirs.mas';
 341
 342 }
 343
 344 sub manage_upload :Path("/breeders/upload") Args(0) {
 345     my $self =shift;
 346     my $c = shift;
 347     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 348
 349     if (!$c->user()) {
 350         $c->res->redirect( uri( path => '/user/login', query => { goto_url => $c->req->uri->path_query } ) );
 351         return;
 352     }
 353
 354     my @editable_stock_props = split ',', $c->config->{editable_stock_props};
 355     my %editable_stock_props = map { $_=>1 } @editable_stock_props;
 356
 357     my @editable_stock_props_definitions = split ',', $c->config->{editable_stock_props_definitions};
 358     my %def_hash;
 359     foreach (@editable_stock_props_definitions) {
 360         my @term_def = split ':', $_;
 361         $def_hash{$term_def[0]} = $term_def[1];
 362     }
 363
 364     my $projects = CXGN::BreedersToolbox::Projects->new( { schema=> $schema } );
 365     my $breeding_programs = $projects->get_breeding_programs();
 366
 367     my $genotyping_facilities = $c->config->{genotyping_facilities};
 368     my @facilities = split ',',$genotyping_facilities;
 369
 370     my $field_management_factors = $c->config->{management_factor_types};
 371     my @management_factor_types = split ',',$field_management_factors;
 372
 373     my $design_type_string = $c->config->{design_types};
 374     my @design_types = split ',',$design_type_string;
 375
 376     $c->stash->{editable_stock_props} = \%editable_stock_props;
 377     $c->stash->{editable_stock_props_definitions} = \%def_hash;
 378     $c->stash->{design_types} = \@design_types;
 379     $c->stash->{management_factor_types} = \@management_factor_types;
 380     $c->stash->{facilities} = \@facilities;
 381     $c->stash->{geojson_locations} = $projects->get_all_locations_by_breeding_program();
 382     $c->stash->{locations} = $projects->get_all_locations();
 383     $c->stash->{breeding_programs} = $breeding_programs;
 384     $c->stash->{timestamp} = localtime;
 385     $c->stash->{preferred_species} = $c->config->{preferred_species};
 386     $c->stash->{template} = '/breeders_toolbox/manage_upload.mas';
 387 }
 388
 389 sub manage_file_share_dump :Path("/breeders/file_share_dump") Args(0) {
 390     my $self =shift;
 391     my $c = shift;
 392     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 393
 394     if (!$c->user()) {
 395         $c->res->redirect( uri( path => '/user/login', query => { goto_url => $c->req->uri->path_query } ) );
 396         return;
 397     }
 398
 399     $c->stash->{template} = '/breeders_toolbox/file_share/manage_file_share_dump.mas';
 400 }
 401
 402 sub manage_plot_phenotyping :Path("/breeders/plot_phenotyping") Args(0) {
 403     my $self =shift;
 404     my $c = shift;
 405     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 406     my $stock_id = $c->req->param('stock_id');
 407
 408     if (!$c->user()) {
 409              $c->res->redirect( uri( path => '/user/login', query => { goto_url => $c->req->uri->path_query } ) );
 410               return;
 411     }
 412     my $stock = $schema->resultset("Stock::Stock")->find( { stock_id=>$stock_id })->uniquename();
 413
 414     $c->stash->{plot_name} = $stock;
 415     $c->stash->{stock_id} = $stock_id;
 416     $c->stash->{template} = '/breeders_toolbox/manage_plot_phenotyping.mas';
 417
 418 }
 419
 420 sub manage_trial_phenotyping :Path("/breeders/trial_phenotyping") Args(0) {
 421     my $self =shift;
 422     my $c = shift;
 423     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 424     my $trial_id = $c->req->param('trial_id');
 425
 426     if (!$c->user()) {
 427              $c->res->redirect( uri( path => '/user/login', query => { goto_url => $c->req->uri->path_query } ) );
 428               return;
 429     }
 430     my $project_name = $schema->resultset("Project::Project")->find( { project_id=>$trial_id })->name();
 431
 432     my $trial = CXGN::Trial->new({ bcs_schema => $schema, trial_id => $trial_id });
 433
 434     $c->stash->{trial_stock_type} = $trial->get_trial_stock_type();
 435     $c->stash->{trial_name} = $project_name;
 436     $c->stash->{trial_id} = $trial_id;
 437     $c->stash->{template} = '/breeders_toolbox/manage_trial_phenotyping.mas';
 438 }
 439
 440 sub manage_odk_data_collection :Path("/breeders/odk") Args(0) {
 441     my $self =shift;
 442     my $c = shift;
 443     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 444
 445     if (!$c->user()) {
 446         $c->res->redirect( uri( path => '/user/login', query => { goto_url => $c->req->uri->path_query } ) );
 447         return;
 448     }
 449     $c->stash->{odk_crossing_data_service_name} = $c->config->{odk_crossing_data_service_name};
 450     $c->stash->{odk_crossing_data_service_url} = $c->config->{odk_crossing_data_service_url};
 451     $c->stash->{odk_crossing_data_test_form_name} = $c->config->{odk_crossing_data_test_form_name};
 452     $c->stash->{odk_phenotyping_data_service_name} = $c->config->{odk_phenotyping_data_service_name};
 453     $c->stash->{odk_phenotyping_data_service_url} = $c->config->{odk_phenotyping_data_service_url};
 454     $c->stash->{template} = '/breeders_toolbox/manage_odk_data_collection.mas';
 455 }
 456
 457
 458 sub manage_identifier_generation :Path("/breeders/identifier_generation") Args(0) {
 459     my $self =shift;
 460     my $c = shift;
 461     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 462
 463     if (!$c->user()) {
 464         $c->res->redirect( uri( path => '/user/login', query => { goto_url => $c->req->uri->path_query } ) );
 465         return;
 466     }
 467     $c->stash->{template} = '/breeders_toolbox/identifier_generation/manage_identifier_generation.mas';
 468 }
 469
 470
 471 sub manage_phenotyping_download : Path("/breeders/phenotyping/download") Args(1) {
 472     my $self =shift;
 473     my $c = shift;
 474     my $file_id = shift;
 475
 476     my $metadata_schema = $c->dbic_schema('CXGN::Metadata::Schema');
 477     my $file_row = $metadata_schema->resultset("MdFiles")->find({file_id => $file_id});
 478     my $file_destination =  catfile($file_row->dirname, $file_row->basename);
 479     #print STDERR "\n\n\nfile name:".$file_row->basename."\n";
 480     my $contents = read_file($file_destination);
 481     my $file_name = $file_row->basename;
 482     $c->res->content_type('Application/trt');
 483     $c->res->header('Content-Disposition', qq[attachment; filename="$file_name"]);
 484     $c->res->body($contents);
 485 }
 486
 487 sub manage_phenotyping_view : Path("/breeders/phenotyping/view") Args(1) {
 488     my $self =shift;
 489     my $c = shift;
 490     my $file_id = shift;
 491
 492     my $metadata_schema = $c->dbic_schema('CXGN::Metadata::Schema');
 493     my $file_row = $metadata_schema->resultset("MdFiles")->find({file_id => $file_id});
 494     my $file_destination =  catfile($file_row->dirname, $file_row->basename);
 495     #print STDERR "\n\n\nfile name:".$file_row->basename."\n";
 496     my @contents = ReadData ($file_destination);
 497     #print STDERR Dumper \@contents;
 498     my $file_name = $file_row->basename;
 499     $c->stash->{file_content} = \@contents;
 500     $c->stash->{filename} = $file_name;
 501     $c->stash->{template} = '/breeders_toolbox/view_file.mas';
 502 }
 503
 504
 505 sub make_cross_form :Path("/stock/cross/new") :Args(0) {
 506     my ($self, $c) = @_;
 507     $c->stash->{template} = '/breeders_toolbox/new_cross.mas';
 508     if ($c->user()) {
 509       my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 510       # get projects
 511       my @rows = $schema->resultset('Project::Project')->all();
 512       my @projects = ();
 513       foreach my $row (@rows) {
 514         push @projects, [ $row->project_id, $row->name, $row->description ];
 515       }
 516       $c->stash->{project_list} = \@projects;
 517       @rows = $schema->resultset('NaturalDiversity::NdGeolocation')->all();
 518       my @locations = ();
 519       foreach my $row (@rows) {
 520         push @locations,  [ $row->nd_geolocation_id,$row->description ];
 521       }
 522       $c->stash->{locations} = \@locations;
 523
 524     }
 525     else {
 526       $c->res->redirect( uri( path => '/user/login', query => { goto_url => $c->req->uri->path_query } ) );
 527       return;
 528     }
 529 }
 530
 531
 532 sub make_cross :Path("/stock/cross/generate") :Args(0) {
 533     my ($self, $c) = @_;
 534     $c->stash->{template} = '/breeders_toolbox/progeny_from_crosses.mas';
 535     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 536     my $cross_name = $c->req->param('cross_name');
 537     $c->stash->{cross_name} = $cross_name;
 538     my $trial_id = $c->req->param('trial_id');
 539     $c->stash->{trial_id} = $trial_id;
 540     #my $location = $c->req->param('location_id');
 541     my $maternal = $c->req->param('maternal');
 542     my $paternal = $c->req->param('paternal');
 543     my $prefix = $c->req->param('prefix');
 544     my $suffix = $c->req->param('suffix');
 545     my $progeny_number = $c->req->param('progeny_number');
 546     my $visible_to_role = $c->req->param('visible_to_role');
 547
 548     if (! $c->user()) { # redirect
 549         $c->res->redirect( uri( path => '/user/login', query => { goto_url => $c->req->uri->path_query } ) );
 550         return;
 551     }
 552
 553
 554     #check that progeny number is an integer less than maximum allowed
 555     my $maximum_progeny_number = 1000;
 556     if ((! $progeny_number =~ m/^\d+$/) or ($progeny_number > $maximum_progeny_number)){
 557       #redirect to error page?
 558       return;
 559     }
 560
 561     #check that parent names are not blank
 562     if ($maternal eq "" or $paternal eq "") {
 563       return;
 564     }
 565
 566     #check that parents exist in the database
 567     if (! $schema->resultset("Stock::Stock")->find({name=>$maternal,})){
 568       return;
 569     }
 570     if (! $schema->resultset("Stock::Stock")->find({name=>$paternal,})){
 571       return;
 572     }
 573
 574     #check that cross name does not already exist
 575     if ($schema->resultset("Stock::Stock")->find({name=>$cross_name})){
 576       return;
 577     }
 578
 579     #check that progeny do not already exist
 580     if ($schema->resultset("Stock::Stock")->find({name=>$prefix.$cross_name.$suffix."-1",})){
 581       return;
 582     }
 583
 584     my $organism = $schema->resultset("Organism::Organism")->find_or_create(
 585     {
 586         genus   => 'Manihot',
 587         species => 'Manihot esculenta',
 588     } );
 589     my $organism_id = $organism->organism_id();
 590
 591     my $accession_cvterm = SGN::Model::Cvterm->get_cvterm_row($schema, 'accession', 'stock_type');
 592
 593     my $population_cvterm = $schema->resultset("Cv::Cvterm")->find(
 594       { name   => 'population',
 595     });
 596
 597
 598     my $female_parent_stock = $schema->resultset("Stock::Stock")->find(
 599         { name       => $maternal,
 600         } );
 601
 602     my $male_parent_stock = $schema->resultset("Stock::Stock")->find(
 603             { name       => $paternal,
 604             } );
 605
 606     my $population_stock = $schema->resultset("Stock::Stock")->find_or_create(
 607             { organism_id => $organism_id,
 608               name       => $cross_name,
 609               uniquename => $cross_name,
 610               type_id => $population_cvterm->cvterm_id,
 611             } );
 612       my $female_parent =  SGN::Model::Cvterm->get_cvterm_row($schema, 'female_parent',  'stock_relationship');
 613
 614       my $male_parent =  SGN::Model::Cvterm->get_cvterm_row($schema, 'male_parent', 'stock_relationship');
 615
 616
 617       my $population_members =  SGN::Model::Cvterm->get_cvterm_row($schema,  'cross_relationship','stock_relationship');
 618
 619
 620     my $visible_to_role_cvterm =  SGN::Model::Cvterm->get_cvterm_row($schema,  'visible_to_role', 'local');
 621
 622     my $increment = 1;
 623     while ($increment < $progeny_number + 1) {
 624         $increment = sprintf "%03d", $increment;
 625         my $stock_name = $prefix.$cross_name."_".$increment.$suffix;
 626       my $accession_stock = $schema->resultset("Stock::Stock")->create(
 627             { organism_id => $organism_id,
 628               name       => $stock_name,
 629               uniquename => $stock_name,
 630               type_id     => $accession_cvterm->cvterm_id,
 631             } );
 632       $accession_stock->find_or_create_related('stock_relationship_objects', {
 633                 type_id => $female_parent->cvterm_id(),
 634                 object_id => $accession_stock->stock_id(),
 635                 subject_id => $female_parent_stock->stock_id(),
 636                                                   } );
 637       $accession_stock->find_or_create_related('stock_relationship_objects', {
 638                 type_id => $male_parent->cvterm_id(),
 639                 object_id => $accession_stock->stock_id(),
 640                 subject_id => $male_parent_stock->stock_id(),
 641                                                   } );
 642       $accession_stock->find_or_create_related('stock_relationship_objects', {
 643                 type_id => $population_members->cvterm_id(),
 644                 object_id => $accession_stock->stock_id(),
 645                 subject_id => $population_stock->stock_id(),
 646                                                   } );
 647       if ($visible_to_role ne "") {
 648         my $accession_stock_prop = $schema->resultset("Stock::Stockprop")->find_or_create(
 649                { type_id =>$visible_to_role_cvterm->cvterm_id(),
 650                  value => $visible_to_role,
 651                  stock_id => $accession_stock->stock_id()
 652                  });
 653       }
 654       $increment++;
 655
 656     }
 657     if ($@) {
 658     }
 659 }
 660
 661 sub selection_index : Path("/selection/index") :Args(0) {
 662     my $self = shift;
 663     my $c = shift;
 664
 665     if (!$c->user()) {
 666
 667         # redirect to login page
 668         $c->res->redirect( uri( path => '/user/login', query => { goto_url => $c->req->uri->path_query } ) );
 669         return;
 670     }
 671
 672 #    my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 673
 674   #  my $projects = CXGN::BreedersToolbox::Projects->new( { schema=> $schema } );
 675
 676 #    my $breeding_programs = $projects->get_breeding_programs();
 677
 678   #  $c->stash->{breeding_programs} = $breeding_programs;
 679     $c->stash->{user} = $c->user();
 680
 681     $c->stash->{template} = '/breeders_toolbox/selection_index.mas';
 682
 683
 684 }
 685
 686
 687 sub breeder_home :Path("/breeders/home") Args(0) {
 688     my ($self , $c) = @_;
 689
 690
 691     if (!$c->user()) {
 692
 693         # redirect to login page
 694         $c->res->redirect( uri( path => '/user/login', query => { goto_url => $c->req->uri->path_query } ) );
 695         return;
 696     }
 697
 698     # my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 699     # my $bp = CXGN::BreedersToolbox::Projects->new( { schema=>$schema });
 700     # my $breeding_programs = $bp->get_breeding_programs();
 701
 702     # $c->stash->{programs} = $breeding_programs;
 703     # $c->stash->{breeding_programs} = $breeding_programs;
 704
 705     # # my $locations_by_breeding_program;
 706     # # foreach my $b (@$breeding_programs) {
 707     # #     $locations_by_breeding_program->{$b->[1]} = $bp->get_locations_by_breeding_program($b->[0]);
 708     # # }
 709     # # $locations_by_breeding_program->{'Other'} = $bp->get_locations_by_breeding_program();
 710
 711     # $c->stash->{locations_by_breeding_program} = ""; #$locations_by_breeding_program;
 712
 713     # # get roles
 714     # #
 715     # my @roles = $c->user->roles();
 716     # $c->stash->{roles}=\@roles;
 717
 718     # $c->stash->{stockrelationships} = $self->get_stock_relationships($c);
 719
 720     # my $locations = $bp->get_locations($c);
 721
 722     # $c->stash->{locations} = $locations;
 723     # # get uploaded phenotype files
 724     # #
 725
 726     # my $data = $self->get_file_data($c, \@file_types);
 727
 728     # $c->stash->{phenotype_files} = $data->{file_info};
 729     # $c->stash->{deleted_phenotype_files} = $data->{deleted_file_info};
 730
 731
 732     $c->stash->{template} = '/breeders_toolbox/home.mas';
 733 }
 734
 735 sub breeder_search : Path('/breeders/search/') :Args(0) {
 736     my ($self, $c) = @_;
 737
 738     if (!$c->user()) {
 739         $c->res->redirect( uri( path => '/user/login', query => { goto_url => $c->req->uri->path_query } ) );
 740         return;
 741     }
 742
 743     $c->stash->{dataset_id} = $c->req->param('dataset_id');
 744     $c->stash->{template} = '/breeders_toolbox/breeder_search_page.mas';
 745
 746 }
 747 sub get_file_data : Private {
 748     my $self = shift;
 749     my $c = shift;
 750     my $file_types = shift;
 751     my $get_files_for_all_users = shift;
 752     my $file_type_string = "'".join("','", @$file_types)."'";
 753
 754     my $metadata_schema = $c->dbic_schema("CXGN::Metadata::Schema");
 755
 756     my $file_info = [];
 757     my $deleted_file_info = [];
 758
 759     my $where_string = '';
 760     if (!$get_files_for_all_users) {
 761         $where_string = ' AND md.create_person_id = '.$c->user()->get_object->get_sp_person_id();
 762     }
 763
 764     my $q = "SELECT mdf.file_id, mdf.basename, mdf.dirname, mdf.filetype, mdf.md5checksum, md.create_date, md.obsolete
 765         FROM metadata.md_files AS mdf
 766         JOIN metadata.md_metadata AS md ON (mdf.metadata_id = md.metadata_id)
 767         WHERE mdf.filetype IN ($file_type_string) $where_string;";
 768     print STDERR $q."\n";
 769     my $h = $c->dbc->dbh->prepare($q);
 770     $h->execute();
 771     while (my ($file_id, $basename, $dirname, $filetype, $md5, $create_date, $obsolete) = $h->fetchrow_array()) {
 772         if (!$obsolete) {
 773             push @$file_info, {
 774                 file_id => $file_id,
 775                 basename => $basename,
 776                 dirname  => $dirname,
 777                 file_type => $filetype,
 778                 md5checksum => $md5,
 779                 create_date => $create_date
 780             };
 781         }
 782         else {
 783             push @$deleted_file_info, {
 784                 file_id => $file_id,
 785                 basename => $basename,
 786                 dirname  => $dirname,
 787                 file_type => $filetype,
 788                 md5checksum => $md5,
 789                 create_date => $create_date
 790             };
 791         }
 792     }
 793
 794     my $data = {
 795         files => $file_info,
 796         deleted_files => $deleted_file_info
 797     };
 798     return $data;
 799 }
 800
 801
 802 sub manage_genotyping : Path("/breeders/genotyping") Args(0) {
 803     my $self = shift;
 804     my $c = shift;
 805
 806     if (!$c->user()) {
 807         # redirect to login page
 808         $c->res->redirect( uri( path => '/user/login', query => { goto_url => $c->req->uri->path_query } ) );
 809         return;
 810     }
 811
 812     my $schema = $c->dbic_schema('Bio::Chado::Schema');
 813
 814     my $projects = CXGN::BreedersToolbox::Projects->new( { schema=> $schema } );
 815
 816     my $breeding_programs = $projects->get_breeding_programs();
 817
 818     my %genotyping_trials_by_breeding_project = ();
 819
 820     foreach my $bp (@$breeding_programs) {
 821         $genotyping_trials_by_breeding_project{$bp->[1]}= $projects->get_genotyping_trials_by_breeding_program($bp->[0]);
 822     }
 823
 824     $genotyping_trials_by_breeding_project{'Other'} = $projects->get_genotyping_trials_by_breeding_program();
 825
 826     my $genotyping_facilities = $c->config->{genotyping_facilities};
 827     my @facilities = split ',',$genotyping_facilities;
 828
 829     $c->stash->{locations} = $projects->get_all_locations($c);
 830
 831     $c->stash->{genotyping_trials_by_breeding_project} = \%genotyping_trials_by_breeding_project;
 832
 833     $c->stash->{breeding_programs} = $breeding_programs;
 834
 835     $c->stash->{facilities} = \@facilities;
 836
 837     $c->stash->{template} = '/breeders_toolbox/manage_genotyping.mas';
 838 }
 839
 840 sub manage_genotype_qc : Path("/breeders/genotype_qc") :Args(0) {
 841     my $self = shift;
 842     my $c = shift;
 843
 844     if (!$c->user()) {
 845         # redirect to login page
 846         $c->res->redirect( uri( path => '/user/login', query => { goto_url => $c->req->uri->path_query } ) );
 847         return;
 848     }
 849
 850     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 851
 852     $c->stash->{template} = '/breeders_toolbox/manage_genotype_qc.mas';
 853 }
 854
 855
 856 sub manage_markers : Path("/breeders/markers") Args(0) {
 857     my $self = shift;
 858     my $c = shift;
 859
 860     if (!$c->user()) {
 861         # redirect to login page
 862         $c->res->redirect( uri( path => '/user/login', query => { goto_url => $c->req->uri->path_query } ) );
 863         return;
 864     }
 865
 866     $c->stash->{template} = '/breeders_toolbox/markers/manage_markers.mas';
 867 }
 868
 869 sub manage_drone_imagery : Path("/breeders/drone_imagery") Args(0) {
 870     my $self = shift;
 871     my $c = shift;
 872
 873     if (!$c->user()) {
 874         # redirect to login page
 875         $c->res->redirect( uri( path => '/user/login', query => { goto_url => $c->req->uri->path_query } ) );
 876         return;
 877     }
 878
 879     my $schema = $c->dbic_schema('Bio::Chado::Schema');
 880     $c->stash->{template} = '/breeders_toolbox/manage_drone_imagery.mas';
 881 }
 882
 883
 884 sub manage_genotyping_projects : Path("/breeders/genotyping_projects") Args(0) {
 885     my $self = shift;
 886     my $c = shift;
 887
 888     if (!$c->user()) {
 889         $c->res->redirect( uri( path => '/user/login', query => { goto_url => $c->req->uri->path_query } ) );
 890         return;
 891     }
 892     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 893     my $projects = CXGN::BreedersToolbox::Projects->new( { schema=>$schema });
 894     my $breeding_programs = $projects->get_breeding_programs();
 895
 896     my @breeding_programs = @$breeding_programs;
 897     my @roles = $c->user->roles();
 898
 899     foreach my $role (@roles) {
 900         for (my $i=0; $i < scalar @breeding_programs; $i++) {
 901             if ($role eq $breeding_programs[$i][1]){
 902                 $breeding_programs[$i][3] = 1;
 903             } else {
 904                 $breeding_programs[$i][3] = 0;
 905             }
 906         }
 907     }
 908
 909     my $locations = $projects->get_all_locations_by_breeding_program();
 910
 911     my $genotyping_facilities = $c->config->{genotyping_facilities};
 912     my @facilities = split ',',$genotyping_facilities;
 913
 914     $c->stash->{facilities} = \@facilities;
 915
 916     $c->stash->{locations} = $locations;
 917
 918     $c->stash->{programs} = \@breeding_programs;
 919
 920
 921     $c->stash->{template} = '/breeders_toolbox/genotyping_data_project/manage_genotyping_projects.mas';
 922
 923 }
 924
 925 sub manage_transformations : Path("/breeders/transformations") Args(0) {
 926     my $self = shift;
 927     my $c = shift;
 928
 929     if (!$c->user()) {
 930
 931         # redirect to login page
 932         #
 933         $c->res->redirect( uri( path => '/user/login', query => { goto_url => $c->req->uri->path_query } ) );
 934         return;
 935     }
 936     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 937     my $bp = CXGN::BreedersToolbox::Projects->new({ schema=>$schema });
 938     my $breeding_programs = $bp->get_breeding_programs();
 939
 940
 941     $c->stash->{user_id} = $c->user()->get_object()->get_sp_person_id();
 942
 943     my $transformation = CXGN::BreedersToolbox::Projects->new({ schema=>$schema });
 944
 945     my @breeding_programs = @$breeding_programs;
 946     my @roles = $c->user->roles();
 947
 948     foreach my $role (@roles) {
 949         for (my $i=0; $i < scalar @breeding_programs; $i++) {
 950             if ($role eq $breeding_programs[$i][1]){
 951                 $breeding_programs[$i][3] = 1;
 952             } else {
 953                 $breeding_programs[$i][3] = 0;
 954             }
 955         }
 956     }
 957
 958     my $locations = $transformation->get_all_locations_by_breeding_program();
 959
 960     $c->stash->{locations} = $locations;
 961
 962     $c->stash->{programs} = \@breeding_programs;
 963
 964     $c->stash->{roles} = $c->user()->roles();
 965
 966     $c->stash->{template} = '/transformation/manage_transformation.mas';
 967
 968 }
 969
 970
 971
 972 sub manage_activities : Path("/breeders/activities") Args(0) {
 973     my $self = shift;
 974     my $c = shift;
 975     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 976
 977     if (!$c->user()) {
 978         $c->res->redirect( uri( path => '/user/login', query => { goto_url => $c->req->uri->path_query } ) );
 979         return;
 980     }
 981     $c->stash->{user_id} = $c->user()->get_object()->get_sp_person_id();
 982
 983     my $activity_project = CXGN::BreedersToolbox::Projects->new( { schema=>$schema });
 984     my $breeding_programs = $activity_project->get_breeding_programs();
 985     my @breeding_programs = @$breeding_programs;
 986     my $locations = $activity_project->get_all_locations_by_breeding_program();
 987
 988     my @roles = $c->user->roles();
 989
 990     foreach my $role (@roles) {
 991         for (my $i=0; $i < scalar @breeding_programs; $i++) {
 992             if ($role eq $breeding_programs[$i][1]){
 993                 $breeding_programs[$i][3] = 1;
 994             } else {
 995                 $breeding_programs[$i][3] = 0;
 996             }
 997         }
 998     }
 999
1000     $c->stash->{locations} = $locations;
1001     $c->stash->{programs} = \@breeding_programs;
1002     $c->stash->{roles} = $c->user()->roles();
1003     $c->stash->{template} = '/tracking_activities/manage_activities.mas';
1004
1005 }
1006
1007
1008
1009 1;