lib/SGN/Controller/AJAX/HighDimensionalPhenotypes.pm

   1 use strict;
   2
   3 package SGN::Controller::AJAX::HighDimensionalPhenotypes;
   4
   5 use Moose;
   6 use Data::Dumper;
   7 use File::Temp qw | tempfile |;
   8 # use File::Slurp;
   9 use File::Spec qw | catfile|;
  10 use File::Basename qw | basename |;
  11 use File::Copy;
  12 use CXGN::Dataset;
  13 use CXGN::Dataset::File;
  14 use CXGN::Tools::Run;
  15 use CXGN::Tools::List qw/distinct evens/;
  16 use Cwd qw(cwd);
  17 use JSON::XS;
  18 use List::Util qw(shuffle);
  19 use CXGN::AnalysisModel::GetModel;
  20 use CXGN::UploadFile;
  21 use DateTime;
  22 use CXGN::Phenotypes::StorePhenotypes;
  23 use CXGN::Phenotypes::HighDimensionalPhenotypesSearch;
  24 use CXGN::Phenotypes::HighDimensionalPhenotypesRelationshipMatrix;
  25
  26 BEGIN { extends 'Catalyst::Controller::REST' }
  27
  28 __PACKAGE__->config(
  29     default   => 'application/json',
  30     stash_key => 'rest',
  31     map       => { 'application/json' => 'JSON', 'text/html' => 'JSON' },
  32 );
  33
  34 sub high_dimensional_phenotypes_nirs_upload_verify : Path('/ajax/highdimensionalphenotypes/nirs_upload_verify') : ActionClass('REST') { }
  35 sub high_dimensional_phenotypes_nirs_upload_verify_POST : Args(0) {
  36     my $self = shift;
  37     my $c = shift;
  38     print STDERR Dumper $c->req->params();
  39     my $schema = $c->dbic_schema("Bio::Chado::Schema");
  40     my $metadata_schema = $c->dbic_schema("CXGN::Metadata::Schema");
  41     my $phenome_schema = $c->dbic_schema("CXGN::Phenome::Schema");
  42     my ($user_id, $user_name, $user_type) = _check_user_login($c);
  43     my @success_status;
  44     my @error_status;
  45     my @warning_status;
  46
  47     my $parser = CXGN::Phenotypes::ParseUpload->new();
  48     my $validate_type = "spreadsheet nirs";
  49     my $metadata_file_type = "nirs spreadsheet";
  50     my $subdirectory = "spreadsheet_phenotype_upload";
  51     my $timestamp_included;
  52
  53     my $protocol_id = $c->req->param('upload_nirs_spreadsheet_protocol_id');
  54     my $protocol_name = $c->req->param('upload_nirs_spreadsheet_protocol_name');
  55     my $protocol_desc = $c->req->param('upload_nirs_spreadsheet_protocol_desc');
  56     my $protocol_device_type = $c->req->param('upload_nirs_spreadsheet_protocol_device_type');
  57
  58     if ($protocol_id && $protocol_name) {
  59         $c->stash->{rest} = {error => ["Please give a protocol name or select a previous protocol, not both!"]};
  60         $c->detach();
  61     }
  62     if (!$protocol_id && (!$protocol_name || !$protocol_desc)) {
  63         $c->stash->{rest} = {error => ["Please give a protocol name and description, or select a previous protocol!"]};
  64         $c->detach();
  65     }
  66     if ($protocol_name && !$protocol_device_type) {
  67         $c->stash->{rest} = {error => ["Please give a NIRS device type to save a new protocol!"]};
  68         $c->detach();
  69     }
  70
  71     my $high_dim_nirs_protocol_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'high_dimensional_phenotype_nirs_protocol', 'protocol_type')->cvterm_id();
  72     my $high_dim_nirs_protocol_prop_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'high_dimensional_phenotype_protocol_properties', 'protocol_property')->cvterm_id();
  73
  74     if ($protocol_id) {
  75         my $protocol_prop_json = decode_json $schema->resultset('NaturalDiversity::NdProtocolprop')->search({nd_protocol_id=>$protocol_id, type_id=>$high_dim_nirs_protocol_prop_cvterm_id})->first->value;
  76         $protocol_device_type = $protocol_prop_json->{device_type};
  77     }
  78
  79     my $data_level = $c->req->param('upload_nirs_spreadsheet_data_level') || 'tissue_samples';
  80     my $upload = $c->req->upload('upload_nirs_spreadsheet_file_input');
  81
  82     my $upload_original_name = $upload->filename();
  83     my $upload_tempfile = $upload->tempname;
  84     my $time = DateTime->now();
  85     my $timestamp = $time->ymd()."_".$time->hms();
  86
  87     my $uploader = CXGN::UploadFile->new({
  88         tempfile => $upload_tempfile,
  89         subdirectory => $subdirectory,
  90         archive_path => $c->config->{archive_path},
  91         archive_filename => $upload_original_name,
  92         timestamp => $timestamp,
  93         user_id => $user_id,
  94         user_role => $user_type
  95     });
  96     my $archived_filename_with_path = $uploader->archive();
  97     my $md5 = $uploader->get_md5($archived_filename_with_path);
  98     if (!$archived_filename_with_path) {
  99         push @error_status, "Could not save file $upload_original_name in archive.";
 100         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
 101         $c->detach();
 102     } else {
 103         push @success_status, "File $upload_original_name saved in archive.";
 104     }
 105     unlink $upload_tempfile;
 106
 107     my $archived_image_zipfile_with_path;
 108     my $nd_protocol_filename;
 109     my $validate_file = $parser->validate($validate_type, $archived_filename_with_path, $timestamp_included, $data_level, $schema, $archived_image_zipfile_with_path, $protocol_id, $nd_protocol_filename);
 110     if (!$validate_file) {
 111         push @error_status, "Archived file not valid: $upload_original_name.";
 112         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
 113         $c->detach();
 114     }
 115     if ($validate_file == 1){
 116         push @success_status, "File valid: $upload_original_name.";
 117     } else {
 118         if ($validate_file->{'error'}) {
 119             push @error_status, $validate_file->{'error'};
 120         }
 121         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
 122         $c->detach();
 123     }
 124
 125     ## Set metadata
 126     my %phenotype_metadata;
 127     $phenotype_metadata{'archived_file'} = $archived_filename_with_path;
 128     $phenotype_metadata{'archived_file_type'} = $metadata_file_type;
 129     $phenotype_metadata{'operator'} = $user_name;
 130     $phenotype_metadata{'date'} = $timestamp;
 131
 132     my $parsed_file = $parser->parse($validate_type, $archived_filename_with_path, $timestamp_included, $data_level, $schema, $archived_image_zipfile_with_path, $user_id, $c, $protocol_id, $nd_protocol_filename);
 133     if (!$parsed_file) {
 134         push @error_status, "Error parsing file $upload_original_name.";
 135         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
 136         $c->detach();
 137     }
 138     if ($parsed_file->{'error'}) {
 139         push @error_status, $parsed_file->{'error'};
 140         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
 141         $c->detach();
 142     }
 143     my %parsed_data;
 144     my @plots;
 145     my @wavelengths;
 146     if (scalar(@error_status) == 0) {
 147         if ($parsed_file && !$parsed_file->{'error'}) {
 148             %parsed_data = %{$parsed_file->{'data'}};
 149             @plots = @{$parsed_file->{'units'}};
 150             @wavelengths = @{$parsed_file->{'variables'}};
 151             push @success_status, "File data successfully parsed.";
 152         }
 153     }
 154
 155     my @filter_input;
 156     while (my ($stock_name, $o) = each %parsed_data) {
 157         my $device_id = $o->{nirs}->{device_id};
 158         my $comments = $o->{nirs}->{comments};
 159         my $spectras = $o->{nirs}->{spectra};
 160         foreach my $spectra (@$spectras) {
 161             push @filter_input, {
 162                 "observationUnitId" => $stock_name,
 163                 "device_type" => $protocol_device_type,
 164                 "nirs_spectra" => $spectra,
 165             };
 166         }
 167     }
 168
 169     my $nirs_dir = $c->tempfiles_subdir('/nirs_files');
 170     my $tempfile_string = $c->tempfile( TEMPLATE => 'nirs_files/fileXXXX');
 171     my $filter_json_filepath = $c->config->{basepath}.$tempfile_string."_input_json";
 172     my $output_csv_filepath = $c->config->{basepath}.$tempfile_string."_output.csv";
 173     my $output_raw_csv_filepath = $c->config->{basepath}.$tempfile_string."_output_raw.csv";
 174     my $output_outliers_filepath = $c->config->{basepath}.$tempfile_string."_output_outliers.csv";
 175
 176     my $output_plot_filepath_string = $tempfile_string."_output_plot.png";
 177     my $output_plot_filepath = $c->config->{basepath}.$output_plot_filepath_string;
 178
 179     my $json = JSON->new->utf8->canonical();
 180     my $filter_data_input_json = $json->encode(\@filter_input);
 181     open(my $F, '>', $filter_json_filepath);
 182         print STDERR Dumper $filter_json_filepath;
 183         print $F $filter_data_input_json;
 184     close($F);
 185
 186     my $cmd_s = "Rscript ".$c->config->{basepath} . "/R/Nirs/nirs_upload_filter_aggregate.R '$filter_json_filepath' '$output_csv_filepath' '$output_raw_csv_filepath' '$output_plot_filepath' '$output_outliers_filepath' ";
 187     print STDERR $cmd_s;
 188     my $cmd_status = system($cmd_s);
 189
 190     my $parsed_file_agg = $parser->parse($validate_type, $output_csv_filepath, $timestamp_included, $data_level, $schema, $archived_image_zipfile_with_path, $user_id, $c, $protocol_id, $nd_protocol_filename);
 191     if (!$parsed_file_agg) {
 192         push @error_status, "Error parsing aggregated file.";
 193         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
 194         $c->detach();
 195     }
 196     if ($parsed_file_agg->{'error'}) {
 197         push @error_status, $parsed_file_agg->{'error'};
 198         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
 199         $c->detach();
 200     }
 201     my %parsed_data_agg;
 202     my @plots_agg;
 203     my @wavelengths_agg;
 204     if (scalar(@error_status) == 0) {
 205         if ($parsed_file_agg && !$parsed_file_agg->{'error'}) {
 206             %parsed_data_agg = %{$parsed_file_agg->{'data'}};
 207             @plots_agg = @{$parsed_file_agg->{'units'}};
 208             @wavelengths_agg = @{$parsed_file_agg->{'variables'}};
 209             push @success_status, "Aggregated file data successfully parsed.";
 210         }
 211     }
 212
 213     my $pheno_dir = $c->tempfiles_subdir('/delete_nd_experiment_ids');
 214     my $temp_file_nd_experiment_id = $c->config->{basepath}."/".$c->tempfile( TEMPLATE => 'delete_nd_experiment_ids/fileXXXX');
 215
 216     my $store_phenotypes = CXGN::Phenotypes::StorePhenotypes->new({
 217         basepath=>$c->config->{basepath},
 218         dbhost=>$c->config->{dbhost},
 219         dbname=>$c->config->{dbname},
 220         dbuser=>$c->config->{dbuser},
 221         dbpass=>$c->config->{dbpass},
 222         temp_file_nd_experiment_id=>$temp_file_nd_experiment_id,
 223         bcs_schema=>$schema,
 224         metadata_schema=>$metadata_schema,
 225         phenome_schema=>$phenome_schema,
 226         user_id=>$user_id,
 227         stock_list=>\@plots_agg,
 228         trait_list=>[],
 229         values_hash=>\%parsed_data_agg,
 230         has_timestamps=>0,
 231         metadata_hash=>\%phenotype_metadata,
 232         composable_validation_check_name=>$c->config->{composable_validation_check_name}
 233     });
 234
 235     my $warning_status;
 236     my ($verified_warning, $verified_error) = $store_phenotypes->verify();
 237     if ($verified_error) {
 238         push @error_status, $verified_error;
 239         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
 240         $c->detach();
 241     }
 242     if ($verified_warning) {
 243         push @warning_status, $verified_warning;
 244     }
 245     push @success_status, "Aggregated file data verified. Plot names and trait names are valid.";
 246
 247     # print STDERR Dumper \@success_status;
 248     # print STDERR Dumper \@warning_status;
 249     # print STDERR Dumper \@error_status;
 250     # print STDERR Dumper $output_plot_filepath_string;
 251     $c->stash->{rest} = {success => \@success_status, warning => \@warning_status, error => \@error_status, figure => $output_plot_filepath_string};
 252 }
 253
 254 sub high_dimensional_phenotypes_nirs_upload_store : Path('/ajax/highdimensionalphenotypes/nirs_upload_store') : ActionClass('REST') { }
 255 sub high_dimensional_phenotypes_nirs_upload_store_POST : Args(0) {
 256     my $self = shift;
 257     my $c = shift;
 258     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 259     my $metadata_schema = $c->dbic_schema("CXGN::Metadata::Schema");
 260     my $phenome_schema = $c->dbic_schema("CXGN::Phenome::Schema");
 261     my ($user_id, $user_name, $user_type) = _check_user_login($c);
 262     my @success_status;
 263     my @error_status;
 264     my @warning_status;
 265
 266     my $parser = CXGN::Phenotypes::ParseUpload->new();
 267     my $validate_type = "spreadsheet nirs";
 268     my $metadata_file_type = "nirs spreadsheet";
 269     my $subdirectory = "spreadsheet_phenotype_upload";
 270     my $timestamp_included;
 271
 272     my $protocol_id = $c->req->param('upload_nirs_spreadsheet_protocol_id');
 273     my $protocol_name = $c->req->param('upload_nirs_spreadsheet_protocol_name');
 274     my $protocol_desc = $c->req->param('upload_nirs_spreadsheet_protocol_desc');
 275     my $protocol_device_type = $c->req->param('upload_nirs_spreadsheet_protocol_device_type');
 276
 277     if ($protocol_id && $protocol_name) {
 278         $c->stash->{rest} = {error => ["Please give a protocol name or select a previous protocol, not both!"]};
 279         $c->detach();
 280     }
 281     if (!$protocol_id && (!$protocol_name || !$protocol_desc)) {
 282         $c->stash->{rest} = {error => ["Please give a protocol name and description, or select a previous protocol!"]};
 283         $c->detach();
 284     }
 285     if ($protocol_name && !$protocol_device_type) {
 286         $c->stash->{rest} = {error => ["Please give a NIRS device type to save a new protocol!"]};
 287         $c->detach();
 288     }
 289
 290     my $high_dim_nirs_protocol_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'high_dimensional_phenotype_nirs_protocol', 'protocol_type')->cvterm_id();
 291     my $high_dim_nirs_protocol_prop_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'high_dimensional_phenotype_protocol_properties', 'protocol_property')->cvterm_id();
 292
 293     if ($protocol_id) {
 294         my $protocol_prop_json = decode_json $schema->resultset('NaturalDiversity::NdProtocolprop')->search({nd_protocol_id=>$protocol_id, type_id=>$high_dim_nirs_protocol_prop_cvterm_id})->first->value;
 295         $protocol_device_type = $protocol_prop_json->{device_type};
 296     }
 297
 298     my $data_level = $c->req->param('upload_nirs_spreadsheet_data_level') || 'tissue_samples';
 299     my $upload = $c->req->upload('upload_nirs_spreadsheet_file_input');
 300
 301     my $upload_original_name = $upload->filename();
 302     my $upload_tempfile = $upload->tempname;
 303     my $time = DateTime->now();
 304     my $timestamp = $time->ymd()."_".$time->hms();
 305
 306     my $uploader = CXGN::UploadFile->new({
 307         tempfile => $upload_tempfile,
 308         subdirectory => $subdirectory,
 309         archive_path => $c->config->{archive_path},
 310         archive_filename => $upload_original_name,
 311         timestamp => $timestamp,
 312         user_id => $user_id,
 313         user_role => $user_type
 314     });
 315     my $archived_filename_with_path = $uploader->archive();
 316     my $md5 = $uploader->get_md5($archived_filename_with_path);
 317     if (!$archived_filename_with_path) {
 318         push @error_status, "Could not save file $upload_original_name in archive.";
 319         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
 320         $c->detach();
 321     } else {
 322         push @success_status, "File $upload_original_name saved in archive.";
 323     }
 324     unlink $upload_tempfile;
 325
 326     my $archived_image_zipfile_with_path;
 327     my $nd_protocol_filename;
 328     my $validate_file = $parser->validate($validate_type, $archived_filename_with_path, $timestamp_included, $data_level, $schema, $archived_image_zipfile_with_path, $protocol_id, $nd_protocol_filename);
 329     if (!$validate_file) {
 330         push @error_status, "Archived file not valid: $upload_original_name.";
 331         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
 332         $c->detach();
 333     }
 334     if ($validate_file == 1){
 335         push @success_status, "File valid: $upload_original_name.";
 336     } else {
 337         if ($validate_file->{'error'}) {
 338             push @error_status, $validate_file->{'error'};
 339         }
 340         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
 341         $c->detach();
 342     }
 343
 344     my $parsed_file = $parser->parse($validate_type, $archived_filename_with_path, $timestamp_included, $data_level, $schema, $archived_image_zipfile_with_path, $user_id, $c, $protocol_id, $nd_protocol_filename);
 345     if (!$parsed_file) {
 346         push @error_status, "Error parsing file $upload_original_name.";
 347         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
 348         $c->detach();
 349     }
 350     if ($parsed_file->{'error'}) {
 351         push @error_status, $parsed_file->{'error'};
 352         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
 353         $c->detach();
 354     }
 355     my %parsed_data;
 356     my @plots;
 357     my @wavelengths;
 358     if (scalar(@error_status) == 0) {
 359         if ($parsed_file && !$parsed_file->{'error'}) {
 360             %parsed_data = %{$parsed_file->{'data'}};
 361             @plots = @{$parsed_file->{'units'}};
 362             @wavelengths = @{$parsed_file->{'variables'}};
 363             push @success_status, "File data successfully parsed.";
 364         }
 365     }
 366
 367     my @filter_input;
 368     while (my ($stock_name, $o) = each %parsed_data) {
 369         my $device_id = $o->{nirs}->{device_id};
 370         my $comments = $o->{nirs}->{comments};
 371         my $spectras = $o->{nirs}->{spectra};
 372         foreach my $spectra (@$spectras) {
 373             push @filter_input, {
 374                 "observationUnitId" => $stock_name,
 375                 "device_type" => $protocol_device_type,
 376                 "nirs_spectra" => $spectra
 377             };
 378         }
 379     }
 380
 381     my $dir = $c->tempfiles_subdir('/nirs_files');
 382     my $tempfile = $c->config->{basepath}."/".$c->tempfile( TEMPLATE => 'nirs_files/fileXXXX');
 383
 384     my $filter_json_filepath = $tempfile."_input_json";
 385     my $output_csv_filepath = $tempfile."_output.csv";
 386     my $output_raw_csv_filepath = $tempfile."_output_raw.csv";
 387     my $output_outliers_filepath = $tempfile."_output_outliers.csv";
 388
 389     my $tempfile_string = $c->tempfile( TEMPLATE => 'nirs_files/fileXXXX');
 390     my $output_plot_filepath_string = $tempfile_string."_output_plot.png";
 391     my $output_plot_filepath = $c->config->{basepath}."/".$output_plot_filepath_string;
 392
 393     my $json = JSON->new->utf8->canonical();
 394     my $filter_data_input_json = $json->encode(\@filter_input);
 395     open(my $F, '>', $filter_json_filepath);
 396         print STDERR Dumper $filter_json_filepath;
 397         print $F $filter_data_input_json;
 398     close($F);
 399
 400     my $cmd_s = "Rscript ".$c->config->{basepath} . "/R/Nirs/nirs_upload_filter_aggregate.R '$filter_json_filepath' '$output_csv_filepath' '$output_raw_csv_filepath' '$output_plot_filepath' '$output_outliers_filepath' ";
 401     print STDERR $cmd_s;
 402     my $cmd_status = system($cmd_s);
 403
 404     my %parsed_data_agg;
 405
 406     # Just use one of the spectra:
 407     #while (my ($stock_name, $o) = each %parsed_data) {
 408     #    my $spectras = $o->{nirs}->{spectra};
 409     #    $parsed_data_agg{$stock_name}->{nirs}->{device_type} = $o->{nirs}->{device_type};
 410     #    $parsed_data_agg{$stock_name}->{nirs}->{spectra} = $spectras->[0];
 411     #}
 412
 413     my $agg_file_name =  basename($output_csv_filepath);
 414
 415     my $uploader_agg = CXGN::UploadFile->new({
 416         tempfile => $output_csv_filepath,
 417         subdirectory => $subdirectory,
 418         archive_path => $c->config->{archive_path},
 419         archive_filename => $agg_file_name,
 420         timestamp => $timestamp,
 421         user_id => $user_id,
 422         user_role => $user_type
 423     });
 424     my $archived_agg_filename_with_path = $uploader->archive();
 425     my $md5_agg = $uploader_agg->get_md5($archived_agg_filename_with_path);
 426     if (!$archived_agg_filename_with_path) {
 427         push @error_status, "Could not save file $agg_file_name in archive.";
 428         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
 429         $c->detach();
 430     } else {
 431         push @success_status, "File $agg_file_name saved in archive.";
 432     }
 433     unlink $output_csv_filepath;
 434
 435     # Using aggregated spectra:
 436     my $parsed_file_agg = $parser->parse($validate_type, $archived_agg_filename_with_path, $timestamp_included, $data_level, $schema, $archived_image_zipfile_with_path, $user_id, $c, $protocol_id, $nd_protocol_filename);
 437     if (!$parsed_file_agg) {
 438         push @error_status, "Error parsing aggregated file.";
 439         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
 440         $c->detach();
 441     }
 442     if ($parsed_file_agg->{'error'}) {
 443         push @error_status, $parsed_file_agg->{'error'};
 444         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
 445         $c->detach();
 446     }
 447     my @plots_agg;
 448     my @wavelengths_agg;
 449     if (scalar(@error_status) == 0) {
 450         if ($parsed_file_agg && !$parsed_file_agg->{'error'}) {
 451             %parsed_data_agg = %{$parsed_file_agg->{'data'}};
 452             @plots_agg = @{$parsed_file_agg->{'units'}};
 453             @wavelengths_agg = @{$parsed_file_agg->{'variables'}};
 454             push @success_status, "Aggregated file data successfully parsed.";
 455         }
 456     }
 457
 458     if (!$protocol_id) {
 459         my %nirs_protocol_prop = (
 460             device_type => $protocol_device_type,
 461             header_column_names => \@wavelengths_agg,
 462             header_column_details => {}
 463         );
 464
 465         my $protocol = $schema->resultset('NaturalDiversity::NdProtocol')->create({
 466             name => $protocol_name,
 467             type_id => $high_dim_nirs_protocol_cvterm_id,
 468             nd_protocolprops => [{type_id => $high_dim_nirs_protocol_prop_cvterm_id, value => encode_json \%nirs_protocol_prop}]
 469         });
 470         $protocol_id = $protocol->nd_protocol_id();
 471
 472         my $desc_q = "UPDATE nd_protocol SET description=? WHERE nd_protocol_id=?;";
 473         my $dbh = $schema->storage->dbh()->prepare($desc_q);
 474         $dbh->execute($protocol_desc, $protocol_id);
 475     }
 476
 477     my %parsed_data_agg_coalesced;
 478     while (my ($stock_name, $o) = each %parsed_data_agg) {
 479         my $device_id = $o->{nirs}->{device_id};
 480         my $comments = $o->{nirs}->{comments};
 481         my $spectras = $o->{nirs}->{spectra};
 482         $parsed_data_agg_coalesced{$stock_name}->{nirs}->{protocol_id} = $protocol_id;
 483         $parsed_data_agg_coalesced{$stock_name}->{nirs}->{device_type} = $protocol_device_type;
 484         $parsed_data_agg_coalesced{$stock_name}->{nirs}->{device_id} = $device_id;
 485         $parsed_data_agg_coalesced{$stock_name}->{nirs}->{comments} = $comments;
 486         $parsed_data_agg_coalesced{$stock_name}->{nirs}->{spectra} = $spectras->[0];
 487     }
 488
 489     ## Set metadata
 490     my %phenotype_metadata;
 491     $phenotype_metadata{'archived_file'} = $archived_agg_filename_with_path;
 492     $phenotype_metadata{'archived_file_type'} = $metadata_file_type;
 493     $phenotype_metadata{'operator'} = $user_name;
 494     $phenotype_metadata{'date'} = $timestamp;
 495
 496     my $pheno_dir = $c->tempfiles_subdir('/delete_nd_experiment_ids');
 497     my $temp_file_nd_experiment_id = $c->config->{basepath}."/".$c->tempfile( TEMPLATE => 'delete_nd_experiment_ids/fileXXXX');
 498
 499     # print STDERR Dumper \%parsed_data_agg_coalesced;
 500     my $store_phenotypes = CXGN::Phenotypes::StorePhenotypes->new({
 501         basepath=>$c->config->{basepath},
 502         dbhost=>$c->config->{dbhost},
 503         dbname=>$c->config->{dbname},
 504         dbuser=>$c->config->{dbuser},
 505         dbpass=>$c->config->{dbpass},
 506         temp_file_nd_experiment_id=>$temp_file_nd_experiment_id,
 507         bcs_schema=>$schema,
 508         metadata_schema=>$metadata_schema,
 509         phenome_schema=>$phenome_schema,
 510         user_id=>$user_id,
 511         stock_list=>\@plots_agg,
 512         trait_list=>[],
 513         values_hash=>\%parsed_data_agg_coalesced,
 514         has_timestamps=>0,
 515         metadata_hash=>\%phenotype_metadata,
 516         composable_validation_check_name=>$c->config->{composable_validation_check_name},
 517         allow_repeat_measures=>$c->config->{allow_repeat_measures}
 518     });
 519
 520     my $warning_status;
 521     my ($verified_warning, $verified_error) = $store_phenotypes->verify();
 522     if ($verified_error) {
 523         push @error_status, $verified_error;
 524         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
 525         $c->detach();
 526     }
 527     if ($verified_warning) {
 528         push @warning_status, $verified_warning;
 529     }
 530     push @success_status, "Aggregated file data verified. Plot names and trait names are valid.";
 531
 532     my ($stored_phenotype_error, $stored_phenotype_success) = $store_phenotypes->store();
 533     if ($stored_phenotype_error) {
 534         push @error_status, $stored_phenotype_error;
 535         $c->stash->{rest} = {success => \@success_status, error => \@error_status};
 536         $c->detach();
 537     }
 538     if ($stored_phenotype_success) {
 539         push @success_status, $stored_phenotype_success;
 540     }
 541
 542     push @success_status, "Metadata saved for archived file.";
 543     my $bs = CXGN::BreederSearch->new( { dbh=>$c->dbc->dbh, dbname=>$c->config->{dbname}, } );
 544     my $refresh = $bs->refresh_matviews($c->config->{dbhost}, $c->config->{dbname}, $c->config->{dbuser}, $c->config->{dbpass}, 'fullview', 'concurrent', $c->config->{basepath});
 545
 546     $c->stash->{rest} = {success => \@success_status, error => \@error_status, figure => $output_plot_filepath_string, nd_protocol_id => $protocol_id};
 547 }
 548
 549 sub high_dimensional_phenotypes_transcriptomics_upload_verify : Path('/ajax/highdimensionalphenotypes/transcriptomics_upload_verify') : ActionClass('REST') { }
 550 sub high_dimensional_phenotypes_transcriptomics_upload_verify_POST : Args(0) {
 551     my $self = shift;
 552     my $c = shift;
 553     print STDERR Dumper $c->req->params();
 554     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 555     my $metadata_schema = $c->dbic_schema("CXGN::Metadata::Schema");
 556     my $phenome_schema = $c->dbic_schema("CXGN::Phenome::Schema");
 557     my ($user_id, $user_name, $user_type) = _check_user_login($c);
 558     my @success_status;
 559     my @error_status;
 560     my @warning_status;
 561
 562     my $parser = CXGN::Phenotypes::ParseUpload->new();
 563     my $validate_type = "highdimensionalphenotypes spreadsheet transcriptomics";
 564     my $metadata_file_type = "transcriptomics spreadsheet";
 565     my $subdirectory = "spreadsheet_phenotype_upload";
 566     my $timestamp_included;
 567
 568     my $protocol_id = $c->req->param('upload_transcriptomics_spreadsheet_protocol_id');
 569     my $protocol_name = $c->req->param('upload_transcriptomics_spreadsheet_protocol_name');
 570     my $protocol_desc = $c->req->param('upload_transcriptomics_spreadsheet_protocol_desc');
 571     my $protocol_unit = $c->req->param('upload_transcriptomics_spreadsheet_protocol_unit');
 572     my $protocol_genome_version = $c->req->param('upload_transcriptomics_spreadsheet_protocol_genome');
 573     my $protocol_genome_annotation_version = $c->req->param('upload_transcriptomics_spreadsheet_protocol_annotation');
 574
 575
 576     if ($protocol_id && $protocol_name) {
 577         $c->stash->{rest} = {error => ["Please give a protocol name or select a previous protocol, not both!"]};
 578         $c->detach();
 579     }
 580     if (!$protocol_id && (!$protocol_name || !$protocol_desc || !$protocol_unit || !$protocol_genome_version || !$protocol_genome_annotation_version)) {
 581         $c->stash->{rest} = {error => ["Please give a protocol name, description, unit, genome and annotation version, or select a previous protocol!"]};
 582         $c->detach();
 583     }
 584
 585     my $high_dim_transcriptomics_protocol_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'high_dimensional_phenotype_transcriptomics_protocol', 'protocol_type')->cvterm_id();
 586     my $high_dim_transcriptomics_protocol_prop_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'high_dimensional_phenotype_protocol_properties', 'protocol_property')->cvterm_id();
 587
 588     my $data_level = $c->req->param('upload_transcriptomics_spreadsheet_data_level') || 'tissue_samples';
 589     my $upload = $c->req->upload('upload_transcriptomics_spreadsheet_file_input');
 590     my $transcript_metadata_upload = $c->req->upload('upload_transcriptomics_transcript_metadata_spreadsheet_file_input');
 591
 592     my $upload_original_name = $upload->filename();
 593     my $upload_tempfile = $upload->tempname;
 594     my $time = DateTime->now();
 595     my $timestamp = $time->ymd()."_".$time->hms();
 596
 597     my $uploader = CXGN::UploadFile->new({
 598         tempfile => $upload_tempfile,
 599         subdirectory => $subdirectory,
 600         archive_path => $c->config->{archive_path},
 601         archive_filename => $upload_original_name,
 602         timestamp => $timestamp,
 603         user_id => $user_id,
 604         user_role => $user_type
 605     });
 606     my $archived_filename_with_path = $uploader->archive();
 607     my $md5 = $uploader->get_md5($archived_filename_with_path);
 608     if (!$archived_filename_with_path) {
 609         push @error_status, "Could not save file $upload_original_name in archive.";
 610         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
 611         $c->detach();
 612     } else {
 613         push @success_status, "File $upload_original_name saved in archive.";
 614     }
 615     unlink $upload_tempfile;
 616
 617     my $upload_transcripts_original_name = $transcript_metadata_upload->filename();
 618     my $upload_transcripts_tempfile = $transcript_metadata_upload->tempname;
 619
 620     my $uploader_transcripts = CXGN::UploadFile->new({
 621         tempfile => $upload_transcripts_tempfile,
 622         subdirectory => $subdirectory,
 623         archive_path => $c->config->{archive_path},
 624         archive_filename => $upload_transcripts_original_name,
 625         timestamp => $timestamp,
 626         user_id => $user_id,
 627         user_role => $user_type
 628     });
 629     my $archived_filename_transcripts_with_path = $uploader_transcripts->archive();
 630     my $md5_transcripts = $uploader_transcripts->get_md5($archived_filename_transcripts_with_path);
 631     if (!$archived_filename_transcripts_with_path) {
 632         push @error_status, "Could not save file $upload_transcripts_original_name in archive.";
 633         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
 634         $c->detach();
 635     } else {
 636         push @success_status, "File $upload_transcripts_original_name saved in archive.";
 637     }
 638     unlink $upload_transcripts_tempfile;
 639
 640     my $archived_image_zipfile_with_path;
 641     my $validate_file = $parser->validate($validate_type, $archived_filename_with_path, $timestamp_included, $data_level, $schema, $archived_image_zipfile_with_path, $protocol_id, $archived_filename_transcripts_with_path);
 642     if (!$validate_file) {
 643         push @error_status, "Archived file not valid: $upload_original_name.";
 644         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
 645         $c->detach();
 646     }
 647     if ($validate_file == 1){
 648         push @success_status, "File valid: $upload_original_name.";
 649     } else {
 650         if ($validate_file->{'error'}) {
 651             push @error_status, $validate_file->{'error'};
 652         }
 653         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
 654         $c->detach();
 655     }
 656
 657     ## Set metadata
 658     my %phenotype_metadata;
 659     $phenotype_metadata{'archived_file'} = $archived_filename_with_path;
 660     $phenotype_metadata{'archived_file_type'} = $metadata_file_type;
 661     $phenotype_metadata{'operator'} = $user_name;
 662     $phenotype_metadata{'date'} = $timestamp;
 663
 664     my $parsed_file = $parser->parse($validate_type, $archived_filename_with_path, $timestamp_included, $data_level, $schema, $archived_image_zipfile_with_path, $user_id, $c, $protocol_id, $archived_filename_transcripts_with_path);
 665     if (!$parsed_file) {
 666         push @error_status, "Error parsing file $upload_original_name.";
 667         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
 668         $c->detach();
 669     }
 670     if ($parsed_file->{'error'}) {
 671         push @error_status, $parsed_file->{'error'};
 672         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
 673         $c->detach();
 674     }
 675     my %parsed_data;
 676     my @plots;
 677     my @transcripts;
 678     my %transcripts_details;
 679     if (scalar(@error_status) == 0) {
 680         if ($parsed_file && !$parsed_file->{'error'}) {
 681             %parsed_data = %{$parsed_file->{'data'}};
 682             @plots = @{$parsed_file->{'units'}};
 683             @transcripts = @{$parsed_file->{'variables'}};
 684             %transcripts_details = %{$parsed_file->{'variables_desc'}};
 685             push @success_status, "File data successfully parsed.";
 686         }
 687     }
 688
 689     my $dir = $c->tempfiles_subdir('/delete_nd_experiment_ids');
 690     my $temp_file_nd_experiment_id = $c->config->{basepath}."/".$c->tempfile( TEMPLATE => 'delete_nd_experiment_ids/fileXXXX');
 691
 692     my $store_phenotypes = CXGN::Phenotypes::StorePhenotypes->new({
 693         basepath=>$c->config->{basepath},
 694         dbhost=>$c->config->{dbhost},
 695         dbname=>$c->config->{dbname},
 696         dbuser=>$c->config->{dbuser},
 697         dbpass=>$c->config->{dbpass},
 698         temp_file_nd_experiment_id=>$temp_file_nd_experiment_id,
 699         bcs_schema=>$schema,
 700         metadata_schema=>$metadata_schema,
 701         phenome_schema=>$phenome_schema,
 702         user_id=>$user_id,
 703         stock_list=>\@plots,
 704         trait_list=>[],
 705         values_hash=>\%parsed_data,
 706         has_timestamps=>0,
 707         metadata_hash=>\%phenotype_metadata,
 708         composable_validation_check_name=>$c->config->{composable_validation_check_name}
 709     });
 710
 711     my $warning_status;
 712     my ($verified_warning, $verified_error) = $store_phenotypes->verify();
 713     if ($verified_error) {
 714         push @error_status, $verified_error;
 715         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
 716         $c->detach();
 717     }
 718     if ($verified_warning) {
 719         push @warning_status, $verified_warning;
 720     }
 721     push @success_status, "File data verified. Plot names and trait names are valid.";
 722
 723     # print STDERR Dumper \@success_status;
 724     # print STDERR Dumper \@warning_status;
 725     # print STDERR Dumper \@error_status;
 726     # print STDERR Dumper $output_plot_filepath_string;
 727     $c->stash->{rest} = {success => \@success_status, warning => \@warning_status, error => \@error_status};
 728 }
 729
 730 sub high_dimensional_phenotypes_transcriptomics_upload_store : Path('/ajax/highdimensionalphenotypes/transcriptomics_upload_store') : ActionClass('REST') { }
 731 sub high_dimensional_phenotypes_transcriptomics_upload_store_POST : Args(0) {
 732     my $self = shift;
 733     my $c = shift;
 734     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 735     my $metadata_schema = $c->dbic_schema("CXGN::Metadata::Schema");
 736     my $phenome_schema = $c->dbic_schema("CXGN::Phenome::Schema");
 737     my ($user_id, $user_name, $user_type) = _check_user_login($c);
 738     my @success_status;
 739     my @error_status;
 740     my @warning_status;
 741
 742     my $parser = CXGN::Phenotypes::ParseUpload->new();
 743     my $validate_type = "highdimensionalphenotypes spreadsheet transcriptomics";
 744     my $metadata_file_type = "transcriptomics spreadsheet";
 745     my $subdirectory = "spreadsheet_phenotype_upload";
 746     my $timestamp_included;
 747
 748     my $protocol_id = $c->req->param('upload_transcriptomics_spreadsheet_protocol_id');
 749     my $protocol_name = $c->req->param('upload_transcriptomics_spreadsheet_protocol_name');
 750     my $protocol_desc = $c->req->param('upload_transcriptomics_spreadsheet_protocol_desc');
 751     my $protocol_unit = $c->req->param('upload_transcriptomics_spreadsheet_protocol_unit');
 752     my $protocol_genome_version = $c->req->param('upload_transcriptomics_spreadsheet_protocol_genome');
 753     my $protocol_genome_annotation_version = $c->req->param('upload_transcriptomics_spreadsheet_protocol_annotation');
 754
 755     if ($protocol_id && $protocol_name) {
 756         $c->stash->{rest} = {error => ["Please give a protocol name or select a previous protocol, not both!"]};
 757         $c->detach();
 758     }
 759     if (!$protocol_id && (!$protocol_name || !$protocol_desc || !$protocol_unit || !$protocol_genome_version || !$protocol_genome_annotation_version)) {
 760         $c->stash->{rest} = {error => ["Please give a protocol name, description, unit, genome and annotation version, or select a previous protocol!"]};
 761         $c->detach();
 762     }
 763
 764     my $high_dim_transcriptomics_protocol_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'high_dimensional_phenotype_transcriptomics_protocol', 'protocol_type')->cvterm_id();
 765     my $high_dim_transcriptomics_protocol_prop_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'high_dimensional_phenotype_protocol_properties', 'protocol_property')->cvterm_id();
 766
 767     my $data_level = $c->req->param('upload_transcriptomics_spreadsheet_data_level') || 'tissue_samples';
 768     my $upload = $c->req->upload('upload_transcriptomics_spreadsheet_file_input');
 769     my $transcript_metadata_upload = $c->req->upload('upload_transcriptomics_transcript_metadata_spreadsheet_file_input');
 770
 771     my $upload_original_name = $upload->filename();
 772     my $upload_tempfile = $upload->tempname;
 773     my $time = DateTime->now();
 774     my $timestamp = $time->ymd()."_".$time->hms();
 775
 776     my $uploader = CXGN::UploadFile->new({
 777         tempfile => $upload_tempfile,
 778         subdirectory => $subdirectory,
 779         archive_path => $c->config->{archive_path},
 780         archive_filename => $upload_original_name,
 781         timestamp => $timestamp,
 782         user_id => $user_id,
 783         user_role => $user_type
 784     });
 785     my $archived_filename_with_path = $uploader->archive();
 786     my $md5 = $uploader->get_md5($archived_filename_with_path);
 787     if (!$archived_filename_with_path) {
 788         push @error_status, "Could not save file $upload_original_name in archive.";
 789         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
 790         $c->detach();
 791     } else {
 792         push @success_status, "File $upload_original_name saved in archive.";
 793     }
 794     unlink $upload_tempfile;
 795
 796     my $upload_transcripts_original_name = $transcript_metadata_upload->filename();
 797     my $upload_transcripts_tempfile = $transcript_metadata_upload->tempname;
 798
 799     my $uploader_transcripts = CXGN::UploadFile->new({
 800         tempfile => $upload_transcripts_tempfile,
 801         subdirectory => $subdirectory,
 802         archive_path => $c->config->{archive_path},
 803         archive_filename => $upload_transcripts_original_name,
 804         timestamp => $timestamp,
 805         user_id => $user_id,
 806         user_role => $user_type
 807     });
 808     my $archived_filename_transcripts_with_path = $uploader_transcripts->archive();
 809     my $md5_transcripts = $uploader_transcripts->get_md5($archived_filename_transcripts_with_path);
 810     if (!$archived_filename_transcripts_with_path) {
 811         push @error_status, "Could not save file $upload_transcripts_original_name in archive.";
 812         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
 813         $c->detach();
 814     } else {
 815         push @success_status, "File $upload_transcripts_original_name saved in archive.";
 816     }
 817     unlink $upload_transcripts_tempfile;
 818
 819     my $archived_image_zipfile_with_path;
 820     my $validate_file = $parser->validate($validate_type, $archived_filename_with_path, $timestamp_included, $data_level, $schema, $archived_image_zipfile_with_path, $protocol_id, $archived_filename_transcripts_with_path);
 821     if (!$validate_file) {
 822         push @error_status, "Archived file not valid: $upload_original_name.";
 823         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
 824         $c->detach();
 825     }
 826     if ($validate_file == 1){
 827         push @success_status, "File valid: $upload_original_name.";
 828     } else {
 829         if ($validate_file->{'error'}) {
 830             push @error_status, $validate_file->{'error'};
 831         }
 832         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
 833         $c->detach();
 834     }
 835
 836     my $parsed_file = $parser->parse($validate_type, $archived_filename_with_path, $timestamp_included, $data_level, $schema, $archived_image_zipfile_with_path, $user_id, $c, $protocol_id, $archived_filename_transcripts_with_path);
 837     if (!$parsed_file) {
 838         push @error_status, "Error parsing file $upload_original_name.";
 839         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
 840         $c->detach();
 841     }
 842     if ($parsed_file->{'error'}) {
 843         push @error_status, $parsed_file->{'error'};
 844         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
 845         $c->detach();
 846     }
 847     my %parsed_data;
 848     my @plots;
 849     my @transcripts;
 850     my %transcripts_details;
 851     if (scalar(@error_status) == 0) {
 852         if ($parsed_file && !$parsed_file->{'error'}) {
 853             %parsed_data = %{$parsed_file->{'data'}};
 854             @plots = @{$parsed_file->{'units'}};
 855             @transcripts = @{$parsed_file->{'variables'}};
 856             %transcripts_details = %{$parsed_file->{'variables_desc'}};
 857             push @success_status, "File data successfully parsed.";
 858         }
 859     }
 860
 861     if (!$protocol_id) {
 862         my %transcriptomics_protocol_prop = (
 863             expression_unit => $protocol_unit,
 864             genome_version => $protocol_genome_version,
 865             annotation_version => $protocol_genome_annotation_version,
 866             header_column_names => \@transcripts,
 867             header_column_details => \%transcripts_details
 868         );
 869
 870         my $protocol = $schema->resultset('NaturalDiversity::NdProtocol')->create({
 871             name => $protocol_name,
 872             type_id => $high_dim_transcriptomics_protocol_cvterm_id,
 873             nd_protocolprops => [{type_id => $high_dim_transcriptomics_protocol_prop_cvterm_id, value => encode_json \%transcriptomics_protocol_prop}]
 874         });
 875         $protocol_id = $protocol->nd_protocol_id();
 876
 877         my $desc_q = "UPDATE nd_protocol SET description=? WHERE nd_protocol_id=?;";
 878         my $dbh = $schema->storage->dbh()->prepare($desc_q);
 879         $dbh->execute($protocol_desc, $protocol_id);
 880     }
 881
 882     my %parsed_data_agg_coalesced;
 883     while (my ($stock_name, $o) = each %parsed_data) {
 884         my $device_id = $o->{transcriptomics}->{device_id};
 885         my $comments = $o->{transcriptomics}->{comments};
 886         my $spectras = $o->{transcriptomics}->{transcripts};
 887         $parsed_data_agg_coalesced{$stock_name}->{transcriptomics} = $spectras->[0];
 888         $parsed_data_agg_coalesced{$stock_name}->{transcriptomics}->{protocol_id} = $protocol_id;
 889         $parsed_data_agg_coalesced{$stock_name}->{transcriptomics}->{device_id} = $device_id;
 890         $parsed_data_agg_coalesced{$stock_name}->{transcriptomics}->{comments} = $comments;
 891     }
 892
 893     ## Set metadata
 894     my %phenotype_metadata;
 895     $phenotype_metadata{'archived_file'} = $archived_filename_with_path;
 896     $phenotype_metadata{'archived_file_type'} = $metadata_file_type;
 897     $phenotype_metadata{'operator'} = $user_name;
 898     $phenotype_metadata{'date'} = $timestamp;
 899
 900     my $pheno_dir = $c->tempfiles_subdir('/delete_nd_experiment_ids');
 901     my $temp_file_nd_experiment_id = $c->config->{basepath}."/".$c->tempfile( TEMPLATE => 'delete_nd_experiment_ids/fileXXXX');
 902
 903     my $store_phenotypes = CXGN::Phenotypes::StorePhenotypes->new({
 904         basepath=>$c->config->{basepath},
 905         dbhost=>$c->config->{dbhost},
 906         dbname=>$c->config->{dbname},
 907         dbuser=>$c->config->{dbuser},
 908         dbpass=>$c->config->{dbpass},
 909         temp_file_nd_experiment_id=>$temp_file_nd_experiment_id,
 910         bcs_schema=>$schema,
 911         metadata_schema=>$metadata_schema,
 912         phenome_schema=>$phenome_schema,
 913         user_id=>$user_id,
 914         stock_list=>\@plots,
 915         trait_list=>[],
 916         values_hash=>\%parsed_data_agg_coalesced,
 917         has_timestamps=>0,
 918         metadata_hash=>\%phenotype_metadata,
 919         composable_validation_check_name=>$c->config->{composable_validation_check_name},
 920         allow_repeat_measures=>$c->config->{allow_repeat_measures}
 921     });
 922
 923     my $warning_status;
 924     my ($verified_warning, $verified_error) = $store_phenotypes->verify();
 925     if ($verified_error) {
 926         push @error_status, $verified_error;
 927         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
 928         $c->detach();
 929     }
 930     if ($verified_warning) {
 931         push @warning_status, $verified_warning;
 932     }
 933     push @success_status, "File data verified. Plot names and trait names are valid.";
 934
 935     my ($stored_phenotype_error, $stored_phenotype_success) = $store_phenotypes->store();
 936     if ($stored_phenotype_error) {
 937         push @error_status, $stored_phenotype_error;
 938         $c->stash->{rest} = {success => \@success_status, error => \@error_status};
 939         $c->detach();
 940     }
 941     if ($stored_phenotype_success) {
 942         push @success_status, $stored_phenotype_success;
 943     }
 944
 945     push @success_status, "Metadata saved for archived file.";
 946     my $bs = CXGN::BreederSearch->new({ dbh=>$c->dbc->dbh, dbname=>$c->config->{dbname} });
 947     my $refresh = $bs->refresh_matviews($c->config->{dbhost}, $c->config->{dbname}, $c->config->{dbuser}, $c->config->{dbpass}, 'fullview', 'concurrent', $c->config->{basepath});
 948
 949     $c->stash->{rest} = {success => \@success_status, error => \@error_status, nd_protocol_id => $protocol_id};
 950 }
 951
 952 sub high_dimensional_phenotypes_metabolomics_upload_verify : Path('/ajax/highdimensionalphenotypes/metabolomics_upload_verify') : ActionClass('REST') { }
 953 sub high_dimensional_phenotypes_metabolomics_upload_verify_POST : Args(0) {
 954     my $self = shift;
 955     my $c = shift;
 956     print STDERR Dumper $c->req->params();
 957     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 958     my $metadata_schema = $c->dbic_schema("CXGN::Metadata::Schema");
 959     my $phenome_schema = $c->dbic_schema("CXGN::Phenome::Schema");
 960     my ($user_id, $user_name, $user_type) = _check_user_login($c);
 961     my @success_status;
 962     my @error_status;
 963     my @warning_status;
 964
 965     my $parser = CXGN::Phenotypes::ParseUpload->new();
 966     my $validate_type = "highdimensionalphenotypes spreadsheet metabolomics";
 967     my $metadata_file_type = "metabolomics spreadsheet";
 968     my $subdirectory = "spreadsheet_phenotype_upload";
 969     my $timestamp_included;
 970
 971     my $protocol_id = $c->req->param('upload_metabolomics_spreadsheet_protocol_id');
 972     my $protocol_name = $c->req->param('upload_metabolomics_spreadsheet_protocol_name');
 973     my $protocol_desc = $c->req->param('upload_metabolomics_spreadsheet_protocol_desc');
 974
 975     my $protocol_equipment_type = $c->req->param('upload_metabolomics_spreadsheet_protocol_equipment_type');
 976     my $protocol_target = $c->req->param('upload_metabolomics_spreadsheet_protocol_target');
 977     my $protocol_sample_collection = $c->req->param('upload_metabolomics_spreadsheet_protocol_sample_collection_protocol');
 978     my $protocol_sample_extraction = $c->req->param('upload_metabolomics_spreadsheet_protocol_sample_extraction_protocol');
 979     my $protocol_rawdata_transformation = $c->req->param('upload_metabolomics_spreadsheet_protocol_rawdata_transformation_protocol');
 980     my $protocol_metabolite_identification = $c->req->param('upload_metabolomics_spreadsheet_protocol_metabolite_identification_protocol');
 981
 982     my $protocol_equipment_desc = $c->req->param('upload_metabolomics_spreadsheet_protocol_equipment_description');
 983     my $protocol_data_process_desc = $c->req->param('upload_metabolomics_spreadsheet_protocol_data_process_description');
 984     my $protocol_phenotype_type = $c->req->param('upload_metabolomics_spreadsheet_protocol_phenotype_type');
 985     my $protocol_phenotype_units = $c->req->param('upload_metabolomics_spreadsheet_protocol_phenotype_units');
 986     my $protocol_chromatography_system_brand = $c->req->param('upload_metabolomics_spreadsheet_protocol_chromatography_system_brand');
 987     my $protocol_chromatography_column_brand = $c->req->param('upload_metabolomics_spreadsheet_protocol_chromatography_column_brand');
 988
 989     my $protocol_chromatography_type = $c->req->param('upload_metabolomics_spreadsheet_protocol_chromatography_type');
 990     my $protocol_chromatography_autosampler_model = $c->req->param('upload_metabolomics_spreadsheet_protocol_chromatography_AutoSampler_Model');
 991     my $protocol_chromatography_column_type = $c->req->param('upload_metabolomics_spreadsheet_protocol_chromatography_column_type');
 992     my $protocol_chromatography_protocol = $c->req->param('upload_metabolomics_spreadsheet_protocol_chromatography_protocol');
 993     my $protocol_mass_spectrometry_protocol = $c->req->param('upload_metabolomics_spreadsheet_protocol_mass_spectrometry_protocol');
 994
 995     my $protocol_ms_brand = $c->req->param('upload_metabolomics_spreadsheet_protocol_ms_brand');
 996     my $protocol_ms_type = $c->req->param('upload_metabolomics_spreadsheet_protocol_ms_mass_analyzer');
 997     my $protocol_ms_instrument_type = $c->req->param('upload_metabolomics_spreadsheet_protocol_ms_scan_polarity');
 998     my $protocol_ms_ion_mode = $c->req->param('upload_metabolomics_spreadsheet_protocol_ms_ion_source');
 999     my $protocol_ms_scan_mz_range = $c->req->param('upload_metabolomics_spreadsheet_protocol_ms_scan_MZ_Range');
1000     my $protocol_publication = $c->req->param('upload_metabolomics_spreadsheet_protocol_publication');
1001
1002     if ($protocol_id && $protocol_name) {
1003         $c->stash->{rest} = {error => ["Please give a protocol name or select a previous protocol, not both!"]};
1004         $c->detach();
1005     }
1006     if (!$protocol_id && (!$protocol_name || !$protocol_desc)) {
1007         $c->stash->{rest} = {error => ["Please give a protocol name and description, or select a previous protocol!"]};
1008         $c->detach();
1009     }
1010     if (!$protocol_id && (!$protocol_equipment_type || !$protocol_equipment_desc || !$protocol_data_process_desc || !$protocol_phenotype_type || !$protocol_phenotype_units || !$protocol_target || !$protocol_sample_collection || !$protocol_sample_extraction || !$protocol_rawdata_transformation || !$protocol_metabolite_identification)) {
1011         $c->stash->{rest} = {error => ["Please give all protocol equipment descriptions, or select a previous protocol!"]};
1012         $c->detach();
1013     }
1014     if (!$protocol_id && $protocol_equipment_type eq 'MS' && (!$protocol_chromatography_system_brand || !$protocol_chromatography_column_brand || !$protocol_ms_brand || !$protocol_ms_type || !$protocol_ms_instrument_type || !$protocol_ms_ion_mode || !$protocol_chromatography_type || !$protocol_chromatography_column_type || !$protocol_chromatography_protocol || !$protocol_mass_spectrometry_protocol || !$protocol_ms_scan_mz_range)) {
1015         $c->stash->{rest} = {error => ["If defining a MS protocol please give all information fields!"]};
1016         $c->detach();
1017     }
1018
1019     my $high_dim_metabolomics_protocol_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'high_dimensional_phenotype_metabolomics_protocol', 'protocol_type')->cvterm_id();
1020     my $high_dim_metabolomics_protocol_prop_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'high_dimensional_phenotype_protocol_properties', 'protocol_property')->cvterm_id();
1021
1022     my $data_level = $c->req->param('upload_metabolomics_spreadsheet_data_level') || 'tissue_samples';
1023     my $upload = $c->req->upload('upload_metabolomics_spreadsheet_file_input');
1024     my $metabolite_details_upload = $c->req->upload('upload_metabolomics_metabolite_details_spreadsheet_file_input');
1025
1026     my $upload_original_name = $upload->filename();
1027     my $upload_tempfile = $upload->tempname;
1028     my $time = DateTime->now();
1029     my $timestamp = $time->ymd()."_".$time->hms();
1030
1031     my $uploader = CXGN::UploadFile->new({
1032         tempfile => $upload_tempfile,
1033         subdirectory => $subdirectory,
1034         archive_path => $c->config->{archive_path},
1035         archive_filename => $upload_original_name,
1036         timestamp => $timestamp,
1037         user_id => $user_id,
1038         user_role => $user_type
1039     });
1040     my $archived_filename_with_path = $uploader->archive();
1041     my $md5 = $uploader->get_md5($archived_filename_with_path);
1042     if (!$archived_filename_with_path) {
1043         push @error_status, "Could not save file $upload_original_name in archive.";
1044         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
1045         $c->detach();
1046     } else {
1047         push @success_status, "File $upload_original_name saved in archive.";
1048     }
1049     unlink $upload_tempfile;
1050
1051     my $upload_transcripts_original_name = $metabolite_details_upload->filename();
1052     my $upload_transcripts_tempfile = $metabolite_details_upload->tempname;
1053
1054     my $uploader_transcripts = CXGN::UploadFile->new({
1055         tempfile => $upload_transcripts_tempfile,
1056         subdirectory => $subdirectory,
1057         archive_path => $c->config->{archive_path},
1058         archive_filename => $upload_transcripts_original_name,
1059         timestamp => $timestamp,
1060         user_id => $user_id,
1061         user_role => $user_type
1062     });
1063     my $archived_filename_transcripts_with_path = $uploader_transcripts->archive();
1064     my $md5_transcripts = $uploader_transcripts->get_md5($archived_filename_transcripts_with_path);
1065     if (!$archived_filename_transcripts_with_path) {
1066         push @error_status, "Could not save file $upload_transcripts_original_name in archive.";
1067         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
1068         $c->detach();
1069     } else {
1070         push @success_status, "File $upload_transcripts_original_name saved in archive.";
1071     }
1072     unlink $upload_transcripts_tempfile;
1073
1074     my $archived_image_zipfile_with_path;
1075     my $validate_file = $parser->validate($validate_type, $archived_filename_with_path, $timestamp_included, $data_level, $schema, $archived_image_zipfile_with_path, $protocol_id, $archived_filename_transcripts_with_path);
1076     if (!$validate_file) {
1077         push @error_status, "Archived file not valid: $upload_original_name.";
1078         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
1079         $c->detach();
1080     }
1081     if ($validate_file == 1){
1082         push @success_status, "File valid: $upload_original_name.";
1083     } else {
1084         if ($validate_file->{'error'}) {
1085             push @error_status, $validate_file->{'error'};
1086         }
1087         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
1088         $c->detach();
1089     }
1090
1091     ## Set metadata
1092     my %phenotype_metadata;
1093     $phenotype_metadata{'archived_file'} = $archived_filename_with_path;
1094     $phenotype_metadata{'archived_file_type'} = $metadata_file_type;
1095     $phenotype_metadata{'operator'} = $user_name;
1096     $phenotype_metadata{'date'} = $timestamp;
1097
1098     my $parsed_file = $parser->parse($validate_type, $archived_filename_with_path, $timestamp_included, $data_level, $schema, $archived_image_zipfile_with_path, $user_id, $c, $protocol_id, $archived_filename_transcripts_with_path);
1099     if (!$parsed_file) {
1100         push @error_status, "Error parsing file $upload_original_name.";
1101         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
1102         $c->detach();
1103     }
1104     if ($parsed_file->{'error'}) {
1105         push @error_status, $parsed_file->{'error'};
1106         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
1107         $c->detach();
1108     }
1109     my %parsed_data;
1110     my @plots;
1111     my @metabolites;
1112     if (scalar(@error_status) == 0) {
1113         if ($parsed_file && !$parsed_file->{'error'}) {
1114             %parsed_data = %{$parsed_file->{'data'}};
1115             @plots = @{$parsed_file->{'units'}};
1116             @metabolites = @{$parsed_file->{'variables'}};
1117             push @success_status, "File data successfully parsed.";
1118         }
1119     }
1120
1121     my $dir = $c->tempfiles_subdir('/delete_nd_experiment_ids');
1122     my $temp_file_nd_experiment_id = $c->config->{basepath}."/".$c->tempfile( TEMPLATE => 'delete_nd_experiment_ids/fileXXXX');
1123
1124     my $store_phenotypes = CXGN::Phenotypes::StorePhenotypes->new({
1125         basepath=>$c->config->{basepath},
1126         dbhost=>$c->config->{dbhost},
1127         dbname=>$c->config->{dbname},
1128         dbuser=>$c->config->{dbuser},
1129         dbpass=>$c->config->{dbpass},
1130         temp_file_nd_experiment_id=>$temp_file_nd_experiment_id,
1131         bcs_schema=>$schema,
1132         metadata_schema=>$metadata_schema,
1133         phenome_schema=>$phenome_schema,
1134         user_id=>$user_id,
1135         stock_list=>\@plots,
1136         trait_list=>[],
1137         values_hash=>\%parsed_data,
1138         has_timestamps=>0,
1139         metadata_hash=>\%phenotype_metadata,
1140         composable_validation_check_name=>$c->config->{composable_validation_check_name}
1141     });
1142
1143     my $warning_status;
1144     my ($verified_warning, $verified_error) = $store_phenotypes->verify();
1145     if ($verified_error) {
1146         push @error_status, $verified_error;
1147         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
1148         $c->detach();
1149     }
1150     if ($verified_warning) {
1151         push @warning_status, $verified_warning;
1152     }
1153     push @success_status, "File data verified. Plot names and trait names are valid.";
1154
1155     # print STDERR Dumper \@success_status;
1156     # print STDERR Dumper \@warning_status;
1157     # print STDERR Dumper \@error_status;
1158     # print STDERR Dumper $output_plot_filepath_string;
1159     $c->stash->{rest} = {success => \@success_status, warning => \@warning_status, error => \@error_status};
1160 }
1161
1162 sub high_dimensional_phenotypes_metabolomics_upload_store : Path('/ajax/highdimensionalphenotypes/metabolomics_upload_store') : ActionClass('REST') { }
1163 sub high_dimensional_phenotypes_metabolomics_upload_store_POST : Args(0) {
1164     my $self = shift;
1165     my $c = shift;
1166     my $schema = $c->dbic_schema("Bio::Chado::Schema");
1167     my $metadata_schema = $c->dbic_schema("CXGN::Metadata::Schema");
1168     my $phenome_schema = $c->dbic_schema("CXGN::Phenome::Schema");
1169     my ($user_id, $user_name, $user_type) = _check_user_login($c);
1170     my @success_status;
1171     my @error_status;
1172     my @warning_status;
1173
1174     my $parser = CXGN::Phenotypes::ParseUpload->new();
1175     my $validate_type = "highdimensionalphenotypes spreadsheet metabolomics";
1176     my $metadata_file_type = "metabolomics spreadsheet";
1177     my $subdirectory = "spreadsheet_phenotype_upload";
1178     my $timestamp_included;
1179
1180     my $protocol_id = $c->req->param('upload_metabolomics_spreadsheet_protocol_id');
1181     my $protocol_name = $c->req->param('upload_metabolomics_spreadsheet_protocol_name');
1182     my $protocol_desc = $c->req->param('upload_metabolomics_spreadsheet_protocol_desc');
1183
1184     my $protocol_equipment_type = $c->req->param('upload_metabolomics_spreadsheet_protocol_equipment_type');
1185     my $protocol_target = $c->req->param('upload_metabolomics_spreadsheet_protocol_target');
1186     my $protocol_sample_collection = $c->req->param('upload_metabolomics_spreadsheet_protocol_sample_collection_protocol');
1187     my $protocol_sample_extraction = $c->req->param('upload_metabolomics_spreadsheet_protocol_sample_extraction_protocol');
1188     my $protocol_rawdata_transformation = $c->req->param('upload_metabolomics_spreadsheet_protocol_rawdata_transformation_protocol');
1189     my $protocol_metabolite_identification = $c->req->param('upload_metabolomics_spreadsheet_protocol_metabolite_identification_protocol');
1190
1191     my $protocol_equipment_desc = $c->req->param('upload_metabolomics_spreadsheet_protocol_equipment_description');
1192     my $protocol_data_process_desc = $c->req->param('upload_metabolomics_spreadsheet_protocol_data_process_description');
1193     my $protocol_phenotype_type = $c->req->param('upload_metabolomics_spreadsheet_protocol_phenotype_type');
1194     my $protocol_phenotype_units = $c->req->param('upload_metabolomics_spreadsheet_protocol_phenotype_units');
1195     my $protocol_chromatography_system_brand = $c->req->param('upload_metabolomics_spreadsheet_protocol_chromatography_system_brand');
1196     my $protocol_chromatography_column_brand = $c->req->param('upload_metabolomics_spreadsheet_protocol_chromatography_column_brand');
1197
1198     my $protocol_chromatography_type = $c->req->param('upload_metabolomics_spreadsheet_protocol_chromatography_type');
1199     my $protocol_chromatography_autosampler_model = $c->req->param('upload_metabolomics_spreadsheet_protocol_chromatography_AutoSampler_Model');
1200     my $protocol_chromatography_column_type = $c->req->param('upload_metabolomics_spreadsheet_protocol_chromatography_column_type');
1201     my $protocol_chromatography_protocol = $c->req->param('upload_metabolomics_spreadsheet_protocol_chromatography_protocol');
1202     my $protocol_mass_spectrometry_protocol = $c->req->param('upload_metabolomics_spreadsheet_protocol_mass_spectrometry_protocol');
1203
1204     my $protocol_ms_brand = $c->req->param('upload_metabolomics_spreadsheet_protocol_ms_brand');
1205     my $protocol_ms_type = $c->req->param('upload_metabolomics_spreadsheet_protocol_ms_mass_analyzer');
1206     my $protocol_ms_instrument_type = $c->req->param('upload_metabolomics_spreadsheet_protocol_ms_scan_polarity');
1207     my $protocol_ms_ion_mode = $c->req->param('upload_metabolomics_spreadsheet_protocol_ms_ion_source');
1208     my $protocol_ms_scan_mz_range = $c->req->param('upload_metabolomics_spreadsheet_protocol_ms_scan_MZ_Range');
1209     my $protocol_publication = $c->req->param('upload_metabolomics_spreadsheet_protocol_publication');
1210
1211     if ($protocol_id && $protocol_name) {
1212         $c->stash->{rest} = {error => ["Please give a protocol name or select a previous protocol, not both!"]};
1213         $c->detach();
1214     }
1215     if (!$protocol_id && (!$protocol_name || !$protocol_desc)) {
1216         $c->stash->{rest} = {error => ["Please give a protocol name and description, or select a previous protocol!"]};
1217         $c->detach();
1218     }
1219     if (!$protocol_id && (!$protocol_equipment_type || !$protocol_equipment_desc || !$protocol_data_process_desc || !$protocol_phenotype_type || !$protocol_phenotype_units || !$protocol_target || !$protocol_sample_collection || !$protocol_sample_extraction || !$protocol_rawdata_transformation || !$protocol_metabolite_identification)) {
1220         $c->stash->{rest} = {error => ["Please give all protocol equipment descriptions, or select a previous protocol!"]};
1221         $c->detach();
1222     }
1223     if (!$protocol_id && $protocol_equipment_type eq 'MS' && (!$protocol_chromatography_system_brand || !$protocol_chromatography_column_brand || !$protocol_ms_brand || !$protocol_ms_type || !$protocol_ms_instrument_type || !$protocol_ms_ion_mode || !$protocol_chromatography_type || !$protocol_chromatography_column_type || !$protocol_chromatography_protocol || !$protocol_mass_spectrometry_protocol || !$protocol_ms_scan_mz_range)) {
1224         $c->stash->{rest} = {error => ["If defining a MS protocol please give all information fields!"]};
1225         $c->detach();
1226     }
1227
1228     my $high_dim_metabolomics_protocol_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'high_dimensional_phenotype_metabolomics_protocol', 'protocol_type')->cvterm_id();
1229     my $high_dim_metabolomics_protocol_prop_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'high_dimensional_phenotype_protocol_properties', 'protocol_property')->cvterm_id();
1230
1231     my $data_level = $c->req->param('upload_metabolomics_spreadsheet_data_level') || 'tissue_samples';
1232     my $upload = $c->req->upload('upload_metabolomics_spreadsheet_file_input');
1233     my $metabolite_details_upload = $c->req->upload('upload_metabolomics_metabolite_details_spreadsheet_file_input');
1234
1235     my $upload_original_name = $upload->filename();
1236     my $upload_tempfile = $upload->tempname;
1237     my $time = DateTime->now();
1238     my $timestamp = $time->ymd()."_".$time->hms();
1239
1240     my $uploader = CXGN::UploadFile->new({
1241         tempfile => $upload_tempfile,
1242         subdirectory => $subdirectory,
1243         archive_path => $c->config->{archive_path},
1244         archive_filename => $upload_original_name,
1245         timestamp => $timestamp,
1246         user_id => $user_id,
1247         user_role => $user_type
1248     });
1249     my $archived_filename_with_path = $uploader->archive();
1250     my $md5 = $uploader->get_md5($archived_filename_with_path);
1251     if (!$archived_filename_with_path) {
1252         push @error_status, "Could not save file $upload_original_name in archive.";
1253         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
1254         $c->detach();
1255     } else {
1256         push @success_status, "File $upload_original_name saved in archive.";
1257     }
1258     unlink $upload_tempfile;
1259
1260     my $upload_transcripts_original_name = $metabolite_details_upload->filename();
1261     my $upload_transcripts_tempfile = $metabolite_details_upload->tempname;
1262
1263     my $uploader_transcripts = CXGN::UploadFile->new({
1264         tempfile => $upload_transcripts_tempfile,
1265         subdirectory => $subdirectory,
1266         archive_path => $c->config->{archive_path},
1267         archive_filename => $upload_transcripts_original_name,
1268         timestamp => $timestamp,
1269         user_id => $user_id,
1270         user_role => $user_type
1271     });
1272     my $archived_filename_transcripts_with_path = $uploader_transcripts->archive();
1273     my $md5_transcripts = $uploader_transcripts->get_md5($archived_filename_transcripts_with_path);
1274     if (!$archived_filename_transcripts_with_path) {
1275         push @error_status, "Could not save file $upload_transcripts_original_name in archive.";
1276         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
1277         $c->detach();
1278     } else {
1279         push @success_status, "File $upload_transcripts_original_name saved in archive.";
1280     }
1281     unlink $upload_transcripts_tempfile;
1282
1283     my $archived_image_zipfile_with_path;
1284     my $validate_file = $parser->validate($validate_type, $archived_filename_with_path, $timestamp_included, $data_level, $schema, $archived_image_zipfile_with_path, $protocol_id, $archived_filename_transcripts_with_path);
1285     if (!$validate_file) {
1286         push @error_status, "Archived file not valid: $upload_original_name.";
1287         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
1288         $c->detach();
1289     }
1290     if ($validate_file == 1){
1291         push @success_status, "File valid: $upload_original_name.";
1292     } else {
1293         if ($validate_file->{'error'}) {
1294             push @error_status, $validate_file->{'error'};
1295         }
1296         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
1297         $c->detach();
1298     }
1299
1300     my $parsed_file = $parser->parse($validate_type, $archived_filename_with_path, $timestamp_included, $data_level, $schema, $archived_image_zipfile_with_path, $user_id, $c, $protocol_id, $archived_filename_transcripts_with_path);
1301     if (!$parsed_file) {
1302         push @error_status, "Error parsing file $upload_original_name.";
1303         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
1304         $c->detach();
1305     }
1306     if ($parsed_file->{'error'}) {
1307         push @error_status, $parsed_file->{'error'};
1308         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
1309         $c->detach();
1310     }
1311     my %parsed_data;
1312     my @plots;
1313     my @metabolites;
1314     my %metabolites_details;
1315     if (scalar(@error_status) == 0) {
1316         if ($parsed_file && !$parsed_file->{'error'}) {
1317             %parsed_data = %{$parsed_file->{'data'}};
1318             @plots = @{$parsed_file->{'units'}};
1319             @metabolites = @{$parsed_file->{'variables'}};
1320             %metabolites_details = %{$parsed_file->{'variables_desc'}};
1321             push @success_status, "File data successfully parsed.";
1322         }
1323     }
1324
1325     if (!$protocol_id) {
1326         my %metabolomics_protocol_prop = (
1327             header_column_names => \@metabolites,
1328             header_column_details => %metabolites_details,
1329             equipment_type => $protocol_equipment_type,
1330
1331             target => $protocol_target,
1332             sample_collection_description => $protocol_sample_collection,
1333             sample_extraction_description => $protocol_sample_extraction,
1334             rawdata_transformation_descripson => $protocol_rawdata_transformation,
1335             metabolite_identification_description => $protocol_metabolite_identification,
1336
1337             equipment_description => $protocol_equipment_desc,
1338             data_process_description => $protocol_data_process_desc,
1339             phenotype_type => $protocol_phenotype_type,
1340             phenotype_units => $protocol_phenotype_units,
1341
1342             protocol_publication => $protocol_publication
1343         );
1344         if ($protocol_equipment_type eq 'MS') {
1345             $metabolomics_protocol_prop{chromatography_system_brand} = $protocol_chromatography_system_brand;
1346             $metabolomics_protocol_prop{chromatography_column_brand} = $protocol_chromatography_column_brand;
1347             $metabolomics_protocol_prop{ms_brand} = $protocol_ms_brand;
1348             $metabolomics_protocol_prop{ms_type} = $protocol_ms_type;
1349             $metabolomics_protocol_prop{ms_instrument_type} = $protocol_ms_instrument_type;
1350             $metabolomics_protocol_prop{ms_ion_mode} = $protocol_ms_ion_mode;
1351
1352             $metabolomics_protocol_prop{chromatography_type} = $protocol_chromatography_type;
1353             $metabolomics_protocol_prop{chromatography_autosampler_model} = $protocol_chromatography_autosampler_model;
1354             $metabolomics_protocol_prop{chromatography_column_type} = $protocol_chromatography_column_type;
1355             $metabolomics_protocol_prop{chromatography_protocol_description} = $protocol_chromatography_protocol;
1356             $metabolomics_protocol_prop{mass_spectrometry_protocol_description} = $protocol_mass_spectrometry_protocol;
1357             $metabolomics_protocol_prop{ms_scan_mz_range} = $protocol_ms_scan_mz_range;
1358         }
1359
1360         my $protocol = $schema->resultset('NaturalDiversity::NdProtocol')->create({
1361             name => $protocol_name,
1362             type_id => $high_dim_metabolomics_protocol_cvterm_id,
1363             nd_protocolprops => [{type_id => $high_dim_metabolomics_protocol_prop_cvterm_id, value => encode_json \%metabolomics_protocol_prop}]
1364         });
1365         $protocol_id = $protocol->nd_protocol_id();
1366
1367         my $desc_q = "UPDATE nd_protocol SET description=? WHERE nd_protocol_id=?;";
1368         my $dbh = $schema->storage->dbh()->prepare($desc_q);
1369         $dbh->execute($protocol_desc, $protocol_id);
1370     }
1371
1372     my %parsed_data_agg;
1373     while (my ($stock_name, $o) = each %parsed_data) {
1374         my $device_id = $o->{metabolomics}->{device_id};
1375         my $comments = $o->{metabolomics}->{comments};
1376         my $spectras = $o->{metabolomics}->{metabolites};
1377         $parsed_data_agg{$stock_name}->{metabolomics} = $spectras->[0];
1378         $parsed_data_agg{$stock_name}->{metabolomics}->{protocol_id} = $protocol_id;
1379         $parsed_data_agg{$stock_name}->{metabolomics}->{device_id} = $device_id;
1380         $parsed_data_agg{$stock_name}->{metabolomics}->{comments} = $comments;
1381     }
1382
1383     ## Set metadata
1384     my %phenotype_metadata;
1385     $phenotype_metadata{'archived_file'} = $archived_filename_with_path;
1386     $phenotype_metadata{'archived_file_type'} = $metadata_file_type;
1387     $phenotype_metadata{'operator'} = $user_name;
1388     $phenotype_metadata{'date'} = $timestamp;
1389
1390     my $pheno_dir = $c->tempfiles_subdir('/delete_nd_experiment_ids');
1391     my $temp_file_nd_experiment_id = $c->config->{basepath}."/".$c->tempfile( TEMPLATE => 'delete_nd_experiment_ids/fileXXXX');
1392
1393     my $store_phenotypes = CXGN::Phenotypes::StorePhenotypes->new({
1394         basepath=>$c->config->{basepath},
1395         dbhost=>$c->config->{dbhost},
1396         dbname=>$c->config->{dbname},
1397         dbuser=>$c->config->{dbuser},
1398         dbpass=>$c->config->{dbpass},
1399         temp_file_nd_experiment_id=>$temp_file_nd_experiment_id,
1400         bcs_schema=>$schema,
1401         metadata_schema=>$metadata_schema,
1402         phenome_schema=>$phenome_schema,
1403         user_id=>$user_id,
1404         stock_list=>\@plots,
1405         trait_list=>[],
1406         values_hash=>\%parsed_data_agg,
1407         has_timestamps=>0,
1408         metadata_hash=>\%phenotype_metadata,
1409         composable_validation_check_name=>$c->config->{composable_validation_check_name},
1410         allow_repeat_measures=>$c->config->{allow_repeat_measures}
1411     });
1412
1413     my $warning_status;
1414     my ($verified_warning, $verified_error) = $store_phenotypes->verify();
1415     if ($verified_error) {
1416         push @error_status, $verified_error;
1417         $c->stash->{rest} = {success => \@success_status, error => \@error_status };
1418         $c->detach();
1419     }
1420     if ($verified_warning) {
1421         push @warning_status, $verified_warning;
1422     }
1423     push @success_status, "File data verified. Plot names and trait names are valid.";
1424
1425     my ($stored_phenotype_error, $stored_phenotype_success) = $store_phenotypes->store();
1426     if ($stored_phenotype_error) {
1427         push @error_status, $stored_phenotype_error;
1428         $c->stash->{rest} = {success => \@success_status, error => \@error_status};
1429         $c->detach();
1430     }
1431     if ($stored_phenotype_success) {
1432         push @success_status, $stored_phenotype_success;
1433     }
1434
1435     push @success_status, "Metadata saved for archived file.";
1436     my $bs = CXGN::BreederSearch->new({ dbh=>$c->dbc->dbh, dbname=>$c->config->{dbname} });
1437     my $refresh = $bs->refresh_matviews($c->config->{dbhost}, $c->config->{dbname}, $c->config->{dbuser}, $c->config->{dbpass}, 'fullview', 'concurrent', $c->config->{basepath});
1438
1439     $c->stash->{rest} = {success => \@success_status, error => \@error_status, nd_protocol_id => $protocol_id};
1440 }
1441
1442 sub high_dimensional_phenotypes_download_file : Path('/ajax/highdimensionalphenotypes/download_file') : ActionClass('REST') { }
1443 sub high_dimensional_phenotypes_download_file_POST : Args(0) {
1444     my $self = shift;
1445     my $c = shift;
1446     my $schema = $c->dbic_schema("Bio::Chado::Schema");
1447     my $metadata_schema = $c->dbic_schema("CXGN::Metadata::Schema");
1448     my $phenome_schema = $c->dbic_schema("CXGN::Phenome::Schema");
1449     my $people_schema = $c->dbic_schema("CXGN::People::Schema");
1450     my ($user_id, $user_name, $user_type) = _check_user_login($c);
1451     my $error;
1452
1453     my $dataset_id = $c->req->param('dataset_id');
1454     my $nd_protocol_id = $c->req->param('nd_protocol_id');
1455     my $high_dimensional_phenotype_type = $c->req->param('high_dimensional_phenotype_type');
1456     my $high_dimensional_download_type = $c->req->param('download_file_type');
1457     my $query_associated_stocks = $c->req->param('query_associated_stocks') eq 'yes' ? 1 : 0;
1458
1459     my $ds = CXGN::Dataset->new({
1460         people_schema => $people_schema,
1461         schema => $schema,
1462         sp_dataset_id => $dataset_id,
1463     });
1464
1465     my $high_dimensional_phenotype_identifier_list = [];
1466     my ($data_matrix, $identifier_metadata, $identifier_names) = $ds->retrieve_high_dimensional_phenotypes(
1467         $nd_protocol_id,
1468         $high_dimensional_phenotype_type,
1469         $query_associated_stocks,
1470         $high_dimensional_phenotype_identifier_list
1471     );
1472
1473     if ($data_matrix->{error}) {
1474         $c->stash->{rest} = {error => $data_matrix->{error}};
1475         $c->detach();
1476     }
1477
1478     # print STDERR Dumper $data_matrix;
1479     # print STDERR Dumper $identifier_metadata;
1480     # print STDERR Dumper $identifier_names;
1481
1482     if ($data_matrix->{error}) {
1483         $c->stash->{rest} = {error => $data_matrix->{error}};
1484         $c->detach();
1485     }
1486
1487     my $dir = $c->tempfiles_subdir('/high_dimensional_phenotypes_download');
1488     my $download_file_link = $c->tempfile( TEMPLATE => 'high_dimensional_phenotypes_download/downloadXXXX');
1489     $download_file_link .= '.csv';
1490     my $download_file_tempfile = $c->config->{basepath}."/".$download_file_link;
1491
1492     open(my $F, ">", $download_file_tempfile) || die "Can't open file ".$download_file_tempfile;
1493
1494         if ($high_dimensional_phenotype_type eq 'NIRS') {
1495
1496             #Old NIRS data were loaded without the protocol identifer_names saved
1497             if (!$identifier_names || scalar(@$identifier_names) == 0) {
1498                 my @stock_ids = keys %$data_matrix;
1499                 my @ids = keys %{$data_matrix->{$stock_ids[0]}->{spectra}};
1500                 my @ids_stripped;
1501                 foreach (@ids) {
1502                     my $s = substr $_, 1;
1503                     push @ids_stripped, $s;
1504                 }
1505                 $identifier_names = \@ids_stripped;
1506             }
1507
1508             my @identifier_names_sorted = sort { $a <=> $b } @$identifier_names;
1509
1510             if ($high_dimensional_download_type eq 'data_matrix') {
1511                 my @header = ('stock_id', @identifier_names_sorted);
1512                 my $header_string = join ',', @header;
1513                 print $F $header_string."\n";
1514
1515                 while ( my ($stock_id, $o) = each %$data_matrix) {
1516                     my $spectra = $o->{spectra};
1517                     if ($spectra) {
1518                         my @row = ($stock_id);
1519                         foreach (@identifier_names_sorted) {
1520                             push @row, $spectra->{"X$_"};
1521                         }
1522                         my $line = join ',', @row;
1523                         print $F $line."\n";
1524                     }
1525                 }
1526             }
1527             elsif ($high_dimensional_download_type eq 'identifier_metadata') {
1528                 my $header_string = 'spectra';
1529                 print $F $header_string."\n";
1530
1531                 foreach (@identifier_names_sorted) {
1532                     print $F "X$_\n";
1533                 }
1534             }
1535         }
1536         elsif ($high_dimensional_phenotype_type eq 'Transcriptomics') {
1537
1538             my @identifier_names_sorted = sort @$identifier_names;
1539
1540             if ($high_dimensional_download_type eq 'data_matrix') {
1541                 my @header = ('stock_id', @identifier_names_sorted);
1542                 my $header_string = join ',', @header;
1543                 print $F $header_string."\n";
1544
1545                 while ( my ($stock_id, $o) = each %$data_matrix) {
1546                     my $spectra = $o->{transcriptomics};
1547                     if ($spectra) {
1548                         my @row = ($stock_id);
1549                         foreach (@identifier_names_sorted) {
1550                             push @row, $spectra->{$_};
1551                         }
1552                         my $line = join ',', @row;
1553                         print $F $line."\n";
1554                     }
1555                 }
1556             }
1557             elsif ($high_dimensional_download_type eq 'identifier_metadata') {
1558                 my $header_string = 'transcript_name,chromosome,start_position,end_position,gene_description,notes';
1559                 print $F $header_string."\n";
1560
1561                 foreach (@identifier_names_sorted) {
1562                     my $chromosome = $identifier_metadata->{$_}->{chr};
1563                     my $start_position = $identifier_metadata->{$_}->{start};
1564                     my $end_position = $identifier_metadata->{$_}->{end};
1565                     my $gene_description = $identifier_metadata->{$_}->{gene_desc};
1566                     my $notes = $identifier_metadata->{$_}->{notes};
1567                     print $F "$_,$chromosome,$start_position,$end_position,$gene_description,$notes\n";
1568                 }
1569             }
1570         }
1571         elsif ($high_dimensional_phenotype_type eq 'Metabolomics') {
1572
1573             my @identifier_names_sorted = sort @$identifier_names;
1574
1575             if ($high_dimensional_download_type eq 'data_matrix') {
1576                 my @header = ('stock_id', @identifier_names_sorted);
1577                 my $header_string = join ',', @header;
1578                 print $F $header_string."\n";
1579
1580                 while ( my ($stock_id, $o) = each %$data_matrix) {
1581                     my $spectra = $o->{metabolomics};
1582                     if ($spectra) {
1583                         my @row = ($stock_id);
1584                         foreach (@identifier_names_sorted) {
1585                             push @row, $spectra->{$_};
1586                         }
1587                         my $line = join ',', @row;
1588                         print $F $line."\n";
1589                     }
1590                 }
1591             }
1592             elsif ($high_dimensional_download_type eq 'identifier_metadata') {
1593                 my $header_string = 'metabolite_name,inchi_key,compound_name';
1594                 print $F $header_string."\n";
1595
1596                 foreach (@identifier_names_sorted) {
1597                     my $inchi = $identifier_metadata->{$_}->{inchi_key};
1598                     my $compound = $identifier_metadata->{$_}->{compound_name};
1599                     print $F "$_,$inchi,$compound\n";
1600                 }
1601             }
1602         }
1603
1604     close($F);
1605
1606     $c->stash->{rest} = {download_file_link => $download_file_link, error => $error};
1607 }
1608
1609 sub high_dimensional_phenotypes_download_relationship_matrix_file : Path('/ajax/highdimensionalphenotypes/download_relationship_matrix_file') : ActionClass('REST') { }
1610 sub high_dimensional_phenotypes_download_relationship_matrix_file_POST : Args(0) {
1611     my $self = shift;
1612     my $c = shift;
1613     my $schema = $c->dbic_schema("Bio::Chado::Schema");
1614     my $metadata_schema = $c->dbic_schema("CXGN::Metadata::Schema");
1615     my $phenome_schema = $c->dbic_schema("CXGN::Phenome::Schema");
1616     my $people_schema = $c->dbic_schema("CXGN::People::Schema");
1617     my ($user_id, $user_name, $user_type) = _check_user_login($c);
1618     my $error;
1619
1620     my $dataset_id = $c->req->param('dataset_id');
1621     my $nd_protocol_id = $c->req->param('nd_protocol_id');
1622     my $high_dimensional_phenotype_type = $c->req->param('high_dimensional_phenotype_type');
1623     my $query_associated_stocks = $c->req->param('query_associated_stocks') eq 'yes' ? 1 : 0;
1624
1625     my $ds = CXGN::Dataset->new({
1626         people_schema => $people_schema,
1627         schema => $schema,
1628         sp_dataset_id => $dataset_id,
1629     });
1630
1631     my $dir = $c->tempfiles_subdir('/high_dimensional_phenotypes_relationship_matrix_download');
1632     my $temp_data_file = $c->config->{basepath}."/".$c->tempfile( TEMPLATE => 'high_dimensional_phenotypes_relationship_matrix_download/downloadXXXX');
1633     my $download_file_link = $c->tempfile( TEMPLATE => 'high_dimensional_phenotypes_relationship_matrix_download/downloadXXXX');
1634     $download_file_link .= '.csv';
1635     my $download_file_tempfile = $c->config->{basepath}."/".$download_file_link;
1636
1637     my ($relationship_matrix_data, $data_matrix, $identifier_metadata, $identifier_names) = $ds->retrieve_high_dimensional_phenotypes_relationship_matrix(
1638         $nd_protocol_id,
1639         $high_dimensional_phenotype_type,
1640         $query_associated_stocks,
1641         $temp_data_file,
1642         $download_file_tempfile
1643     );
1644     # print STDERR Dumper $relationship_matrix_data;
1645     # print STDERR Dumper $data_matrix;
1646     # print STDERR Dumper $identifier_metadata;
1647     # print STDERR Dumper $identifier_names;
1648
1649     $c->stash->{rest} = {download_file_link => $download_file_link, error => $error};
1650 }
1651
1652 sub _check_user_login {
1653     my $c = shift;
1654     my $user_id;
1655     my $user_name;
1656     my $user_role;
1657     my $session_id = $c->req->param("sgn_session_id");
1658
1659     if ($session_id){
1660         my $dbh = $c->dbc->dbh;
1661         my @user_info = CXGN::Login->new($dbh)->query_from_cookie($session_id);
1662         if (!$user_info[0]){
1663             $c->stash->{rest} = {error=>'You must be logged in to do this!'};
1664             $c->detach();
1665         }
1666         $user_id = $user_info[0];
1667         $user_role = $user_info[1];
1668         my $p = CXGN::People::Person->new($dbh, $user_id);
1669         $user_name = $p->get_username;
1670     } else{
1671         if (!$c->user){
1672             $c->stash->{rest} = {error=>'You must be logged in to do this!'};
1673             $c->detach();
1674         }
1675         $user_id = $c->user()->get_object()->get_sp_person_id();
1676         $user_name = $c->user()->get_object()->get_username();
1677         $user_role = $c->user->get_object->get_user_type();
1678     }
1679     if ($user_role ne 'submitter' && $user_role ne 'curator') {
1680         $c->stash->{rest} = {error=>'You do not have permission in the database to do this! Please contact us.'};
1681         $c->detach();
1682     }
1683     return ($user_id, $user_name, $user_role);
1684 }
1685
1686 1;