lib/SGN/Controller/AJAX/TrialMetadata.pm

   1 package SGN::Controller::AJAX::TrialMetadata;
   2
   3 use Moose;
   4 use Data::Dumper;
   5 use List::Util 'max';
   6 use Bio::Chado::Schema;
   7 use List::Util qw | any |;
   8 use CXGN::Trial;
   9 use Math::Round::Var;
  10 use List::MoreUtils qw(uniq);
  11 use CXGN::Trial::FieldMap;
  12 use JSON;
  13 use CXGN::Phenotypes::PhenotypeMatrix;
  14 use CXGN::Login;
  15 use CXGN::UploadFile;
  16 use CXGN::Stock::Seedlot;
  17 use CXGN::Stock::Seedlot::Transaction;
  18
  19 BEGIN { extends 'Catalyst::Controller::REST' }
  20
  21 __PACKAGE__->config(
  22     default   => 'application/json',
  23     stash_key => 'rest',
  24     map       => { 'application/json' => 'JSON', 'text/html' => 'JSON' },
  25    );
  26
  27 has 'schema' => (
  28                  is       => 'rw',
  29                  isa      => 'DBIx::Class::Schema',
  30                  lazy_build => 1,
  31                 );
  32
  33
  34 sub trial : Chained('/') PathPart('ajax/breeders/trial') CaptureArgs(1) {
  35     my $self = shift;
  36     my $c = shift;
  37     my $trial_id = shift;
  38
  39     $c->stash->{trial_id} = $trial_id;
  40     $c->stash->{schema} =  $c->dbic_schema("Bio::Chado::Schema");
  41     $c->stash->{trial} = CXGN::Trial->new( { bcs_schema => $c->stash->{schema}, trial_id => $trial_id });
  42
  43     if (!$c->stash->{trial}) {
  44         $c->stash->{rest} = { error => "The specified trial with id $trial_id does not exist" };
  45         return;
  46     }
  47
  48 }
  49
  50 =head2 delete_trial_by_file
  51  Usage:
  52  Desc:
  53  Ret:
  54  Args:
  55  Side Effects:
  56  Example:
  57 =cut
  58
  59 sub delete_trial_data : Local() ActionClass('REST');
  60
  61 sub delete_trial_data_GET : Chained('trial') PathPart('delete') Args(1) {
  62     my $self = shift;
  63     my $c = shift;
  64     my $datatype = shift;
  65
  66     if ($self->privileges_denied($c)) {
  67         $c->stash->{rest} = { error => "You have insufficient access privileges to delete trial data." };
  68         return;
  69     }
  70
  71     my $error = "";
  72
  73     if ($datatype eq 'phenotypes') {
  74         $error = $c->stash->{trial}->delete_phenotype_metadata($c->dbic_schema("CXGN::Metadata::Schema"), $c->dbic_schema("CXGN::Phenome::Schema"));
  75         $error .= $c->stash->{trial}->delete_phenotype_data();
  76     }
  77
  78     elsif ($datatype eq 'layout') {
  79         $error = $c->stash->{trial}->delete_metadata($c->dbic_schema("CXGN::Metadata::Schema"), $c->dbic_schema("CXGN::Phenome::Schema"));
  80         $error = $c->stash->{trial}->delete_field_layout();
  81     }
  82     elsif ($datatype eq 'entry') {
  83         $error = $c->stash->{trial}->delete_project_entry();
  84     }
  85     else {
  86         $c->stash->{rest} = { error => "unknown delete action for $datatype" };
  87         return;
  88     }
  89     if ($error) {
  90         $c->stash->{rest} = { error => $error };
  91         return;
  92     }
  93     $c->stash->{rest} = { message => "Successfully deleted trial data.", success => 1 };
  94 }
  95
  96 sub trial_phenotypes_fully_uploaded : Chained('trial') PathPart('phenotypes_fully_uploaded') Args(0) ActionClass('REST') {};
  97
  98 sub trial_phenotypes_fully_uploaded_GET   {
  99     my $self = shift;
 100     my $c = shift;
 101     my $trial = $c->stash->{trial};
 102     $c->stash->{rest} = { phenotypes_fully_uploaded => $trial->get_phenotypes_fully_uploaded() };
 103 }
 104
 105 sub trial_phenotypes_fully_uploaded_POST  {
 106     my $self = shift;
 107     my $c = shift;
 108     my $value = $c->req->param("phenotypes_fully_uploaded");
 109     my $trial = $c->stash->{trial};
 110     eval {
 111         $trial->set_phenotypes_fully_uploaded($value);
 112     };
 113     if ($@) {
 114         $c->stash->{rest} = { error => "An error occurred setting phenotypes_fully_uploaded: $@" };
 115     }
 116     else {
 117         $c->stash->{rest} = { success => 1 };
 118     }
 119 }
 120
 121 sub trial_details : Chained('trial') PathPart('details') Args(0) ActionClass('REST') {};
 122
 123 sub trial_details_GET   {
 124     my $self = shift;
 125     my $c = shift;
 126
 127     my $trial = $c->stash->{trial};
 128
 129     $c->stash->{rest} = { details => $trial->get_details() };
 130
 131 }
 132
 133 sub trial_details_POST  {
 134     my $self = shift;
 135     my $c = shift;
 136
 137     my @categories = $c->req->param("categories[]");
 138
 139     my $details = {};
 140     foreach my $category (@categories) {
 141       $details->{$category} = $c->req->param("details[$category]");
 142     }
 143
 144     if (!%{$details}) {
 145       $c->stash->{rest} = { error => "No values were edited, so no changes could be made for this trial's details." };
 146       return;
 147     }
 148     else {
 149     print STDERR "Here are the deets: " . Dumper($details) . "\n";
 150     }
 151
 152     #check privileges
 153     print STDERR " curator status = ".$c->user()->check_roles('curator')." and submitter status = ".$c->user()->check_roles('submitter')."\n";
 154     if (!($c->user()->check_roles('curator') || $c->user()->check_roles('submitter'))) {
 155       $c->stash->{rest} = { error => 'You do not have the required privileges to edit trial details, trial details can only be edited by accounts with submitter or curator privileges' };
 156       return;
 157     }
 158
 159     my $trial_id = $c->stash->{trial_id};
 160     my $trial = $c->stash->{trial};
 161     my $program_object = CXGN::BreedersToolbox::Projects->new( { schema => $c->stash->{schema} });
 162     my $program_ref = $program_object->get_breeding_programs_by_trial($trial_id);
 163
 164     my $program_array = @$program_ref[0];
 165     my $breeding_program_name = @$program_array[1];
 166     my @user_roles = $c->user->roles();
 167     my %has_roles = ();
 168     map { $has_roles{$_} = 1; } @user_roles;
 169
 170     print STDERR "my user roles = @user_roles and trial breeding program = $breeding_program_name \n";
 171
 172     if (!exists($has_roles{$breeding_program_name})) {
 173       $c->stash->{rest} = { error => "You need to be associated with breeding program $breeding_program_name to change the details of this trial." };
 174       return;
 175     }
 176
 177     # set each new detail that is defined
 178     eval {
 179       if ($details->{name}) { $trial->set_name($details->{name}); }
 180       if ($details->{breeding_program}) { $trial->set_breeding_program($details->{breeding_program}); }
 181       if ($details->{location}) { $trial->set_location($details->{location}); }
 182       if ($details->{year}) { $trial->set_year($details->{year}); }
 183       if ($details->{type}) { $trial->set_project_type($details->{type}); }
 184       if ($details->{planting_date}) {
 185         if ($details->{planting_date} eq 'remove') { $trial->remove_planting_date($trial->get_planting_date()); }
 186         else { $trial->set_planting_date($details->{planting_date}); }
 187       }
 188       if ($details->{harvest_date}) {
 189         if ($details->{harvest_date} eq 'remove') { $trial->remove_harvest_date($trial->get_harvest_date()); }
 190         else { $trial->set_harvest_date($details->{harvest_date}); }
 191       }
 192       if ($details->{description}) { $trial->set_description($details->{description}); }
 193     };
 194
 195     if ($@) {
 196             $c->stash->{rest} = { error => "An error occurred setting the new trial details: $@" };
 197     }
 198     else {
 199             $c->stash->{rest} = { success => 1 };
 200     }
 201 }
 202
 203 sub traits_assayed : Chained('trial') PathPart('traits_assayed') Args(0) {
 204     my $self = shift;
 205     my $c = shift;
 206     my $stock_type = $c->req->param('stock_type');
 207
 208     my @traits_assayed  = $c->stash->{trial}->get_traits_assayed($stock_type);
 209     $c->stash->{rest} = { traits_assayed => \@traits_assayed };
 210 }
 211
 212 sub trait_phenotypes : Chained('trial') PathPart('trait_phenotypes') Args(0) {
 213     my $self = shift;
 214     my $c = shift;
 215     #get userinfo from db
 216     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 217     my $user = $c->user();
 218     if (! $c->user) {
 219       $c->stash->{rest} = {
 220         status => "not logged in"
 221       };
 222       return;
 223     }
 224     my $display = $c->req->param('display');
 225     my $trait = $c->req->param('trait');
 226     my @trait_list = ($trait);
 227     print STDERR 'DUMP'.Dumper( @trait_list).'\n';
 228     my $phenotypes_search;
 229     if ($display eq 'plot') {
 230         my @items = map {@{$_}[0]} @{$c->stash->{trial}->get_plots()};
 231         $phenotypes_search = CXGN::Phenotypes::PhenotypeMatrix->new(
 232             bcs_schema=> $schema,
 233             search_type => "Native",
 234             data_level => $display,
 235             trait_list=> \@trait_list,
 236             plot_list=>  \@items
 237         );
 238     }
 239     if ($display eq 'plant') {
 240         my @items = map {@{$_}[0]} @{$c->stash->{trial}->get_plants()};
 241         $phenotypes_search = CXGN::Phenotypes::PhenotypeMatrix->new(
 242             bcs_schema=> $schema,
 243             search_type => "Native",
 244             data_level => $display,
 245             trait_list=> \@trait_list,
 246             plant_list=>  \@items
 247         );
 248     }
 249     if ($display eq 'subplot') {
 250         my @items = map {@{$_}[0]} @{$c->stash->{trial}->get_subplots()};
 251         $phenotypes_search = CXGN::Phenotypes::PhenotypeMatrix->new(
 252             bcs_schema=> $schema,
 253             search_type => "Native",
 254             data_level => $display,
 255             trait_list=> \@trait_list,
 256             plant_list=>  \@items
 257         );
 258     }
 259     my @data = $phenotypes_search->get_phenotype_matrix();
 260     $c->stash->{rest} = {
 261       status => "success",
 262       data => \@data
 263    };
 264 }
 265
 266 sub phenotype_summary : Chained('trial') PathPart('phenotypes') Args(0) {
 267     my $self = shift;
 268     my $c = shift;
 269
 270     my $schema = $c->stash->{schema};
 271     my $round = Math::Round::Var->new(0.01);
 272     my $dbh = $c->dbc->dbh();
 273     my $trial_id = $c->stash->{trial_id};
 274     my $display = $c->req->param('display');
 275     my $select_clause_additional = '';
 276     my $group_by_additional = '';
 277     my $stock_type_id;
 278     my $rel_type_id;
 279     my $total_complete_number;
 280     if ($display eq 'plots') {
 281         $stock_type_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'plot', 'stock_type')->cvterm_id();
 282         $rel_type_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'plot_of', 'stock_relationship')->cvterm_id();
 283         my $plots = $c->stash->{trial}->get_plots();
 284         $total_complete_number = scalar (@$plots);
 285     }
 286     if ($display eq 'plants') {
 287         $stock_type_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'plant', 'stock_type')->cvterm_id();
 288         $rel_type_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'plant_of', 'stock_relationship')->cvterm_id();
 289         my $plants = $c->stash->{trial}->get_plants();
 290         $total_complete_number = scalar (@$plants);
 291     }
 292     if ($display eq 'subplots') {
 293         $stock_type_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'subplot', 'stock_type')->cvterm_id();
 294         $rel_type_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'subplot_of', 'stock_relationship')->cvterm_id();
 295         my $subplots = $c->stash->{trial}->get_subplots();
 296         $total_complete_number = scalar (@$subplots);
 297     }
 298     my $stocks_per_accession;
 299     if ($display eq 'plots_accession') {
 300         $stock_type_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'plot', 'stock_type')->cvterm_id();
 301         $rel_type_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'plot_of', 'stock_relationship')->cvterm_id();
 302         $select_clause_additional = ', accession.uniquename, accession.stock_id';
 303         $group_by_additional = ', accession.stock_id, accession.uniquename';
 304         $stocks_per_accession = $c->stash->{trial}->get_plots_per_accession();
 305     }
 306     if ($display eq 'plants_accession') {
 307         $stock_type_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'plant', 'stock_type')->cvterm_id();
 308         $rel_type_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'plant_of', 'stock_relationship')->cvterm_id();
 309         $select_clause_additional = ', accession.uniquename, accession.stock_id';
 310         $group_by_additional = ', accession.stock_id, accession.uniquename';
 311         $stocks_per_accession = $c->stash->{trial}->get_plants_per_accession();
 312     }
 313     my $accesion_type_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'accession', 'stock_type')->cvterm_id();
 314
 315     my $h = $dbh->prepare("SELECT (((cvterm.name::text || '|'::text) || db.name::text) || ':'::text) || dbxref.accession::text AS trait,
 316         cvterm.cvterm_id,
 317         count(phenotype.value),
 318         to_char(avg(phenotype.value::real), 'FM999990.990'),
 319         to_char(max(phenotype.value::real), 'FM999990.990'),
 320         to_char(min(phenotype.value::real), 'FM999990.990'),
 321         to_char(stddev(phenotype.value::real), 'FM999990.990')
 322         $select_clause_additional
 323         FROM cvterm
 324             JOIN phenotype ON (cvterm_id=cvalue_id)
 325             JOIN nd_experiment_phenotype USING(phenotype_id)
 326             JOIN nd_experiment_project USING(nd_experiment_id)
 327             JOIN nd_experiment_stock USING(nd_experiment_id)
 328             JOIN stock as plot USING(stock_id)
 329             JOIN stock_relationship on (plot.stock_id = stock_relationship.subject_id)
 330             JOIN stock as accession on (accession.stock_id = stock_relationship.object_id)
 331             JOIN dbxref ON cvterm.dbxref_id = dbxref.dbxref_id JOIN db ON dbxref.db_id = db.db_id
 332         WHERE project_id=?
 333             AND phenotype.value~?
 334             AND stock_relationship.type_id=?
 335             AND plot.type_id=?
 336             AND accession.type_id=?
 337         GROUP BY (((cvterm.name::text || '|'::text) || db.name::text) || ':'::text) || dbxref.accession::text, cvterm.cvterm_id $group_by_additional
 338         ORDER BY cvterm.name ASC;");
 339
 340     my $numeric_regex = '^[0-9]+([,.][0-9]+)?$';
 341     $h->execute($c->stash->{trial_id}, $numeric_regex, $rel_type_id, $stock_type_id, $accesion_type_id);
 342
 343     my @phenotype_data;
 344
 345     while (my ($trait, $trait_id, $count, $average, $max, $min, $stddev, $stock_name, $stock_id) = $h->fetchrow_array()) {
 346
 347         my $cv = 0;
 348         if ($stddev && $average != 0) {
 349             $cv = ($stddev /  $average) * 100;
 350             $cv = $round->round($cv) . '%';
 351         }
 352         if ($average) { $average = $round->round($average); }
 353         if ($min) { $min = $round->round($min); }
 354         if ($max) { $max = $round->round($max); }
 355         if ($stddev) { $stddev = $round->round($stddev); }
 356
 357         my @return_array;
 358         if ($stock_name && $stock_id) {
 359             $total_complete_number = scalar (@{$stocks_per_accession->{$stock_id}});
 360             push @return_array, qq{<a href="/stock/$stock_id/view">$stock_name</a>};
 361         }
 362         my $percent_missing = '';
 363         if ($total_complete_number){
 364             $percent_missing = 100 - sprintf("%.2f", ($count/$total_complete_number)*100)."%";
 365         }
 366
 367         push @return_array, ( qq{<a href="/cvterm/$trait_id/view">$trait</a>}, $average, $min, $max, $stddev, $cv, $count, $percent_missing, qq{<a href="#raw_data_histogram_well" onclick="trait_summary_hist_change($trait_id)"><span class="glyphicon glyphicon-stats"></span></a>} );
 368         push @phenotype_data, \@return_array;
 369     }
 370
 371     $c->stash->{rest} = { data => \@phenotype_data };
 372 }
 373
 374 sub trait_histogram : Chained('trial') PathPart('trait_histogram') Args(1) {
 375     my $self = shift;
 376     my $c = shift;
 377     my $trait_id = shift;
 378     my $stock_type = $c->req->param('stock_type') || 'plot';
 379
 380     my @data = $c->stash->{trial}->get_phenotypes_for_trait($trait_id, $stock_type);
 381
 382     $c->stash->{rest} = { data => \@data };
 383 }
 384
 385 sub get_trial_folder :Chained('trial') PathPart('folder') Args(0) {
 386     my $self = shift;
 387     my $c = shift;
 388
 389     if (!($c->user()->check_roles('curator') || $c->user()->check_roles('submitter'))) {
 390         $c->stash->{rest} = { error => 'You do not have the required privileges to edit the trial type of this trial.' };
 391         return;
 392     }
 393
 394     my $project_parent = $c->stash->{trial}->get_folder();
 395
 396     $c->stash->{rest} = { folder => [ $project_parent->project_id(), $project_parent->name() ] };
 397
 398 }
 399
 400 sub trial_accessions : Chained('trial') PathPart('accessions') Args(0) {
 401     my $self = shift;
 402     my $c = shift;
 403     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 404
 405     my $trial = CXGN::Trial->new( { bcs_schema => $schema, trial_id => $c->stash->{trial_id} });
 406
 407     my @data = $trial->get_accessions();
 408
 409     $c->stash->{rest} = { accessions => \@data };
 410 }
 411
 412 sub trial_seedlots : Chained('trial') PathPart('seedlots') Args(0) {
 413     my $self = shift;
 414     my $c = shift;
 415     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 416
 417     my $trial = CXGN::Trial->new( { bcs_schema => $schema, trial_id => $c->stash->{trial_id} });
 418
 419     my @data = $trial->get_seedlots();
 420
 421     $c->stash->{rest} = { seedlots => \@data };
 422 }
 423
 424 sub trial_used_seedlots_upload : Chained('trial') PathPart('upload_used_seedlots') Args(0) {
 425     my $self = shift;
 426     my $c = shift;
 427     my $user_id;
 428     my $user_name;
 429     my $user_role;
 430     my $session_id = $c->req->param("sgn_session_id");
 431
 432     if ($session_id){
 433         my $dbh = $c->dbc->dbh;
 434         my @user_info = CXGN::Login->new($dbh)->query_from_cookie($session_id);
 435         if (!$user_info[0]){
 436             $c->stash->{rest} = {error=>'You must be logged in to upload this seedlot info!'};
 437             $c->detach();
 438         }
 439         $user_id = $user_info[0];
 440         $user_role = $user_info[1];
 441         my $p = CXGN::People::Person->new($dbh, $user_id);
 442         $user_name = $p->get_username;
 443     } else{
 444         if (!$c->user){
 445             $c->stash->{rest} = {error=>'You must be logged in to upload this seedlot info!'};
 446             $c->detach();
 447         }
 448         $user_id = $c->user()->get_object()->get_sp_person_id();
 449         $user_name = $c->user()->get_object()->get_username();
 450         $user_role = $c->user->get_object->get_user_type();
 451     }
 452
 453     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 454     my $upload = $c->req->upload('trial_upload_used_seedlot_file');
 455     my $subdirectory = "trial_used_seedlot_upload";
 456     my $upload_original_name = $upload->filename();
 457     my $upload_tempfile = $upload->tempname;
 458     my $time = DateTime->now();
 459     my $timestamp = $time->ymd()."_".$time->hms();
 460
 461     ## Store uploaded temporary file in archive
 462     my $uploader = CXGN::UploadFile->new({
 463         tempfile => $upload_tempfile,
 464         subdirectory => $subdirectory,
 465         archive_path => $c->config->{archive_path},
 466         archive_filename => $upload_original_name,
 467         timestamp => $timestamp,
 468         user_id => $user_id,
 469         user_role => $user_role
 470     });
 471     my $archived_filename_with_path = $uploader->archive();
 472     my $md5 = $uploader->get_md5($archived_filename_with_path);
 473     if (!$archived_filename_with_path) {
 474         $c->stash->{rest} = {error => "Could not save file $upload_original_name in archive",};
 475         $c->detach();
 476     }
 477     unlink $upload_tempfile;
 478     my $parser = CXGN::Trial::ParseUpload->new(chado_schema => $schema, filename => $archived_filename_with_path);
 479     $parser->load_plugin('TrialUsedSeedlotsXLS');
 480     my $parsed_data = $parser->parse();
 481     #print STDERR Dumper $parsed_data;
 482
 483     if (!$parsed_data) {
 484         my $return_error = '';
 485         my $parse_errors;
 486         if (!$parser->has_parse_errors() ){
 487             $c->stash->{rest} = {error_string => "Could not get parsing errors"};
 488             $c->detach();
 489         } else {
 490             $parse_errors = $parser->get_parse_errors();
 491             #print STDERR Dumper $parse_errors;
 492
 493             foreach my $error_string (@{$parse_errors->{'error_messages'}}){
 494                 $return_error .= $error_string."<br>";
 495             }
 496         }
 497         $c->stash->{rest} = {error_string => $return_error, missing_seedlots => $parse_errors->{'missing_seedlots'}, missing_plots => $parse_errors->{'missing_plots'}};
 498         $c->detach();
 499     }
 500
 501     eval {
 502         while (my ($key, $val) = each(%$parsed_data)){
 503             my $sl = CXGN::Stock::Seedlot->new(schema => $schema, seedlot_id => $val->{seedlot_stock_id});
 504
 505             my $transaction = CXGN::Stock::Seedlot::Transaction->new(schema => $schema);
 506             $transaction->factor(1);
 507             $transaction->from_stock([$val->{seedlot_stock_id}, $val->{seedlot_name}]);
 508             $transaction->to_stock([$val->{plot_stock_id}, $val->{plot_name}]);
 509             $transaction->amount($val->{amount});
 510             $transaction->timestamp($timestamp);
 511             $transaction->description($val->{description});
 512             $transaction->operator($user_name);
 513             $transaction->store();
 514
 515             $sl->set_current_count_property();
 516         }
 517     };
 518     if ($@) {
 519         $c->stash->{rest} = { error => $@ };
 520         print STDERR "An error condition occurred, was not able to upload trial used seedlots. ($@).\n";
 521         $c->detach();
 522     }
 523
 524     $c->stash->{rest} = { success => 1 };
 525 }
 526
 527 sub trial_controls : Chained('trial') PathPart('controls') Args(0) {
 528     my $self = shift;
 529     my $c = shift;
 530     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 531
 532     my $trial = CXGN::Trial->new( { bcs_schema => $schema, trial_id => $c->stash->{trial_id} });
 533
 534     my @data = $trial->get_controls();
 535
 536     $c->stash->{rest} = { accessions => \@data };
 537 }
 538
 539 sub controls_by_plot : Chained('trial') PathPart('controls_by_plot') Args(0) {
 540     my $self = shift;
 541     my $c = shift;
 542     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 543     my @plot_ids = $c->req->param('plot_ids[]');
 544
 545     my $trial = CXGN::Trial->new({ bcs_schema => $schema, trial_id => $c->stash->{trial_id} });
 546
 547     my @data = $trial->get_controls_by_plot(\@plot_ids);
 548
 549     $c->stash->{rest} = { accessions => \@data };
 550 }
 551
 552 sub trial_plots : Chained('trial') PathPart('plots') Args(0) {
 553     my $self = shift;
 554     my $c = shift;
 555     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 556
 557     my $trial = $c->stash->{trial};
 558
 559     my @data = $trial->get_plots();
 560
 561     $c->stash->{rest} = { plots => \@data };
 562 }
 563
 564 sub trial_has_subplots : Chained('trial') PathPart('has_subplots') Args(0) {
 565     my $self = shift;
 566     my $c = shift;
 567     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 568
 569     my $trial = $c->stash->{trial};
 570     $c->stash->{rest} = { has_subplots => $trial->has_subplot_entries() };
 571 }
 572
 573 sub trial_subplots : Chained('trial') PathPart('subplots') Args(0) {
 574     my $self = shift;
 575     my $c = shift;
 576     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 577
 578     my $trial = $c->stash->{trial};
 579
 580     my @data = $trial->get_subplots();
 581
 582     $c->stash->{rest} = { subplots => \@data };
 583 }
 584
 585 sub trial_has_plants : Chained('trial') PathPart('has_plants') Args(0) {
 586     my $self = shift;
 587     my $c = shift;
 588     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 589
 590     my $trial = $c->stash->{trial};
 591     $c->stash->{rest} = { has_plants => $trial->has_plant_entries() };
 592 }
 593
 594 sub trial_plants : Chained('trial') PathPart('plants') Args(0) {
 595     my $self = shift;
 596     my $c = shift;
 597     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 598
 599     my $trial = $c->stash->{trial};
 600
 601     my @data = $trial->get_plants();
 602
 603     $c->stash->{rest} = { plants => \@data };
 604 }
 605
 606 sub trial_treatments : Chained('trial') PathPart('treatments') Args(0) {
 607     my $self = shift;
 608     my $c = shift;
 609     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 610
 611     my $trial = $c->stash->{trial};
 612
 613     my $data = $trial->get_treatments();
 614
 615     $c->stash->{rest} = { treatments => $data };
 616 }
 617
 618 sub trial_add_treatment : Chained('trial') PathPart('add_treatment') Args(0) {
 619     my $self = shift;
 620     my $c = shift;
 621
 622     if (!$c->user()){
 623         $c->stash->{rest} = {error => "You must be logged in to add a treatment"};
 624         $c->detach();
 625     }
 626
 627     my $schema = $c->dbic_schema('Bio::Chado::Schema');
 628     my $trial_id = $c->stash->{trial_id};
 629     my $trial = $c->stash->{trial};
 630     my $design = decode_json $c->req->param('design');
 631     my $new_treatment_has_plant_entries = $c->req->param('has_plant_entries');
 632
 633     my $trial_design_store = CXGN::Trial::TrialDesignStore->new({
 634                 bcs_schema => $schema,
 635                 trial_id => $trial_id,
 636         trial_name => $trial->get_name(),
 637                 nd_geolocation_id => $trial->get_location()->[0],
 638                 design_type => $trial->get_design_type(),
 639                 design => $design,
 640         new_treatment_has_plant_entries => $new_treatment_has_plant_entries,
 641         operator => $c->user()->get_object()->get_username()
 642         });
 643     my $error = $trial_design_store->store();
 644     if ($error){
 645         $c->stash->{rest} = {error => "Treatment not added: ".$error};
 646     } else {
 647         $c->stash->{rest} = {success => 1};
 648     }
 649 }
 650
 651 sub trial_layout : Chained('trial') PathPart('layout') Args(0) {
 652     my $self = shift;
 653     my $c = shift;
 654     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 655
 656     my $layout = CXGN::Trial::TrialLayout->new({ schema => $schema, trial_id =>$c->stash->{trial_id} });
 657
 658     my $design = $layout->get_design();
 659     $c->stash->{rest} = {design => $design};
 660 }
 661
 662 sub trial_design : Chained('trial') PathPart('design') Args(0) {
 663     my $self = shift;
 664     my $c = shift;
 665     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 666
 667     my $layout = CXGN::Trial::TrialLayout->new({ schema => $schema, trial_id =>$c->stash->{trial_id} });
 668
 669     my $design = $layout->get_design();
 670     my $design_type = $layout->get_design_type();
 671     my $plot_dimensions = $layout->get_plot_dimensions();
 672
 673     my $plot_length = '';
 674     if ($plot_dimensions->[0]) {
 675         $plot_length = $plot_dimensions->[0];
 676     }
 677
 678     my $plot_width = '';
 679     if ($plot_dimensions->[1]){
 680         $plot_width = $plot_dimensions->[1];
 681     }
 682
 683     my $plants_per_plot = '';
 684     if ($plot_dimensions->[2]){
 685         $plants_per_plot = $plot_dimensions->[2];
 686     }
 687
 688     my $block_numbers = $layout->get_block_numbers();
 689     my $number_of_blocks = '';
 690     if ($block_numbers) {
 691       $number_of_blocks = scalar(@{$block_numbers});
 692     }
 693
 694     my $replicate_numbers = $layout->get_replicate_numbers();
 695     my $number_of_replicates = '';
 696     if ($replicate_numbers) {
 697       $number_of_replicates = scalar(@{$replicate_numbers});
 698     }
 699
 700     $c->stash->{rest} = { design_type => $design_type, num_blocks => $number_of_blocks, num_reps => $number_of_replicates, plot_length => $plot_length, plot_width => $plot_width, plants_per_plot => $plants_per_plot, design => $design };
 701 }
 702
 703 sub get_spatial_layout : Chained('trial') PathPart('coords') Args(0) {
 704
 705     my $self = shift;
 706     my $c = shift;
 707     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 708
 709     my $fieldmap = CXGN::Trial::FieldMap->new({
 710       bcs_schema => $schema,
 711       trial_id => $c->stash->{trial_id},
 712     });
 713     my $return = $fieldmap->display_fieldmap();
 714
 715     $c->stash->{rest} = $return;
 716 }
 717
 718 sub retrieve_trial_info :  Path('/ajax/breeders/trial_phenotyping_info') : ActionClass('REST') { }
 719 sub retrieve_trial_info_POST : Args(0) {
 720 #sub retrieve_trial_info : chained('trial') Pathpart("trial_phenotyping_info") Args(0) {
 721     my $self =shift;
 722     my $c = shift;
 723     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 724     my $trial_id = $c->req->param('trial_id');
 725
 726     my $layout = CXGN::Trial::TrialLayout->new({
 727                 schema => $schema,
 728                 trial_id => $trial_id
 729         });
 730
 731         my $design = $layout-> get_design();
 732     #print STDERR Dumper($design);
 733
 734     my @layout_info;
 735         foreach my $plot_number (keys %{$design}) {
 736                 push @layout_info, {
 737         plot_id => $design->{$plot_number}->{plot_id},
 738                 plot_number => $plot_number,
 739                 row_number => $design->{$plot_number}->{row_number},
 740                 col_number => $design->{$plot_number}->{col_number},
 741                 block_number=> $design->{$plot_number}-> {block_number},
 742                 rep_number =>  $design->{$plot_number}-> {rep_number},
 743                 plot_name => $design->{$plot_number}-> {plot_name},
 744                 accession_name => $design->{$plot_number}-> {accession_name},
 745                 plant_names => $design->{$plot_number}-> {plant_names},
 746                 };
 747         @layout_info = sort { $a->{plot_number} <=> $b->{plot_number} } @layout_info;
 748         }
 749
 750     #print STDERR Dumper(@layout_info);
 751     $c->stash->{rest} = {trial_info => \@layout_info};
 752     #$c->stash->{layout_info} = \@layout_info;
 753 }
 754
 755
 756 sub trial_completion_layout_section : Chained('trial') PathPart('trial_completion_layout_section') Args(0) {
 757     my $self = shift;
 758     my $c = shift;
 759     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 760
 761     my $trial_layout = CXGN::Trial::TrialLayout->new({schema => $schema, trial_id => $c->stash->{trial_id}, verify_layout=>1, verify_physical_map=>1});
 762     my $trial_errors = $trial_layout->_get_design_from_trial();
 763     my $has_layout_check = $trial_errors->{errors}->{layout_errors} || $trial_errors->{error} ? 0 : 1;
 764     my $has_physical_map_check = $trial_errors->{errors}->{physical_map_errors} || $trial_errors->{error} ? 0 : 1;
 765     my $has_seedlots = $trial_errors->{errors}->{seedlot_errors} || $trial_errors->{error} ? 0 : 1;
 766     my $error_string = $trial_errors->{error} ? $trial_errors->{error} : '';
 767     my $layout_error_string = $trial_errors->{errors}->{layout_errors} ? join ', ', @{$trial_errors->{errors}->{layout_errors}} : '';
 768     my $map_error_string = $trial_errors->{errors}->{physical_map_errors} ? join ', ', @{$trial_errors->{errors}->{physical_map_errors}} : '';
 769     my $seedlot_error_string = $trial_errors->{errors}->{seedlot_errors} ? join ', ', @{$trial_errors->{errors}->{seedlot_errors}} : '';
 770
 771     $c->stash->{rest} = {
 772         has_layout => $has_layout_check,
 773         layout_errors => $error_string." ".$layout_error_string,
 774         has_physical_map => $has_physical_map_check,
 775         physical_map_errors => $error_string." ".$map_error_string,
 776         has_seedlots => $has_seedlots,
 777         seedlot_errors => $error_string." ".$seedlot_error_string
 778     };
 779 }
 780
 781 sub trial_completion_phenotype_section : Chained('trial') PathPart('trial_completion_phenotype_section') Args(0) {
 782     my $self = shift;
 783     my $c = shift;
 784     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 785
 786     my $plot_type_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'plot', 'stock_type')->cvterm_id();
 787     my $plant_type_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'plant', 'stock_type')->cvterm_id();
 788     my $phenotyping_experiment_type_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'phenotyping_experiment', 'experiment_type')->cvterm_id();
 789     my $has_phenotype_check = $schema->resultset('Phenotype::Phenotype')->search({'stock.type_id'=> [$plot_type_id, $plant_type_id], 'nd_experiment.type_id'=>$phenotyping_experiment_type_id, 'me.value' => { '!=' => ''}, 'project.project_id'=>$c->stash->{trial_id}}, {join=>{'nd_experiment_phenotypes'=>{'nd_experiment'=>[{'nd_experiment_stocks'=>'stock' }, {'nd_experiment_projects'=>'project'}] } }, rows=>1 });
 790     my $has_phenotypes = $has_phenotype_check->first ? 1 : 0;
 791
 792     $c->stash->{rest} = {has_phenotypes => $has_phenotypes};
 793 }
 794
 795 #sub compute_derive_traits : Path('/ajax/phenotype/delete_field_coords') Args(0) {
 796 sub delete_field_coord : Path('/ajax/phenotype/delete_field_coords') Args(0) {
 797   my $self = shift;
 798         my $c = shift;
 799         my $trial_id = $c->req->param('trial_id');
 800
 801   my $schema = $c->dbic_schema('Bio::Chado::Schema');
 802
 803   if ($self->privileges_denied($c)) {
 804     $c->stash->{rest} = { error => "You have insufficient access privileges to update this map." };
 805     return;
 806   }
 807
 808   my $fieldmap = CXGN::Trial::FieldMap->new({
 809     bcs_schema => $schema,
 810     trial_id => $trial_id,
 811   });
 812   my $delete_return_error = $fieldmap->delete_fieldmap();
 813   if ($delete_return_error) {
 814     $c->stash->{rest} = { error => $delete_return_error };
 815     return;
 816   }
 817
 818   $c->stash->{rest} = {success => 1};
 819 }
 820
 821 sub replace_trial_accession : Chained('trial') PathPart('replace_accession') Args(0) {
 822   my $self = shift;
 823   my $c = shift;
 824   my $schema = $c->dbic_schema('Bio::Chado::Schema');
 825   my $old_accession_id = $c->req->param('old_accession_id');
 826   my $new_accession = $c->req->param('new_accession');
 827   my $trial_id = $c->stash->{trial_id};
 828
 829   if ($self->privileges_denied($c)) {
 830     $c->stash->{rest} = { error => "You have insufficient access privileges to edit this map." };
 831     return;
 832   }
 833
 834   if (!$new_accession){
 835     $c->stash->{rest} = { error => "Provide new accession name." };
 836     return;
 837   }
 838
 839   my $replace_accession_fieldmap = CXGN::Trial::FieldMap->new({
 840     bcs_schema => $schema,
 841     trial_id => $trial_id,
 842     old_accession_id => $old_accession_id,
 843     new_accession => $new_accession,
 844   });
 845
 846   my $return_error = $replace_accession_fieldmap->update_fieldmap_precheck();
 847      if ($return_error) {
 848        $c->stash->{rest} = { error => $return_error };
 849        return;
 850      }
 851
 852   my $replace_return_error = $replace_accession_fieldmap->replace_trial_accession_fieldMap();
 853   if ($replace_return_error) {
 854     $c->stash->{rest} = { error => $replace_return_error };
 855     return;
 856   }
 857
 858   $c->stash->{rest} = { success => 1};
 859 }
 860
 861 sub replace_plot_accession : Chained('trial') PathPart('replace_plot_accessions') Args(0) {
 862   my $self = shift;
 863   my $c = shift;
 864   my $schema = $c->dbic_schema('Bio::Chado::Schema');
 865   my $old_accession = $c->req->param('old_accession');
 866   my $new_accession = $c->req->param('new_accession');
 867   my $old_plot_id = $c->req->param('old_plot_id');
 868   my $trial_id = $c->stash->{trial_id};
 869
 870   if ($self->privileges_denied($c)) {
 871     $c->stash->{rest} = { error => "You have insufficient access privileges to edit this map." };
 872     return;
 873   }
 874
 875   if (!$new_accession){
 876     $c->stash->{rest} = { error => "Provide new accession name." };
 877     return;
 878   }
 879
 880   my $replace_plot_accession_fieldmap = CXGN::Trial::FieldMap->new({
 881     bcs_schema => $schema,
 882     trial_id => $trial_id,
 883     new_accession => $new_accession,
 884     old_accession => $old_accession,
 885     old_plot_id => $old_plot_id,
 886
 887   });
 888
 889   my $return_error = $replace_plot_accession_fieldmap->update_fieldmap_precheck();
 890      if ($return_error) {
 891        $c->stash->{rest} = { error => $return_error };
 892        return;
 893      }
 894
 895   print "Calling Replace Function...............\n";
 896   my $replace_return_error = $replace_plot_accession_fieldmap->replace_plot_accession_fieldMap();
 897   if ($replace_return_error) {
 898     $c->stash->{rest} = { error => $replace_return_error };
 899     return;
 900   }
 901
 902   print "OldAccession: $old_accession, NewAcc: $new_accession, OldPlotId: $old_plot_id\n";
 903   $c->stash->{rest} = { success => 1};
 904 }
 905
 906 sub substitute_accession : Chained('trial') PathPart('substitute_accession') Args(0) {
 907   my $self = shift;
 908         my $c = shift;
 909   my $schema = $c->dbic_schema('Bio::Chado::Schema');
 910   my $trial_id = $c->stash->{trial_id};
 911   my $plot_1_info = $c->req->param('plot_1_info');
 912   my $plot_2_info = $c->req->param('plot_2_info');
 913
 914   my ($plot_1_id, $accession_1) = split /,/, $plot_1_info;
 915   my ($plot_2_id, $accession_2) = split /,/, $plot_2_info;
 916
 917   if ($self->privileges_denied($c)) {
 918     $c->stash->{rest} = { error => "You have insufficient access privileges to update this map." };
 919     return;
 920   }
 921
 922   if ($plot_1_id == $plot_2_id){
 923     $c->stash->{rest} = { error => "Choose a different plot/accession in 'select Accession 2' to perform this operation." };
 924     return;
 925   }
 926
 927   my @controls;
 928   my @ids;
 929
 930   my $fieldmap = CXGN::Trial::FieldMap->new({
 931     bcs_schema => $schema,
 932     trial_id => $trial_id,
 933     first_plot_selected => $plot_1_id,
 934     second_plot_selected => $plot_2_id,
 935     first_accession_selected => $accession_1,
 936     second_accession_selected => $accession_2,
 937   });
 938
 939   my $return_error = $fieldmap->update_fieldmap_precheck();
 940   if ($return_error) {
 941     $c->stash->{rest} = { error => $return_error };
 942     return;
 943   }
 944
 945   my $return_check_error = $fieldmap->substitute_accession_precheck();
 946   if ($return_check_error) {
 947     $c->stash->{rest} = { error => $return_check_error };
 948     return;
 949   }
 950
 951   my $update_return_error = $fieldmap->substitute_accession_fieldmap();
 952   if ($update_return_error) {
 953     $c->stash->{rest} = { error => $update_return_error };
 954     return;
 955   }
 956
 957   $c->stash->{rest} = { success => 1};
 958 }
 959
 960 sub create_plant_subplots : Chained('trial') PathPart('create_subplots') Args(0) {
 961     my $self = shift;
 962     my $c = shift;
 963     my $plants_per_plot = $c->req->param("plants_per_plot") || 8;
 964     my $inherits_plot_treatments = $c->req->param("inherits_plot_treatments");
 965     my $plants_with_treatments;
 966     if($inherits_plot_treatments eq '1'){
 967         $plants_with_treatments = 1;
 968     }
 969
 970     if (my $error = $self->privileges_denied($c)) {
 971         $c->stash->{rest} = { error => $error };
 972         return;
 973     }
 974
 975     if (!$plants_per_plot || $plants_per_plot > 50) {
 976         $c->stash->{rest} = { error => "Plants per plot number is required and must be smaller than 50." };
 977         return;
 978     }
 979
 980     my $t = CXGN::Trial->new( { bcs_schema => $c->dbic_schema("Bio::Chado::Schema"), trial_id => $c->stash->{trial_id} });
 981
 982     if ($t->create_plant_entities($plants_per_plot, $plants_with_treatments)) {
 983         $c->stash->{rest} = {success => 1};
 984         return;
 985     } else {
 986         $c->stash->{rest} = { error => "Error creating plant entries in controller." };
 987         return;
 988     }
 989
 990 }
 991
 992 sub privileges_denied {
 993     my $self = shift;
 994     my $c = shift;
 995
 996     my $trial_id = $c->stash->{trial_id};
 997
 998     if (! $c->user) { return "Login required for modifying trial."; }
 999     my $user_id = $c->user->get_object->get_sp_person_id();
1000
1001     if ($c->user->check_roles('curator')) {
1002              return 0;
1003     }
1004
1005     my $breeding_programs = $c->stash->{trial}->get_breeding_programs();
1006
1007     if ( ($c->user->check_roles('submitter')) && ( $c->user->check_roles($breeding_programs->[0]->[1]))) {
1008         return 0;
1009     }
1010     return "You have insufficient privileges to modify or delete this trial.";
1011 }
1012
1013 # loading field coordinates
1014
1015 sub upload_trial_coordinates : Path('/ajax/breeders/trial/coordsupload') Args(0) {
1016     my $self = shift;
1017     my $c = shift;
1018
1019     if (!$c->user()) {
1020         print STDERR "User not logged in... not uploading coordinates.\n";
1021         $c->stash->{rest} = {error => "You need to be logged in to upload coordinates." };
1022         return;
1023     }
1024
1025     if (!any { $_ eq "curator" || $_ eq "submitter" } ($c->user()->roles)  ) {
1026         $c->stash->{rest} = {error =>  "You have insufficient privileges to add coordinates." };
1027         return;
1028     }
1029
1030     my $time = DateTime->now();
1031     my $user_id = $c->user()->get_object()->get_sp_person_id();
1032     my $user_name = $c->user()->get_object()->get_username();
1033     my $timestamp = $time->ymd()."_".$time->hms();
1034     my $subdirectory = 'trial_coords_upload';
1035     my $upload = $c->req->upload('trial_coordinates_uploaded_file');
1036     my $trial_id = $c->req->param('trial_coordinates_upload_trial_id');
1037     my $upload_tempfile  = $upload->tempname;
1038     my $upload_original_name  = $upload->filename();
1039     my $md5;
1040     my %upload_metadata;
1041
1042     # Store uploaded temporary file in archive
1043     print STDERR "TEMP FILE: $upload_tempfile\n";
1044     my $uploader = CXGN::UploadFile->new({
1045         tempfile => $upload_tempfile,
1046         subdirectory => $subdirectory,
1047         archive_path => $c->config->{archive_path},
1048         archive_filename => $upload_original_name,
1049         timestamp => $timestamp,
1050         user_id => $user_id,
1051         user_role => $c->user()->roles
1052     });
1053     my $archived_filename_with_path = $uploader->archive();
1054
1055     if (!$archived_filename_with_path) {
1056         $c->stash->{rest} = {error => "Could not save file $upload_original_name in archive",};
1057         return;
1058     }
1059
1060     $md5 = $uploader->get_md5($archived_filename_with_path);
1061     unlink $upload_tempfile;
1062
1063     my $error_string = '';
1064    # open file and remove return of line
1065     open(my $F, "<", $archived_filename_with_path) || die "Can't open archive file $archived_filename_with_path";
1066     my $schema = $c->dbic_schema("Bio::Chado::Schema");
1067     my $header = <$F>;
1068     while (<$F>) {
1069         chomp;
1070         $_ =~ s/\r//g;
1071         my ($plot,$row,$col) = split /\t/ ;
1072         my $rs = $schema->resultset("Stock::Stock")->search({uniquename=> $plot });
1073         if ($rs->count()== 1) {
1074         my $r =  $rs->first();
1075         print STDERR "The plots $plot was found.\n Loading row $row col $col\n";
1076         $r->create_stockprops({row_number => $row, col_number => $col}, {autocreate => 1});
1077       }
1078       else {
1079         print STDERR "WARNING! $plot was not found in the database.\n";
1080         $error_string .= "WARNING! $plot was not found in the database.";
1081       }
1082     }
1083
1084     my $trial_layout = CXGN::Trial::TrialLayout->new({
1085        schema => $schema,
1086        trial_id => $trial_id
1087     });
1088     $trial_layout->generate_and_cache_layout();
1089
1090     if ($error_string){
1091         $c->stash->{rest} = {error_string => $error_string};
1092         $c->detach();
1093     }
1094
1095     $c->stash->{rest} = {success => 1};
1096 }
1097
1098 1;