lib/SGN/Controller/AJAX/BreedingProgram.pm

   1
   2 =head1 NAME
   3
   4 SGN::Controller::AJAX::BreedingProgram
   5  REST controller for viewing breeding programs and the data associated with them
   6
   7 =head1 DESCRIPTION
   8
   9
  10 =head1 AUTHOR
  11
  12 Naama Menda <nm249@cornell.edu>
  13 Titima Tantikanjana <tt15@cornell.edu>
  14
  15 =cut
  16
  17 package SGN::Controller::AJAX::BreedingProgram;
  18
  19 use Moose;
  20
  21 BEGIN { extends 'Catalyst::Controller::REST' };
  22
  23 use List::MoreUtils qw | any all |;
  24 use JSON::Any;
  25 use Data::Dumper;
  26 use Try::Tiny;
  27 use Math::Round;
  28 use CXGN::BreedingProgram;
  29 use CXGN::Phenotypes::PhenotypeMatrix;
  30 use CXGN::BreedersToolbox::Projects;
  31 use CXGN::Stock::Search;
  32 use JSON;
  33 use CXGN::BreedersToolbox::ProductProfile;
  34 use File::Spec::Functions;
  35 use Spreadsheet::WriteExcel;
  36 use CXGN::People::Person;
  37
  38 use File::Basename qw | basename dirname|;
  39 use File::Copy;
  40 use Digest::MD5;
  41 use DateTime;
  42
  43 __PACKAGE__->config(
  44     default   => 'application/json',
  45     stash_key => 'rest',
  46     map       => { 'application/json' => 'JSON', 'text/html' => 'JSON'  },
  47     );
  48
  49
  50 =head2 action program_trials()
  51
  52   Usage:        /breeders/program/<program_id>/datatables/trials
  53   Desc:         retrieves trials associated with the breeding program
  54   Ret:          a table in json suitable for datatables
  55   Args:
  56     Side Effects:
  57   Example:
  58
  59 =cut
  60
  61
  62 sub ajax_breeding_program : Chained('/')  PathPart('ajax/breeders/program')  CaptureArgs(1) {
  63     my ($self, $c, $program_id) = @_;
  64
  65     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
  66     my $program = CXGN::BreedingProgram->new( { schema=> $schema , program_id => $program_id } );
  67
  68     $c->stash->{schema} = $schema;
  69     $c->stash->{program} = $program;
  70
  71 }
  72
  73
  74 sub program_trials :Chained('ajax_breeding_program') PathPart('trials') Args(0) {
  75     my $self = shift;
  76     my $c = shift;
  77     my $program = $c->stash->{program};
  78
  79     my $trials = $program->get_trials();
  80
  81     my @formatted_trials;
  82     while (my $trial = $trials->next ) {
  83
  84         my $name = $trial->name;
  85         my $id = $trial->project_id;
  86         my $description = $trial->description;
  87         push @formatted_trials, [ '<a href="/breeders/trial/'.$id.'">'.$name.'</a>', $description ];
  88     }
  89     $c->stash->{rest} = { data => \@formatted_trials };
  90 }
  91
  92
  93 sub phenotype_summary : Chained('ajax_breeding_program') PathPart('phenotypes') Args(0) {
  94     my $self = shift;
  95     my $c = shift;
  96     my $program = $c->stash->{program};
  97     my $program_id = $program->get_program_id;
  98     my $schema = $c->stash->{schema};
  99     my $round = Math::Round::Var->new(0.01);
 100     my $dbh = $c->dbc->dbh();
 101
 102     my $trials = $program->get_trials;
 103     my @trial_ids;
 104     while (my $trial = $trials->next() ) {
 105         my $trial_id = $trial->project_id;
 106         push @trial_ids , $trial_id;
 107     }
 108     my $trial_ids = join ',', map { "?" } @trial_ids;
 109     my @phenotype_data;
 110     my @trait_list;
 111
 112     if ( $trial_ids ) {
 113         my $h = $dbh->prepare("SELECT (((cvterm.name::text || '|'::text) || db.name::text) || ':'::text) || dbxref.accession::text AS trait,
 114         cvterm.cvterm_id,
 115         count(phenotype.value),
 116         to_char(avg(phenotype.value::real), 'FM999990.990'),
 117         to_char(max(phenotype.value::real), 'FM999990.990'),
 118         to_char(min(phenotype.value::real), 'FM999990.990'),
 119         to_char(stddev(phenotype.value::real), 'FM999990.990')
 120
 121         FROM cvterm
 122             JOIN phenotype ON (cvterm_id=cvalue_id)
 123             JOIN nd_experiment_phenotype USING(phenotype_id)
 124             JOIN nd_experiment_project USING(nd_experiment_id)
 125             JOIN nd_experiment_stock USING(nd_experiment_id)
 126             JOIN stock as plot USING(stock_id)
 127             JOIN stock_relationship on (plot.stock_id = stock_relationship.subject_id)
 128             JOIN stock as accession on (accession.stock_id = stock_relationship.object_id)
 129             JOIN dbxref ON cvterm.dbxref_id = dbxref.dbxref_id JOIN db ON dbxref.db_id = db.db_id
 130         WHERE project_id IN ( $trial_ids )
 131             AND phenotype.value~?
 132
 133         GROUP BY (((cvterm.name::text || '|'::text) || db.name::text) || ':'::text) || dbxref.accession::text, cvterm.cvterm_id
 134         ORDER BY cvterm.name ASC
 135        ;");
 136
 137         my $numeric_regex = '^-?[0-9]+([,.][0-9]+)?$';
 138         $h->execute( @trial_ids , $numeric_regex);
 139
 140         while (my ($trait, $trait_id, $count, $average, $max, $min, $stddev) = $h->fetchrow_array()) {
 141             push @trait_list, [$trait_id, $trait];
 142             my $cv = 0;
 143             if ($stddev && $average != 0) {
 144                 $cv = ($stddev /  $average) * 100;
 145                 $cv = $round->round($cv) . '%';
 146             }
 147             if ($average) { $average = $round->round($average); }
 148             if ($min) { $min = $round->round($min); }
 149             if ($max) { $max = $round->round($max); }
 150             if ($stddev) { $stddev = $round->round($stddev); }
 151
 152             my @return_array;
 153
 154
 155             push @return_array, ( 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($program_id, $trait_id)"><span class="glyphicon glyphicon-stats"></span></a>} );
 156             push @phenotype_data, \@return_array;
 157         }
 158     }
 159     $c->stash->{trait_list} = \@trait_list;
 160     $c->stash->{rest} = { data => \@phenotype_data };
 161 }
 162
 163
 164 sub traits_assayed : Chained('ajax_breeding_program') PathPart('traits_assayed') Args(0) {
 165     my $self = shift;
 166     my $c = shift;
 167     my $program = $c->stash->{program};
 168     my @traits_assayed  =  $program->get_traits_assayed;
 169     $c->stash->{rest} = { traits_assayed => \@traits_assayed };
 170 }
 171
 172 sub trait_phenotypes : Chained('ajax_breeding_program') PathPart('trait_phenotypes') Args(0) {
 173     my $self = shift;
 174     my $c = shift;
 175     my $program = $c->stash->{program};
 176     #get userinfo from db
 177     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 178     #my $user = $c->user();
 179     #if (! $c->user) {
 180     #  $c->stash->{rest} = {
 181     #    status => "not logged in"
 182     #  };
 183     #  return;
 184     #}
 185     my $display = $c->req->param('display') || 'plot' ;
 186     my $trials = $program->get_trials;
 187     my @trial_ids;
 188     while (my $trial = $trials->next() ) {
 189         my $trial_id = $trial->project_id;
 190         push @trial_ids , $trial_id;
 191     }
 192     my $trait = $c->req->param('trait');
 193     my $phenotypes_search = CXGN::Phenotypes::PhenotypeMatrix->new(
 194         bcs_schema=> $schema,
 195         search_type => "MaterializedViewTable",
 196         data_level => $display,
 197         trait_list=> [$trait],
 198         trial_list => \@trial_ids
 199     );
 200     my @data = $phenotypes_search->get_phenotype_matrix();
 201     $c->stash->{rest} = {
 202       status => "success",
 203       data => \@data
 204    };
 205 }
 206
 207
 208 sub accessions : Chained('ajax_breeding_program') PathPart('accessions') Args(0) {
 209     my ($self, $c) = @_;
 210     my $program = $c->stash->{program};
 211     my $accessions = $program->get_accessions;
 212     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 213     my @formatted_accessions;
 214
 215
 216     foreach my $id ( @$accessions ) {
 217         my $acc =  my $row = $schema->resultset("Stock::Stock")->find(
 218             { stock_id => $id , }
 219             );
 220
 221         my $name        = $acc->uniquename;
 222         my $description = $acc->description;
 223         push @formatted_accessions, [ '<a href="/stock/' .$id. '/view">'.$name.'</a>', $description ];
 224     }
 225     $c->stash->{rest} = { data => \@formatted_accessions };
 226 }
 227
 228
 229 sub program_locations :Chained('ajax_breeding_program') PathPart('locations') Args(0){
 230     my $self = shift;
 231     my $c = shift;
 232     my $program = $c->stash->{program};
 233     my $program_locations = $program->get_locations_with_details();
 234     $c->stash->{rest} = {data => $program_locations};
 235
 236 }
 237
 238
 239 sub program_field_trials :Chained('ajax_breeding_program') PathPart('field_trials') Args(0){
 240     my $self = shift;
 241     my $c = shift;
 242
 243     my $start_date = $c->req->param("start_date");
 244     my $end_date = $c->req->param("end_date");
 245     my $program = $c->stash->{program};
 246     my $program_id = $program->get_program_id;
 247     my $schema = $c->stash->{schema};
 248
 249     my $projects = CXGN::BreedersToolbox::Projects->new({schema => $schema});
 250     my @all_trials = $projects->get_trials_by_breeding_program($program_id, $start_date, $end_date);
 251     my $field_trials_ref = $all_trials[0];
 252
 253     my @field_trials;
 254     my @field_trial_data;
 255
 256     if (defined $field_trials_ref) {
 257         @field_trials = @$field_trials_ref;
 258     }
 259
 260     foreach my $trial(@field_trials){
 261         push @field_trial_data, ['<a href="/breeders/trial/'.$$trial[0].'">'.$$trial[1].'</a>', $$trial[2]];
 262     }
 263
 264     $c->stash->{rest} = {data => \@field_trial_data};
 265
 266 }
 267
 268
 269 sub program_genotyping_plates :Chained('ajax_breeding_program') PathPart('genotyping_plates') Args(0){
 270     my $self = shift;
 271     my $c = shift;
 272     my $program = $c->stash->{program};
 273     my $program_id = $program->get_program_id;
 274     my $schema = $c->stash->{schema};
 275
 276     my $projects = CXGN::BreedersToolbox::Projects->new({schema => $schema});
 277     my @all_trials = $projects->get_trials_by_breeding_program($program_id);
 278     my $genotyping_plates_ref = $all_trials[2];
 279
 280     my @genotyping_plates;
 281     my @genotyping_plate_data;
 282
 283     if (defined $genotyping_plates_ref) {
 284         @genotyping_plates = @$genotyping_plates_ref;
 285     }
 286
 287     foreach my $plate(@genotyping_plates){
 288         push @genotyping_plate_data, ['<a href="/breeders/trial/'.$$plate[0].'">'.$$plate[1].'</a>', $$plate[2]];
 289     }
 290
 291     $c->stash->{rest} = {data => \@genotyping_plate_data};
 292
 293 }
 294
 295
 296 sub program_crossing_experiments :Chained('ajax_breeding_program') PathPart('crossing_experiments') Args(0){
 297     my $self = shift;
 298     my $c = shift;
 299     my $program = $c->stash->{program};
 300     my $program_id = $program->get_program_id;
 301     my $schema = $c->stash->{schema};
 302
 303     my $projects = CXGN::BreedersToolbox::Projects->new({schema => $schema});
 304     my @all_trials = $projects->get_trials_by_breeding_program($program_id);
 305     my $crossing_experiment_ref = $all_trials[1];
 306
 307     my @crossing_experiments;
 308     my @crossing_experiment_data;
 309
 310     if (defined $crossing_experiment_ref) {
 311         @crossing_experiments = @$crossing_experiment_ref;
 312     }
 313
 314     foreach my $experiment(@crossing_experiments){
 315         push @crossing_experiment_data, ['<a href="/breeders/trial/'.$$experiment[0].'">'.$$experiment[1].'</a>', $$experiment[2]];
 316     }
 317
 318     $c->stash->{rest} = {data => \@crossing_experiment_data};
 319
 320 }
 321
 322
 323 sub program_crosses :Chained('ajax_breeding_program') PathPart('crosses') Args(0){
 324     my $self = shift;
 325     my $c = shift;
 326     my $program = $c->stash->{program};
 327     my $result = $program->get_crosses;
 328
 329     my @cross_data;
 330     foreach my $r (@$result){
 331         my ($cross_id, $cross_name, $female_parent_id, $female_parent_name, $male_parent_id, $male_parent_name, $cross_type) = @$r;
 332         push @cross_data, [qq{<a href="/cross/$cross_id">$cross_name</a>},
 333         qq{<a href="/stock/$female_parent_id/view">$female_parent_name</a>},
 334         qq{<a href="/stock/$male_parent_id/view">$male_parent_name</a>}, $cross_type]
 335     }
 336
 337     $c->stash->{rest} = {data => \@cross_data};
 338
 339 }
 340
 341
 342 sub program_seedlots :Chained('ajax_breeding_program') PathPart('seedlots') Args(0){
 343     my $self = shift;
 344     my $c = shift;
 345     my $program = $c->stash->{program};
 346     my $result = $program->get_seedlots;
 347 #    print STDERR "SEEDLOTS =".Dumper($result)."\n";
 348     my @seedlot_data;
 349     foreach my $r (@$result){
 350         my ($seedlot_id, $seedlot_name, $content_id, $content_name, $content_type) = @$r;
 351         if ($content_type eq 'accession') {
 352             push @seedlot_data, [qq{<a href="/breeders/seedlot/$seedlot_id">$seedlot_name</a>},
 353             qq{<a href="/stock/$content_id/view">$content_name</a>}, $content_type]
 354         } elsif ($content_type eq 'cross') {
 355             push @seedlot_data, [qq{<a href="/breeders/seedlot/$seedlot_id">$seedlot_name</a>},
 356             qq{<a href="/cross/$content_id">$content_name</a>}, $content_type]
 357         }
 358     }
 359
 360     $c->stash->{rest} = {data => \@seedlot_data};
 361
 362 }
 363
 364
 365 sub add_product_profile : Path('/ajax/breeders/program/add_product_profile') : ActionClass('REST') { }
 366
 367 sub add_product_profile_POST : Args(0) {
 368     my $self = shift;
 369     my $c = shift;
 370     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 371     my $program_id = $c->req->param('profile_program_id');
 372     my $product_profile_name = $c->req->param('product_profile_name');
 373     my $product_profile_scope = $c->req->param('product_profile_scope');
 374     my $trait_list_json = $c->req->param('trait_list_json');
 375     my $target_values_json = $c->req->param('target_values_json');
 376
 377     my @traits = @{_parse_list_from_json($trait_list_json)};
 378     my @target_values = @{_parse_list_from_json($target_values_json)};
 379
 380     my %trait_value_hash;
 381     for my $i (0 .. $#traits) {
 382         $trait_value_hash{$traits[$i]} = $target_values[$i];
 383     }
 384     my $profile_string = encode_json \%trait_value_hash;
 385
 386     my $product_profile = CXGN::BreedersToolbox::ProductProfile->new({ bcs_schema => $schema });
 387     $product_profile->product_profile_name($product_profile_name);
 388     $product_profile->product_profile_scope($product_profile_scope);
 389     $product_profile->product_profile_details($profile_string);
 390     $product_profile->parent_id($program_id);
 391         my $project_prop_id = $product_profile->store_by_rank();
 392
 393 #    print STDERR "PROJECT PROP ID =".Dumper($project_prop_id)."\n";
 394     if ($@) {
 395         $c->stash->{rest} = { error => "Error storing product profile. ($@)" };
 396         return;
 397     }
 398
 399     $c->stash->{rest} = { success => 1};
 400 }
 401
 402
 403 sub get_product_profiles :Chained('ajax_breeding_program') PathPart('product_profiles') Args(0){
 404     my $self = shift;
 405     my $c = shift;
 406     my $program = $c->stash->{program};
 407     my $program_id = $program->get_program_id;
 408     my $schema = $c->stash->{schema};
 409
 410     my $profile_obj = CXGN::BreedersToolbox::ProductProfile->new({ bcs_schema => $schema, parent_id => $program_id });
 411     my $profiles = $profile_obj->get_product_profile_info();
 412 #    print STDERR "PRODUCT PROFILE RESULTS =".Dumper($profiles)."\n";
 413     my @profile_summary;
 414     foreach my $profile(@$profiles){
 415         my @trait_list = ();
 416         my @profile_info = @$profile;
 417         my $projectprop_id = $profile_info[0];
 418         my $profile_name = $profile_info[1];
 419         my $profile_scope = $profile_info[2];
 420         my $profile_details = $profile_info[3];
 421         my $profile_submitter = $profile_info[4];
 422         my $uploaded_date = $profile_info[5];
 423         my $profile_name_link = qq{<a href = "/profile/$projectprop_id">$profile_name</a>};
 424         my $trait_info_ref = decode_json $profile_details;
 425         my %trait_info_hash = %{$trait_info_ref};
 426         my @traits = keys %trait_info_hash;
 427         foreach my $trait(@traits){
 428             my @trait_name = ();
 429             @trait_name = split '\|', $trait;
 430             pop @trait_name;
 431             push @trait_list, @trait_name
 432         }
 433         my @sort_trait_list = sort @trait_list;
 434         my $trait_string = join("<br>", @sort_trait_list);
 435
 436         push @profile_summary, [$profile_name_link, $profile_scope, $trait_string, $profile_submitter, $uploaded_date] ;
 437     }
 438 #    print STDERR "TRAIT LIST =".Dumper(\@profile_summary)."\n";
 439
 440     $c->stash->{rest} = {data => \@profile_summary};
 441
 442 }
 443
 444
 445 sub get_profile_detail :Path('/ajax/breeders/program/profile_detail') :Args(1) {
 446     my $self = shift;
 447     my $c = shift;
 448     my $profile_id = shift;
 449     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 450
 451     my $profile_json_type_id = SGN::Model::Cvterm->get_cvterm_row($c->dbic_schema("Bio::Chado::Schema"), 'product_profile_json', 'project_property')->cvterm_id();
 452     my $profile_rs = $schema->resultset("Project::Projectprop")->search({ projectprop_id => $profile_id, type_id => $profile_json_type_id });
 453
 454     my $profile_row = $profile_rs->next();
 455     my $profile_detail_string = $profile_row->value();
 456
 457     my $profile_detail_hash = decode_json $profile_detail_string;
 458     my $trait_info_string = $profile_detail_hash->{'product_profile_details'};
 459
 460     my $trait_info_hash_ref = decode_json $trait_info_string;
 461     my @all_details;
 462     my %trait_info_hash = %{$trait_info_hash_ref};
 463     my @traits = keys %trait_info_hash;
 464
 465     foreach my $trait_name(@traits){
 466         my @trait_row = ();
 467         push @trait_row, $trait_name;
 468
 469         my $target_value = $trait_info_hash{$trait_name}{'target_value'};
 470         if (defined $target_value){
 471             push @trait_row, $target_value;
 472         } else {
 473             push @trait_row, 'N/A';
 474         }
 475
 476         my $benchmark_variety = $trait_info_hash{$trait_name}{'benchmark_variety'};
 477         if (defined $benchmark_variety){
 478             push @trait_row, $benchmark_variety;
 479         } else {
 480             push @trait_row, 'N/A';
 481         }
 482
 483         my $performance = $trait_info_hash{$trait_name}{'performance'};
 484         if (defined $performance){
 485             push @trait_row, $performance;
 486         } else {
 487             push @trait_row, 'N/A';
 488         }
 489
 490         my $weight = $trait_info_hash{$trait_name}{'weight'};
 491         if (defined $weight) {
 492             push @trait_row, $weight;
 493         } else {
 494             push @trait_row, 'N/A';
 495         }
 496
 497         my $trait_type = $trait_info_hash{$trait_name}{'trait_type'};
 498         if (defined $trait_type) {
 499             push @trait_row, $trait_type;
 500         } else {
 501             push @trait_row, 'N/A';
 502         }
 503
 504         push @all_details, [@trait_row];
 505     }
 506 #    print STDERR "ALL DETAILS =".Dumper(\@all_details)."\n";
 507     $c->stash->{rest} = {data => \@all_details};
 508
 509 }
 510
 511
 512 sub create_profile_template : Path('/ajax/program/create_profile_template') : ActionClass('REST') { }
 513
 514 sub create_profile_template_POST : Args(0) {
 515     my ($self, $c) = @_;
 516
 517     if (!$c->user()) {
 518         $c->stash->{rest} = {error => "You need to be logged in to create a product profile template" };
 519         return;
 520     }
 521     if (!any { $_ eq "curator" || $_ eq "submitter" } ($c->user()->roles)  ) {
 522         $c->stash->{rest} = {error =>  "You have insufficient privileges to create a product profile template." };
 523         return;
 524     }
 525     my $metadata_schema = $c->dbic_schema('CXGN::Metadata::Schema');
 526
 527     my $template_file_name = $c->req->param('template_file_name');
 528     my $user_id = $c->user()->get_object()->get_sp_person_id();
 529     my $user_name = $c->user()->get_object()->get_username();
 530     my $time = DateTime->now();
 531     my $timestamp = $time->ymd()."_".$time->hms();
 532     my $subdirectory_name = "profile_template_files";
 533     my $archived_file_name = catfile($user_id, $subdirectory_name,$timestamp."_".$template_file_name.".xls");
 534     my $archive_path = $c->config->{archive_path};
 535     my $file_destination =  catfile($archive_path, $archived_file_name);
 536     my $dbh = $c->dbc->dbh();
 537     my @trait_ids;
 538     my @trait_list = @{_parse_list_from_json($c->req->param('trait_list_json'))};
 539 #    print STDERR "TRAIT LIST =".Dumper(\@trait_list)."\n";
 540
 541     my %errors;
 542     my @error_messages;
 543     my $tempfile = $c->config->{basepath}."/".$c->tempfile( TEMPLATE => 'other/excelXXXX');
 544     my $wb = Spreadsheet::WriteExcel->new($tempfile);
 545     if (!$wb) {
 546         push @error_messages, "Could not create file.";
 547         $errors{'error_messages'} = \@error_messages;
 548         return \%errors;
 549     }
 550
 551     my $ws = $wb->add_worksheet();
 552
 553     my @headers = ('Trait Name','Target Value','Benchmark Variety','Performance (equal, smaller, larger)','Weight','Trait Type');
 554
 555     for(my $n=0; $n<scalar(@headers); $n++) {
 556         $ws->write(0, $n, $headers[$n]);
 557     }
 558
 559     my $line = 1;
 560     foreach my $trait (@trait_list) {
 561         $ws->write($line, 0, $trait);
 562         $line++;
 563     }
 564
 565     $wb->close();
 566
 567     open(my $F, "<", $tempfile) || die "Can't open file ".$self->tempfile();
 568         binmode $F;
 569         my $md5 = Digest::MD5->new();
 570         $md5->addfile($F);
 571     close($F);
 572
 573     if (!-d $archive_path) {
 574       mkdir $archive_path;
 575     }
 576
 577     if (! -d catfile($archive_path, $user_id)) {
 578       mkdir (catfile($archive_path, $user_id));
 579     }
 580
 581     if (! -d catfile($archive_path, $user_id,$subdirectory_name)) {
 582       mkdir (catfile($archive_path, $user_id, $subdirectory_name));
 583     }
 584
 585     my $md_row = $metadata_schema->resultset("MdMetadata")->create({
 586         create_person_id => $user_id,
 587     });
 588     $md_row->insert();
 589
 590     my $file_row = $metadata_schema->resultset("MdFiles")->create({
 591         basename => basename($file_destination),
 592         dirname => dirname($file_destination),
 593         filetype => 'profile template xls',
 594         md5checksum => $md5->hexdigest(),
 595         metadata_id => $md_row->metadata_id(),
 596     });
 597     $file_row->insert();
 598     my $file_id = $file_row->file_id();
 599
 600     move($tempfile,$file_destination);
 601     unlink $tempfile;
 602
 603     my $result = $file_row->file_id;
 604
 605 #    print STDERR "FILE =".Dumper($file_destination)."\n";
 606 #    print STDERR "FILE ID =".Dumper($file_id)."\n";
 607
 608     $c->stash->{rest} = {
 609         success => 1,
 610         result => $result,
 611         file => $file_destination,
 612         file_id => $file_id,
 613     };
 614
 615 }
 616
 617
 618 sub upload_profile : Path('/ajax/breeders/program/upload_profile') : ActionClass('REST') { }
 619 sub upload_profile_POST : Args(0) {
 620     my $self = shift;
 621     my $c = shift;
 622     my $user_id;
 623     my $user_name;
 624     my $user_role;
 625     my $session_id = $c->req->param("sgn_session_id");
 626
 627     if ($session_id){
 628         my $dbh = $c->dbc->dbh;
 629         my @user_info = CXGN::Login->new($dbh)->query_from_cookie($session_id);
 630         if (!$user_info[0]){
 631             $c->stash->{rest} = {error=>'You must be logged in to upload product profile!'};
 632             return;
 633         }
 634         $user_id = $user_info[0];
 635         $user_role = $user_info[1];
 636         my $p = CXGN::People::Person->new($dbh, $user_id);
 637         $user_name = $p->get_username;
 638     } else{
 639         if (!$c->user){
 640             $c->stash->{rest} = {error=>'You must be logged in to upload product profile!'};
 641             return;
 642         }
 643         $user_id = $c->user()->get_object()->get_sp_person_id();
 644         $user_name = $c->user()->get_object()->get_username();
 645         $user_role = $c->user->get_object->get_user_type();
 646     }
 647
 648     if (!any { $_ eq 'curator' || $_ eq 'submitter' } ($user_role)) {
 649         $c->stash->{rest} = {error =>  'You have insufficient privileges to upload product profile.' };
 650         return;
 651     }
 652
 653     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 654     my $phenome_schema = $c->dbic_schema("CXGN::Phenome::Schema");
 655     my $program_id = $c->req->param('profile_program_id');
 656     my $new_profile_name = $c->req->param('new_profile_name');
 657     my $new_profile_scope = $c->req->param('new_profile_scope');
 658     $new_profile_name =~ s/^\s+|\s+$//g;
 659
 660     my $profile_obj = CXGN::BreedersToolbox::ProductProfile->new({ bcs_schema => $schema, parent_id => $program_id });
 661     my $profiles = $profile_obj->get_product_profile_info();
 662     my @db_profile_names;
 663     foreach my $profile(@$profiles){
 664         my @profile_info = @$profile;
 665         my $stored_profile_name = $profile_info[1];
 666         push @db_profile_names, $stored_profile_name;
 667     }
 668     if ($new_profile_name ~~ @db_profile_names){
 669         $c->stash->{rest} = {error=>'Please use different product profile name. This name is already used for another product profile!'};
 670         return;
 671     }
 672
 673     my $upload = $c->req->upload('profile_uploaded_file');
 674     my $subdirectory = "profile_upload";
 675     my $upload_original_name = $upload->filename();
 676     my $upload_tempfile = $upload->tempname;
 677     my $time = DateTime->now();
 678     my $timestamp = $time->ymd()."_".$time->hms();
 679     my $uploaded_date = $time->ymd();
 680 #    print STDERR "PROGRAM ID =".Dumper($program_id)."\n";
 681 #    print STDERR "PROFILE NAME =".Dumper($new_profile_name)."\n";
 682 #    print STDERR "PROFILE SCOPE =".Dumper($new_profile_scope)."\n";
 683
 684     ## Store uploaded temporary file in archive
 685     my $uploader = CXGN::UploadFile->new({
 686         tempfile => $upload_tempfile,
 687         subdirectory => $subdirectory,
 688         archive_path => $c->config->{archive_path},
 689         archive_filename => $upload_original_name,
 690         timestamp => $timestamp,
 691         user_id => $user_id,
 692         user_role => $user_role
 693     });
 694     my $archived_filename_with_path = $uploader->archive();
 695     my $md5 = $uploader->get_md5($archived_filename_with_path);
 696     if (!$archived_filename_with_path) {
 697         $c->stash->{rest} = {error => "Could not save file $upload_original_name in archive",};
 698         $c->detach();
 699     }
 700     unlink $upload_tempfile;
 701     my $parser = CXGN::Trial::ParseUpload->new(chado_schema => $schema, filename => $archived_filename_with_path);
 702     $parser->load_plugin('ProfileXLS');
 703     my $parsed_data = $parser->parse();
 704     print STDERR "PARSED DATA =".Dumper($parsed_data)."\n";
 705
 706     my $profile_detail_string;
 707     if ($parsed_data){
 708         $profile_detail_string = encode_json $parsed_data;
 709     }
 710
 711     if (!$parsed_data) {
 712         my $return_error = '';
 713         my $parse_errors;
 714         if (!$parser->has_parse_errors() ){
 715             $c->stash->{rest} = {error_string => "Could not get parsing errors"};
 716         } else {
 717             $parse_errors = $parser->get_parse_errors();
 718             #print STDERR Dumper $parse_errors;
 719
 720             foreach my $error_string (@{$parse_errors->{'error_messages'}}){
 721                 $return_error .= $error_string."<br>";
 722             }
 723         }
 724         $c->stash->{rest} = {error_string => $return_error, missing_accessions => $parse_errors->{'missing_accessions'} };
 725         $c->detach();
 726     }
 727
 728     my $profile = CXGN::BreedersToolbox::ProductProfile->new({ bcs_schema => $schema });
 729     $profile->product_profile_name($new_profile_name);
 730     $profile->product_profile_scope($new_profile_scope);
 731     $profile->product_profile_details($profile_detail_string);
 732     $profile->product_profile_submitter($user_name);
 733     $profile->product_profile_uploaded_date($uploaded_date);
 734     $profile->parent_id($program_id);
 735         my $project_prop_id = $profile->store_by_rank();
 736
 737     if ($@) {
 738         $c->stash->{rest} = { error => $@ };
 739         print STDERR "An error condition occurred, was not able to upload profile. ($@).\n";
 740         $c->detach();
 741     }
 742
 743     $c->stash->{rest} = { success => 1 };
 744
 745 }
 746
 747
 748 sub get_autogenerated_name_metadata :Chained('ajax_breeding_program') PathPart('autogenerated_name_metadata') Args(0){
 749     my $self = shift;
 750     my $c = shift;
 751     my $program = $c->stash->{program};
 752     my $program_id = $program->get_program_id;
 753     my $schema = $c->stash->{schema};
 754     my $dbh = $c->dbc->dbh();
 755
 756     my $projects = CXGN::BreedersToolbox::Projects->new({schema => $schema});
 757     my $return = $projects->get_autogenerated_name_metadata_by_breeding_program($program_id);
 758     my $name_metadata = $return->{name_metadata};
 759
 760     my @autogenerated_name_metadata;
 761
 762     foreach my $format_name (keys %$name_metadata) {
 763         my $description = $name_metadata->{$format_name}->{'description'};
 764         my $name_type = $name_metadata->{$format_name}->{'name_type'};
 765         my $name_attributes = $name_metadata->{$format_name}->{'name_attributes'};
 766         my @all_attributes = ();
 767
 768         foreach my $attribute (@$name_attributes) {
 769             if (ref $attribute eq ref {}) {
 770                 my %text_hash = %{$attribute};
 771                 my $text = $text_hash{'text'};
 772                 push @all_attributes, $text;
 773             } else {
 774                 push @all_attributes, $attribute;
 775             }
 776         }
 777         my $attributes_string = join("_", @all_attributes);
 778
 779         my $last_serial_number = $name_metadata->{$format_name}->{'last_serial_number'};
 780         my $added_by = $name_metadata->{$format_name}->{'added_by'};
 781         my $created_date = $name_metadata->{$format_name}->{'date'};
 782
 783         my $person = CXGN::People::Person->new($dbh, $added_by);
 784         my $person_name = $person->get_first_name()." ".$person->get_last_name();
 785
 786         push @autogenerated_name_metadata, [$format_name, $description, $name_type, $attributes_string, $last_serial_number, $person_name, $created_date];
 787     }
 788
 789     $c->stash->{rest} = {data => \@autogenerated_name_metadata};
 790
 791 }
 792
 793
 794 sub _parse_list_from_json {
 795     my $list_json = shift;
 796     my $json = JSON->new();
 797
 798     if ($list_json) {
 799         my $decoded_list = $json->allow_nonref->utf8->relaxed->escape_slash->loose->allow_singlequote->allow_barekey->decode($list_json);
 800         #my $decoded_list = decode_json($list_json);
 801         my @array_of_list_items = @{$decoded_list};
 802         return \@array_of_list_items;
 803     }
 804     else {
 805         return;
 806     }
 807 }
 808
 809
 810
 811 1;