lib/SGN/Controller/AJAX/TrialMetadata.pm

   1
   2 package SGN::Controller::AJAX::TrialMetadata;
   3
   4 use Moose;
   5 use Data::Dumper;
   6 use List::Util 'max';
   7 use Bio::Chado::Schema;
   8 use List::Util qw | any |;
   9 use CXGN::Trial;
  10 use Math::Round::Var;
  11
  12
  13 BEGIN { extends 'Catalyst::Controller::REST' }
  14
  15 __PACKAGE__->config(
  16     default   => 'application/json',
  17     stash_key => 'rest',
  18     map       => { 'application/json' => 'JSON', 'text/html' => 'JSON' },
  19    );
  20
  21 has 'schema' => (
  22                  is       => 'rw',
  23                  isa      => 'DBIx::Class::Schema',
  24                  lazy_build => 1,
  25                 );
  26
  27
  28 sub trial : Chained('/') PathPart('ajax/breeders/trial') CaptureArgs(1) {
  29     my $self = shift;
  30     my $c = shift;
  31     my $trial_id = shift;
  32
  33     $c->stash->{trial_id} = $trial_id;
  34     $c->stash->{schema} =  $c->dbic_schema("Bio::Chado::Schema");
  35     $c->stash->{trial} = CXGN::Trial->new( { bcs_schema => $c->stash->{schema}, trial_id => $trial_id });
  36
  37     if (!$c->stash->{trial}) {
  38         $c->stash->{rest} = { error => "The specified trial with id $trial_id does not exist" };
  39         return;
  40     }
  41
  42 }
  43
  44 =head2 delete_trial_by_file
  45
  46  Usage:
  47  Desc:
  48  Ret:
  49  Args:
  50  Side Effects:
  51  Example:
  52
  53 =cut
  54
  55 sub delete_trial_data : Local() ActionClass('REST');
  56
  57 sub delete_trial_data_GET : Chained('trial') PathPart('delete') Args(1) {
  58     my $self = shift;
  59     my $c = shift;
  60     my $datatype = shift;
  61
  62     if ($self->delete_privileges_denied($c)) {
  63         $c->stash->{rest} = { error => "You have insufficient access privileges to delete trial data." };
  64         return;
  65     }
  66
  67     my $error = "";
  68
  69     if ($datatype eq 'phenotypes') {
  70         $error = $c->stash->{trial}->delete_phenotype_metadata($c->dbic_schema("CXGN::Metadata::Schema"), $c->dbic_schema("CXGN::Phenome::Schema"));
  71         $error .= $c->stash->{trial}->delete_phenotype_data();
  72     }
  73
  74     elsif ($datatype eq 'layout') {
  75         $error = $c->stash->{trial}->delete_metadata($c->dbic_schema("CXGN::Metadata::Schema"), $c->dbic_schema("CXGN::Phenome::Schema"));
  76         $error = $c->stash->{trial}->delete_field_layout();
  77     }
  78     elsif ($datatype eq 'entry') {
  79         $error = $c->stash->{trial}->delete_project_entry();
  80     }
  81     else {
  82         $c->stash->{rest} = { error => "unknown delete action for $datatype" };
  83         return;
  84     }
  85     if ($error) {
  86         $c->stash->{rest} = { error => $error };
  87         return;
  88     }
  89     $c->stash->{rest} = { message => "Successfully deleted trial data.", success => 1 };
  90 }
  91
  92 sub trial_details : Chained('trial') PathPart('details') Args(0) ActionClass('REST') {};
  93
  94 sub trial_details_GET   {
  95     my $self = shift;
  96     my $c = shift;
  97
  98     my $trial = $c->stash->{trial};
  99
 100     $c->stash->{rest} = { details => $trial->get_details() };
 101
 102 }
 103
 104 sub trial_details_POST  {
 105     my $self = shift;
 106     my $c = shift;
 107
 108     my @categories = $c->req->param("categories[]");
 109
 110     my $details = {};
 111     foreach my $category (@categories) {
 112       $details->{$category} = $c->req->param("details[$category]");
 113     }
 114
 115     if (!%{$details}) {
 116       $c->stash->{rest} = { error => "No values were edited, so no changes could be made for this trial's details." };
 117       return;
 118     }
 119     else {
 120     print STDERR "Here are the deets: " . Dumper($details) . "\n";
 121     }
 122
 123     if (!($c->user()->check_roles('curator') || $c->user()->check_roles('submitter'))) {
 124             $c->stash->{rest} = { error => 'You do not have the required privileges to edit the trial details of this trial.' };
 125             return;
 126     }
 127
 128     my $trial_id = $c->stash->{trial_id};
 129     my $trial = $c->stash->{trial};
 130     my $program_object = CXGN::BreedersToolbox::Projects->new( { schema => $c->stash->{schema} });
 131     my $breeding_program = $program_object->get_breeding_programs_by_trial($trial_id);
 132
 133     if (! ($c->user() &&  ($c->user->check_roles("curator") || $c->user->check_roles($breeding_program)))) {
 134             $c->stash->{rest} = { error => "You need to be logged in with sufficient privileges to change the details of this trial." };
 135             return;
 136     }
 137
 138     # set each new detail that is defined
 139     eval {
 140       if ($details->{name}) { $trial->set_name($details->{name}); }
 141       if ($details->{breeding_program}) { $trial->set_breeding_program($details->{breeding_program}); }
 142       if ($details->{location}) { $trial->set_location($details->{location}); }
 143       if ($details->{year}) { $trial->set_year($details->{year}); }
 144       if ($details->{type}) { $trial->set_project_type($details->{type}); }
 145       if ($details->{planting_date}) {
 146         if ($details->{planting_date} eq 'remove') { $trial->remove_planting_date($trial->get_planting_date()); }
 147         else { $trial->set_planting_date($details->{planting_date}); }
 148       }
 149       if ($details->{harvest_date}) {
 150         if ($details->{harvest_date} eq 'remove') { $trial->remove_harvest_date($trial->get_harvest_date()); }
 151         else { $trial->set_harvest_date($details->{harvest_date}); }
 152       }
 153       if ($details->{description}) { $trial->set_description($details->{description}); }
 154     };
 155
 156     if ($@) {
 157             $c->stash->{rest} = { error => "An error occurred setting the new trial details: $@" };
 158     }
 159     else {
 160             $c->stash->{rest} = { success => 1 };
 161     }
 162 }
 163
 164 sub traits_assayed : Chained('trial') PathPart('traits_assayed') Args(0) {
 165     my $self = shift;
 166     my $c = shift;
 167     my $stock_type = $c->req->param('stock_type');
 168
 169     my @traits_assayed  = $c->stash->{trial}->get_traits_assayed($stock_type);
 170     $c->stash->{rest} = { traits_assayed => \@traits_assayed };
 171 }
 172
 173
 174 sub phenotype_summary : Chained('trial') PathPart('phenotypes') Args(0) {
 175     my $self = shift;
 176     my $c = shift;
 177
 178     my $round = Math::Round::Var->new(0.01);
 179     my $dbh = $c->dbc->dbh();
 180     my $trial_id = $c->stash->{trial_id};
 181
 182     my $h = $dbh->prepare("SELECT (((cvterm.name::text || '|'::text) || db.name::text) || ':'::text)
 183                                       || dbxref.accession::text AS trait,
 184                                      cvterm.cvterm_id,
 185                                      count(phenotype.value),
 186                                      to_char(avg(phenotype.value::real), 'FM999990.990'),
 187                                      to_char(max(phenotype.value::real), 'FM999990.990'),
 188                                      to_char(min(phenotype.value::real), 'FM999990.990'),
 189                                      to_char(stddev(phenotype.value::real), 'FM999990.990')
 190                                     FROM cvterm
 191                                     JOIN phenotype ON (cvterm_id=cvalue_id)
 192                                     JOIN nd_experiment_phenotype USING(phenotype_id)
 193                                     JOIN nd_experiment_project USING(nd_experiment_id)
 194                                     JOIN dbxref ON cvterm.dbxref_id = dbxref.dbxref_id JOIN db ON dbxref.db_id = db.db_id
 195                                     WHERE project_id=?
 196                                           AND phenotype.value~?
 197                                     GROUP BY (((cvterm.name::text || '|'::text) || db.name::text) || ':'::text)
 198                                                 || dbxref.accession::text, cvterm.cvterm_id;");
 199
 200     my $numeric_regex = '^[0-9]+([,.][0-9]+)?$';
 201     $h->execute($c->stash->{trial_id}, $numeric_regex);
 202
 203     my @phenotype_data;
 204
 205     while (my ($trait, $trait_id, $count, $average, $max, $min, $stddev) = $h->fetchrow_array()) {
 206
 207         my $cv   = ($stddev /  $average) * 100;
 208         $cv      = $round->round($cv) . '%';
 209         $average = $round->round($average);
 210         $min     = $round->round($min);
 211         $max     = $round->round($max);
 212         $stddev  = $round->round($stddev);
 213
 214         push @phenotype_data, [ qq{<a href="/cvterm/$trait_id/view">$trait</a>}, $average, $min, $max, $stddev, $cv, $count, qq{<a href="#raw_data_histogram_well" onclick="trait_summary_hist_change($trait_id)"><span class="glyphicon glyphicon-stats"></span></a>} ];
 215     }
 216
 217     $c->stash->{rest} = { data => \@phenotype_data };
 218 }
 219
 220 sub trait_histogram : Chained('trial') PathPart('trait_histogram') Args(1) {
 221     my $self = shift;
 222     my $c = shift;
 223     my $trait_id = shift;
 224
 225     my @data = $c->stash->{trial}->get_phenotypes_for_trait($trait_id);
 226
 227     $c->stash->{rest} = { data => \@data };
 228 }
 229
 230 sub get_trial_folder :Chained('trial') PathPart('folder') Args(0) {
 231     my $self = shift;
 232     my $c = shift;
 233
 234     if (!($c->user()->check_roles('curator') || $c->user()->check_roles('submitter'))) {
 235         $c->stash->{rest} = { error => 'You do not have the required privileges to edit the trial type of this trial.' };
 236         return;
 237     }
 238
 239     my $project_parent = $c->stash->{trial}->get_folder();
 240
 241     $c->stash->{rest} = { folder => [ $project_parent->project_id(), $project_parent->name() ] };
 242
 243 }
 244
 245 sub trial_accessions : Chained('trial') PathPart('accessions') Args(0) {
 246     my $self = shift;
 247     my $c = shift;
 248     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 249
 250     my $trial = CXGN::Trial->new( { bcs_schema => $schema, trial_id => $c->stash->{trial_id} });
 251
 252     my @data = $trial->get_accessions();
 253
 254     $c->stash->{rest} = { accessions => \@data };
 255 }
 256
 257 sub trial_controls : Chained('trial') PathPart('controls') Args(0) {
 258     my $self = shift;
 259     my $c = shift;
 260     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 261
 262     my $trial = CXGN::Trial->new( { bcs_schema => $schema, trial_id => $c->stash->{trial_id} });
 263
 264     my @data = $trial->get_controls();
 265
 266     $c->stash->{rest} = { accessions => \@data };
 267 }
 268
 269 sub trial_plots : Chained('trial') PathPart('plots') Args(0) {
 270     my $self = shift;
 271     my $c = shift;
 272     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 273
 274     my $trial = CXGN::Trial->new( { bcs_schema => $schema, trial_id => $c->stash->{trial_id} });
 275
 276     my @data = $trial->get_plots();
 277
 278     $c->stash->{rest} = { plots => \@data };
 279 }
 280
 281 sub trial_plants : Chained('trial') PathPart('plants') Args(0) {
 282     my $self = shift;
 283     my $c = shift;
 284     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 285
 286     my $trial = CXGN::Trial->new( { bcs_schema => $schema, trial_id => $c->stash->{trial_id} });
 287
 288     my @data = $trial->get_plants();
 289
 290     $c->stash->{rest} = { plants => \@data };
 291 }
 292
 293 sub trial_design : Chained('trial') PathPart('design') Args(0) {
 294     my $self = shift;
 295     my $c = shift;
 296     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 297
 298     my $layout = CXGN::Trial::TrialLayout->new({ schema => $schema, trial_id =>$c->stash->{trial_id} });
 299
 300     my $design = $layout->get_design();
 301     my $design_type = $layout->get_design_type();
 302     my $plot_dimensions = $layout->get_plot_dimensions();
 303
 304     my $plot_length = '';
 305     if ($plot_dimensions->[0]) {
 306         $plot_length = $plot_dimensions->[0];
 307     }
 308
 309     my $plot_width = '';
 310     if ($plot_dimensions->[1]){
 311         $plot_width = $plot_dimensions->[1];
 312     }
 313
 314     my $plants_per_plot = '';
 315     if ($plot_dimensions->[2]){
 316         $plants_per_plot = $plot_dimensions->[2];
 317     }
 318
 319     my $block_numbers = $layout->get_block_numbers();
 320     my $number_of_blocks = '';
 321     if ($block_numbers) {
 322       $number_of_blocks = scalar(@{$block_numbers});
 323     }
 324
 325     my $replicate_numbers = $layout->get_replicate_numbers();
 326     my $number_of_replicates = '';
 327     if ($replicate_numbers) {
 328       $number_of_replicates = scalar(@{$replicate_numbers});
 329     }
 330
 331     $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 };
 332 }
 333
 334 sub get_spatial_layout : Chained('trial') PathPart('coords') Args(0) {
 335
 336     my $self = shift;
 337     my $c = shift;
 338     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 339
 340     my $layout = CXGN::Trial::TrialLayout->new(
 341         {
 342             schema => $schema,
 343             trial_id =>$c->stash->{trial_id}
 344         });
 345
 346     my $design = $layout-> get_design();
 347
 348     #print STDERR Dumper($design);
 349
 350     my @layout_info;
 351     foreach my $plot_number (keys %{$design}) {
 352         push @layout_info, {
 353                         plot_id => $design->{$plot_number}->{plot_id},
 354                         plot_number => $plot_number,
 355                         row_number => $design->{$plot_number}->{row_number},
 356                         col_number => $design->{$plot_number}->{col_number},
 357                         block_number=> $design->{$plot_number}-> {block_number},
 358                         rep_number =>  $design->{$plot_number}-> {rep_number},
 359                         plot_name => $design->{$plot_number}-> {plot_name},
 360                         accession_name => $design->{$plot_number}-> {accession_name},
 361
 362         };
 363
 364     }
 365
 366         my @row_numbers = ();
 367         my @col_numbers = ();
 368         my @rep_numbers = ();
 369         my @block_numbers = ();
 370         my @accession_name = ();
 371         my @plot_name = ();
 372         my @plot_id = ();
 373         my @array_msg = ();
 374         my @plot_number = ();
 375         my $my_hash;
 376
 377         foreach $my_hash (@layout_info) {
 378             if ($my_hash->{'row_number'}) {
 379                 if ($my_hash->{'row_number'} =~ m/\d+/) {
 380                 $array_msg[$my_hash->{'row_number'}-1][$my_hash->{'col_number'}-1] = "rep_number: ".$my_hash->{'rep_number'}."\nblock_number: ".$my_hash->{'block_number'}."\nrow_number: ".$my_hash->{'row_number'}."\ncol_number: ".$my_hash->{'col_number'}."\naccession_name: ".$my_hash->{'accession_name'};
 381
 382
 383         $plot_id[$my_hash->{'row_number'}-1][$my_hash->{'col_number'}-1] = $my_hash->{'plot_id'};
 384         #$plot_id[$my_hash->{'plot_number'}] = $my_hash->{'plot_id'};
 385         $plot_number[$my_hash->{'row_number'}-1][$my_hash->{'col_number'}-1] = $my_hash->{'plot_number'};
 386         #$plot_number[$my_hash->{'plot_number'}] = $my_hash->{'plot_number'};
 387
 388                 }
 389                 else {
 390                 }
 391             }
 392         }
 393  # Looping through the hash and printing out all the hash elements.
 394
 395     foreach $my_hash (@layout_info) {
 396         push @col_numbers, $my_hash->{'col_number'};
 397         push @row_numbers, $my_hash->{'row_number'};
 398         #push @plot_id, $my_hash->{'plot_id'};
 399         #push @plot_number, $my_hash->{'plot_number'};
 400         push @rep_numbers, $my_hash->{'rep_number'};
 401         push @block_numbers, $my_hash->{'block_number'};
 402         push @accession_name, $my_hash->{'accession_name'};
 403         push @plot_name, $my_hash->{'plot_name'};
 404
 405     }
 406
 407
 408     my $max_col = 0;
 409     $max_col = max( @col_numbers ) if (@col_numbers);
 410     #print "$max_col\n";
 411     my $max_row = 0;
 412     $max_row = max( @row_numbers ) if (@row_numbers);
 413     #print "$max_row\n";
 414
 415     #print STDERR Dumper \@layout_info;
 416
 417         $c->stash->{rest} = { coord_row =>  \@row_numbers,
 418                               coords =>  \@layout_info,
 419                               coord_col =>  \@col_numbers,
 420                               max_row => $max_row,
 421                               max_col => $max_col,
 422                               plot_msg => \@array_msg,
 423                               rep => \@rep_numbers,
 424                               block => \@block_numbers,
 425                               accessions => \@accession_name,
 426                               plot_name => \@plot_name,
 427                               plot_id => \@plot_id,
 428                               plot_number => \@plot_number
 429         };
 430
 431 }
 432
 433 sub compute_derive_traits : Path('/ajax/phenotype/delete_field_coords') Args(0) {
 434
 435   my $self = shift;
 436         my $c = shift;
 437         my $trial_id = $c->req->param('trial_id');
 438   print "TRIALID: $trial_id\n";
 439
 440   my $schema = $c->dbic_schema('Bio::Chado::Schema');
 441   my $dbh = $c->dbc->dbh();
 442
 443   if (!$c->user()) {
 444                 print STDERR "User not logged in... not deleting field map.\n";
 445                 $c->stash->{rest} = {error => "You need to be logged in to delete field map." };
 446                 return;
 447         }
 448
 449         if (!any { $_ eq "curator" || $_ eq "submitter" } ($c->user()->roles)  ) {
 450                 $c->stash->{rest} = {error =>  "You have insufficient privileges to delete field map." };
 451                 return;
 452         }
 453
 454   my $h = $dbh->prepare("delete from stockprop where stockprop.stockprop_id IN (select stockprop.stockprop_id from project join nd_experiment_project using(project_id) join nd_experiment_stock using(nd_experiment_id) join stock using(stock_id) join stockprop on(stock.stock_id=stockprop.stock_id) where (stockprop.type_id IN (select cvterm_id from cvterm where name='col_number') or stockprop.type_id IN (select cvterm_id from cvterm where name='row_number')) and project.project_id=? and stock.type_id IN (select cvterm_id from cvterm join cv using(cv_id) where cv.name = 'stock_type' and cvterm.name ='plot'));");
 455   my ($row_number, $col_number, $cvterm_id, @cvterm );
 456   $h->execute($trial_id);
 457
 458   $c->stash->{rest} = {success => 1};
 459
 460 }
 461
 462
 463 sub create_plant_subplots : Chained('trial') PathPart('create_subplots') Args(0) {
 464     my $self = shift;
 465     my $c = shift;
 466     my $plants_per_plot = $c->req->param("plants_per_plot") || 8;
 467
 468     if (my $error = $self->delete_privileges_denied($c)) {
 469         $c->stash->{rest} = { error => $error };
 470         return;
 471     }
 472
 473     if (!$plants_per_plot || $plants_per_plot > 50) {
 474         $c->stash->{rest} = { error => "Plants per plot number is required and must be smaller than 20." };
 475         return;
 476     }
 477
 478     my $t = CXGN::Trial->new( { bcs_schema => $c->dbic_schema("Bio::Chado::Schema"), trial_id => $c->stash->{trial_id} });
 479
 480     if ($t->create_plant_entities($plants_per_plot)) {
 481         $c->stash->{rest} = {success => 1};
 482         return;
 483     } else {
 484         $c->stash->{rest} = { error => "Error creating plant entries in controller." };
 485         return;
 486     }
 487
 488 }
 489
 490
 491 sub delete_privileges_denied {
 492     my $self = shift;
 493     my $c = shift;
 494
 495     my $trial_id = $c->stash->{trial_id};
 496
 497     if (! $c->user) { return "Login required for delete functions."; }
 498     my $user_id = $c->user->get_object->get_sp_person_id();
 499
 500     if ($c->user->check_roles('curator')) {
 501         return 0;
 502     }
 503
 504     my $breeding_programs = $c->stash->{trial}->get_breeding_programs();
 505
 506     if ( ($c->user->check_roles('submitter')) && ( $c->user->check_roles($breeding_programs->[0]->[1]))) {
 507         return 0;
 508     }
 509     return "You have insufficient privileges to modify or delete this trial.";
 510 }
 511
 512 # loading field coordinates
 513
 514 sub upload_trial_coordinates : Path('/ajax/breeders/trial/coordsupload') Args(0) {
 515
 516     my $self = shift;
 517     my $c = shift;
 518
 519     if (!$c->user()) {
 520         print STDERR "User not logged in... not uploading coordinates.\n";
 521         $c->stash->{rest} = {error => "You need to be logged in to upload coordinates." };
 522         return;
 523     }
 524
 525     if (!any { $_ eq "curator" || $_ eq "submitter" } ($c->user()->roles)  ) {
 526         $c->stash->{rest} = {error =>  "You have insufficient privileges to add coordinates." };
 527         return;
 528     }
 529
 530     my $time = DateTime->now();
 531     my $user_id = $c->user()->get_object()->get_sp_person_id();
 532     my $user_name = $c->user()->get_object()->get_username();
 533     my $timestamp = $time->ymd()."_".$time->hms();
 534     my $subdirectory = 'trial_coords_upload';
 535
 536     my $upload = $c->req->upload('trial_coordinates_uploaded_file');
 537     my $upload_tempfile  = $upload->tempname;
 538
 539     my $upload_original_name  = $upload->filename();
 540     my $md5;
 541
 542     my $uploader = CXGN::UploadFile->new();
 543
 544     my %upload_metadata;
 545
 546
 547     # Store uploaded temporary file in archive
 548     print STDERR "TEMP FILE: $upload_tempfile\n";
 549     my $archived_filename_with_path = $uploader->archive($c, $subdirectory, $upload_tempfile, $upload_original_name, $timestamp);
 550
 551     if (!$archived_filename_with_path) {
 552         $c->stash->{rest} = {error => "Could not save file $upload_original_name in archive",};
 553         return;
 554     }
 555
 556     $md5 = $uploader->get_md5($archived_filename_with_path);
 557     unlink $upload_tempfile;
 558
 559    # open file and remove return of line
 560
 561      open(my $F, "<", $archived_filename_with_path) || die "Can't open archive file $archived_filename_with_path";
 562     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 563     my $header = <$F>;
 564     while (<$F>) {
 565         chomp;
 566         $_ =~ s/\r//g;
 567         my ($plot,$row,$col) = split /\t/ ;
 568
 569         my $rs = $schema->resultset("Stock::Stock")->search({uniquename=> $plot });
 570
 571         if ($rs->count()== 1) {
 572         my $r =  $rs->first();
 573         print STDERR "The plots $plot was found.\n Loading row $row col $col\n";
 574         $r->create_stockprops({row_number => $row, col_number => $col}, {autocreate => 1});
 575     }
 576
 577     else {
 578
 579         print STDERR "WARNING! $plot was not found in the database.\n";
 580
 581     }
 582
 583     }
 584
 585     $c->stash->{rest} = {success => 1};
 586
 587
 588 }
 589
 590
 591
 592 1;