lib/SGN/Controller/AJAX/Cross.pm

   1
   2 =head1 NAME
   3
   4 SGN::Controller::AJAX::Cross - a REST controller class to provide the
   5 functions for adding crosses
   6
   7 =head1 DESCRIPTION
   8
   9 Add a new cross or upload a file containing crosses to add
  10
  11 =head1 AUTHOR
  12
  13 Jeremy Edwards <jde22@cornell.edu>
  14 Lukas Mueller <lam87@cornell.edu>
  15
  16 =cut
  17
  18 package SGN::Controller::AJAX::Cross;
  19
  20 use Moose;
  21 use Try::Tiny;
  22 use DateTime;
  23 use Data::Dumper;
  24 use File::Basename qw | basename dirname|;
  25 use File::Copy;
  26 use File::Slurp;
  27 use File::Spec::Functions;
  28 use Digest::MD5;
  29 use List::MoreUtils qw /any /;
  30 use Bio::GeneticRelationships::Pedigree;
  31 use Bio::GeneticRelationships::Individual;
  32 use CXGN::UploadFile;
  33 use CXGN::Pedigree::AddCrosses;
  34 use CXGN::Pedigree::AddProgeny;
  35 use CXGN::Pedigree::AddCrossInfo;
  36 use CXGN::Pedigree::ParseUpload;
  37
  38 BEGIN { extends 'Catalyst::Controller::REST' }
  39
  40 __PACKAGE__->config(
  41     default   => 'application/json',
  42     stash_key => 'rest',
  43     map       => { 'application/json' => 'JSON', 'text/html' => 'JSON' },
  44    );
  45
  46 sub upload_cross_file : Path('/ajax/cross/upload_crosses_file') : ActionClass('REST') { }
  47
  48 sub upload_cross_file_POST : Args(0) {
  49   my ($self, $c) = @_;
  50   my $chado_schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
  51   my $metadata_schema = $c->dbic_schema("CXGN::Metadata::Schema");
  52   my $phenome_schema = $c->dbic_schema("CXGN::Phenome::Schema");
  53   my $dbh = $c->dbc->dbh;
  54   my $program = $c->req->param('cross_upload_breeding_program');
  55   my $location = $c->req->param('cross_upload_location');
  56   my $upload = $c->req->upload('crosses_upload_file');
  57   my $prefix = $c->req->param('upload_prefix');
  58   my $suffix = $c->req->param('upload_suffix');
  59   my $uploader = CXGN::UploadFile->new();
  60   my $parser;
  61   my $parsed_data;
  62   my $upload_original_name = $upload->filename();
  63   my $upload_tempfile = $upload->tempname;
  64   my $subdirectory = "cross_upload";
  65   my $archived_filename_with_path;
  66   my $md5;
  67   my $validate_file;
  68   my $parsed_file;
  69   my $parse_errors;
  70   my %parsed_data;
  71   my %upload_metadata;
  72   my $time = DateTime->now();
  73   my $timestamp = $time->ymd()."_".$time->hms();
  74   my $user_id;
  75   my $owner_name;
  76   my $upload_file_type = "crosses excel";#get from form when more options are added
  77
  78   if (!$c->user()) {
  79     print STDERR "User not logged in... not adding a crosses.\n";
  80     $c->stash->{rest} = {error => "You need to be logged in to add a cross." };
  81     return;
  82   }
  83   $user_id = $c->user()->get_object()->get_sp_person_id();
  84
  85   $owner_name = $c->user()->get_object()->get_username();
  86
  87   ## Store uploaded temporary file in archive
  88   $archived_filename_with_path = $uploader->archive($c, $subdirectory, $upload_tempfile, $upload_original_name, $timestamp);
  89   $md5 = $uploader->get_md5($archived_filename_with_path);
  90   if (!$archived_filename_with_path) {
  91       $c->stash->{rest} = {error => "Could not save file $upload_original_name in archive",};
  92       return;
  93   }
  94   unlink $upload_tempfile;
  95
  96   $upload_metadata{'archived_file'} = $archived_filename_with_path;
  97   $upload_metadata{'archived_file_type'}="cross upload file";
  98   $upload_metadata{'user_id'}=$user_id;
  99   $upload_metadata{'date'}="$timestamp";
 100
 101   #parse uploaded file with appropriate plugin
 102   $parser = CXGN::Pedigree::ParseUpload->new(chado_schema => $chado_schema, filename => $archived_filename_with_path);
 103   $parser->load_plugin('CrossesExcelFormat');
 104   $parsed_data = $parser->parse();
 105
 106   if (!$parsed_data) {
 107     my $return_error = '';
 108
 109     if (! $parser->has_parse_errors() ){
 110       $return_error = "Could not get parsing errors";
 111       $c->stash->{rest} = {error_string => $return_error,};
 112     }
 113
 114     else {
 115       $parse_errors = $parser->get_parse_errors();
 116       foreach my $error_string (@{$parse_errors}){
 117         $return_error=$return_error.$error_string."<br>";
 118       }
 119     }
 120
 121     $c->stash->{rest} = {error_string => $return_error,};
 122     return;
 123   }
 124
 125   my $cross_add = CXGN::Pedigree::AddCrosses
 126     ->new({
 127            chado_schema => $chado_schema,
 128            phenome_schema => $phenome_schema,
 129            metadata_schema => $metadata_schema,
 130            dbh => $dbh,
 131            location => $location,
 132            program => $program,
 133            crosses =>  $parsed_data->{crosses},
 134            owner_name => $owner_name,
 135           });
 136
 137   #validate the crosses
 138   if (!$cross_add->validate_crosses()){
 139     $c->stash->{rest} = {error_string => "Error validating crosses",};
 140     return;
 141   }
 142
 143   #add the crosses
 144   if (!$cross_add->add_crosses()){
 145     $c->stash->{rest} = {error_string => "Error adding crosses",};
 146     return;
 147   }
 148
 149   #add the progeny
 150   foreach my $cross_name_key (keys %{$parsed_data->{progeny}}){
 151     my $progeny_number = $parsed_data->{progeny}->{$cross_name_key};
 152     my $progeny_increment = 1;
 153     my @progeny_names;
 154
 155     #create array of progeny names to add for this cross
 156     while ($progeny_increment < $progeny_number + 1) {
 157       $progeny_increment = sprintf "%03d", $progeny_increment;
 158       my $stock_name = $cross_name_key.$prefix.$progeny_increment.$suffix;
 159       push @progeny_names, $stock_name;
 160       $progeny_increment++;
 161     }
 162
 163     #add array of progeny to the cross
 164     my $progeny_add = CXGN::Pedigree::AddProgeny
 165       ->new({
 166              chado_schema => $chado_schema,
 167              phenome_schema => $phenome_schema,
 168              dbh => $dbh,
 169              cross_name => $cross_name_key,
 170              progeny_names => \@progeny_names,
 171              owner_name => $owner_name,
 172             });
 173     if (!$progeny_add->add_progeny()){
 174       $c->stash->{rest} = {error_string => "Error adding progeny",};
 175       #should delete crosses and other progeny if add progeny fails?
 176       return;
 177     }
 178   }
 179
 180   #add the number of flowers to crosses
 181   foreach my $cross_name_key (keys %{$parsed_data->{flowers}}) {
 182     my $number_of_flowers = $parsed_data->{flowers}->{$cross_name_key};
 183     my $cross_add_info = CXGN::Pedigree::AddCrossInfo->new({ chado_schema => $chado_schema, cross_name => $cross_name_key} );
 184     $cross_add_info->set_number_of_flowers($number_of_flowers);
 185     $cross_add_info->add_info();
 186   }
 187
 188   #add the number of seeds to crosses
 189   foreach my $cross_name_key (keys %{$parsed_data->{seeds}}) {
 190     my $number_of_seeds = $parsed_data->{seeds}->{$cross_name_key};
 191     my $cross_add_info = CXGN::Pedigree::AddCrossInfo->new({ chado_schema => $chado_schema, cross_name => $cross_name_key} );
 192     $cross_add_info->set_number_of_seeds($number_of_seeds);
 193     $cross_add_info->add_info();
 194   }
 195
 196   $c->stash->{rest} = {success => "1",};
 197 }
 198
 199
 200 sub add_cross : Local : ActionClass('REST') { }
 201
 202 sub add_cross_POST :Args(0) {
 203     my ($self, $c) = @_;
 204     my $chado_schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 205     my $metadata_schema = $c->dbic_schema("CXGN::Metadata::Schema");
 206     my $phenome_schema = $c->dbic_schema("CXGN::Phenome::Schema");
 207     my $dbh = $c->dbc->dbh;
 208     my $cross_name = $c->req->param('cross_name');
 209     my $cross_type = $c->req->param('cross_type');
 210     my $program = $c->req->param('program');
 211     my $location = $c->req->param('location');
 212     my $maternal = $c->req->param('maternal_parent');
 213     my $paternal = $c->req->param('paternal_parent');
 214     my $prefix = $c->req->param('prefix');
 215     my $suffix = $c->req->param('suffix');
 216     my $progeny_number = $c->req->param('progeny_number');
 217     my $number_of_flowers = $c->req->param('number_of_flowers');
 218     my $number_of_seeds = $c->req->param('number_of_seeds');
 219     my $visible_to_role = $c->req->param('visible_to_role');
 220     my $cross_add;
 221     my $progeny_add;
 222     my @progeny_names;
 223     my @array_of_pedigree_objects;
 224     my $progeny_increment = 1;
 225     my $paternal_parent_not_required;
 226     my $number_of_flowers_cvterm;
 227     my $number_of_seeds_cvterm;
 228     my $owner_name;
 229
 230     if ($cross_type eq "open" || $cross_type eq "bulk_open") {
 231       $paternal_parent_not_required = 1;
 232     }
 233
 234     print STDERR "Adding Cross... Maternal: $maternal Paternal: $paternal Cross Type: $cross_type\n";
 235
 236     if (!$c->user()) {
 237         print STDERR "User not logged in... not adding a cross.\n";
 238         $c->stash->{rest} = {error => "You need to be logged in to add a cross." };
 239         return;
 240     }
 241
 242     $owner_name = $c->user()->get_object()->get_username();
 243
 244     if (!any { $_ eq "curator" || $_ eq "submitter" } ($c->user()->roles)  ) {
 245         print STDERR "User does not have sufficient privileges.\n";
 246         $c->stash->{rest} = {error =>  "you have insufficient privileges to add a cross." };
 247         return;
 248     }
 249
 250     #check that progeny number is an integer less than maximum allowed
 251     my $maximum_progeny_number = 999; #higher numbers break cross name convention
 252     if ($progeny_number) {
 253       if ((! $progeny_number =~ m/^\d+$/) or ($progeny_number > $maximum_progeny_number) or ($progeny_number < 1)) {
 254         $c->stash->{rest} = {error =>  "progeny number exceeds the maximum of $maximum_progeny_number or is invalid." };
 255         return;
 256       }
 257     }
 258
 259     #check that maternal name is not blank
 260     if ($maternal eq "") {
 261       $c->stash->{rest} = {error =>  "maternal parent name cannot be blank." };
 262       return;
 263     }
 264
 265     #if required, check that paternal parent name is not blank;
 266     if ($paternal eq "" && !$paternal_parent_not_required) {
 267       $c->stash->{rest} = {error =>  "paternal parent name cannot be blank." };
 268       return;
 269     }
 270
 271     #check that parents exist in the database
 272     if (! $chado_schema->resultset("Stock::Stock")->find({name=>$maternal,})){
 273       $c->stash->{rest} = {error =>  "maternal parent does not exist." };
 274       return;
 275     }
 276
 277     if (!$paternal_parent_not_required) {
 278       if (! $chado_schema->resultset("Stock::Stock")->find({name=>$paternal,})){
 279         $c->stash->{rest} = {error =>  "paternal parent does not exist." };
 280         return;
 281       }
 282     }
 283
 284     #check that cross name does not already exist
 285     if ($chado_schema->resultset("Stock::Stock")->find({name=>$cross_name})){
 286       $c->stash->{rest} = {error =>  "cross name already exists." };
 287       return;
 288     }
 289
 290     #check that progeny do not already exist
 291     if ($chado_schema->resultset("Stock::Stock")->find({name=>$cross_name.$prefix.'001'.$suffix,})){
 292       $c->stash->{rest} = {error =>  "progeny already exist." };
 293       return;
 294     }
 295
 296     #objects to store cross information
 297     my $cross_to_add = Bio::GeneticRelationships::Pedigree->new(name => $cross_name, cross_type => $cross_type);
 298     my $female_individual = Bio::GeneticRelationships::Individual->new(name => $maternal);
 299     $cross_to_add->set_female_parent($female_individual);
 300
 301     if (!$paternal_parent_not_required){
 302       my $male_individual = Bio::GeneticRelationships::Individual->new(name => $paternal);
 303       $cross_to_add->set_male_parent($male_individual);
 304     }
 305
 306
 307     $cross_to_add->set_cross_type($cross_type);
 308     $cross_to_add->set_name($cross_name);
 309
 310     eval {
 311         #create array of pedigree objects to add, in this case just one pedigree
 312         @array_of_pedigree_objects = ($cross_to_add);
 313         $cross_add = CXGN::Pedigree::AddCrosses
 314             ->new({
 315                 chado_schema => $chado_schema,
 316                 phenome_schema => $phenome_schema,
 317                 #metadata_schema => $metadata_schema,
 318                 dbh => $dbh,
 319                 location => $location,
 320                 program => $program,
 321                 crosses =>  \@array_of_pedigree_objects,
 322                 owner_name => $owner_name,
 323                   });
 324
 325
 326         #add the crosses
 327         $cross_add->add_crosses();
 328     };
 329     if ($@) {
 330         $c->stash->{rest} = { error => "Error creating the cross: $@" };
 331         return;
 332     }
 333
 334     eval {
 335         #create progeny if specified
 336         if ($progeny_number) {
 337
 338             #create array of progeny names to add for this cross
 339             while ($progeny_increment < $progeny_number + 1) {
 340                 $progeny_increment = sprintf "%03d", $progeny_increment;
 341                 my $stock_name = $cross_name.$prefix.$progeny_increment.$suffix;
 342                 push @progeny_names, $stock_name;
 343                 $progeny_increment++;
 344             }
 345
 346             #add array of progeny to the cross
 347             $progeny_add = CXGN::Pedigree::AddProgeny
 348                 ->new({
 349                     chado_schema => $chado_schema,
 350                     phenome_schema => $phenome_schema,
 351                     dbh => $dbh,
 352                     cross_name => $cross_name,
 353                     progeny_names => \@progeny_names,
 354                     owner_name => $owner_name,
 355                       });
 356             $progeny_add->add_progeny();
 357
 358         }
 359
 360         #add number of flowers as an experimentprop if specified
 361         if ($number_of_flowers) {
 362             my $cross_add_info = CXGN::Pedigree::AddCrossInfo->new({ chado_schema => $chado_schema, cross_name => $cross_name} );
 363             $cross_add_info->set_number_of_flowers($number_of_flowers);
 364             $cross_add_info->add_info();
 365         }
 366
 367         #add number of seeds as an experimentprop if specified
 368         if ($number_of_seeds) {
 369             my $cross_add_info = CXGN::Pedigree::AddCrossInfo->new({ chado_schema => $chado_schema, cross_name => $cross_name} );
 370             $cross_add_info->set_number_of_seeds($number_of_seeds);
 371             $cross_add_info->add_info();
 372         }
 373
 374     };
 375     if ($@) {
 376         $c->stash->{rest} = { error => "An error occurred: $@"};
 377         return;
 378     }
 379
 380     $c->stash->{rest} = { error => '', };
 381   }
 382
 383 sub get_cross_relationships :Path('/cross/ajax/relationships') :Args(1) {
 384     my $self = shift;
 385     my $c = shift;
 386     my $cross_id = shift;
 387
 388     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 389
 390     my $cross = $schema->resultset("Stock::Stock")->find( { stock_id => $cross_id });
 391
 392     if ($cross && $cross->type()->name() ne "cross") {
 393         $c->stash->{rest} = { error => 'This entry is not of type cross and cannot be displayed using this page.' };
 394         return;
 395     }
 396
 397     my $crs = $schema->resultset("Stock::StockRelationship")->search( { object_id => $cross_id } );
 398
 399     my $maternal_parent = "";
 400     my $paternal_parent = "";
 401     my @progeny = ();
 402
 403     foreach my $child ($crs->all()) {
 404         if ($child->type->name() eq "female_parent") {
 405             $maternal_parent = [ $child->subject->name, $child->subject->stock_id() ];
 406         }
 407         if ($child->type->name() eq "male_parent") {
 408             $paternal_parent = [ $child->subject->name, $child->subject->stock_id() ];
 409         }
 410         if ($child->type->name() eq "member_of") {
 411             push @progeny, [ $child->subject->name, $child->subject->stock_id() ];
 412         }
 413     }
 414
 415     $c->stash->{rest} = { maternal_parent => $maternal_parent,
 416                           paternal_parent => $paternal_parent,
 417                           progeny => \@progeny,
 418     };
 419 }
 420
 421
 422 sub get_cross_properties :Path('/cross/ajax/properties') Args(1) {
 423     my $self = shift;
 424     my $c = shift;
 425     my $cross_id = shift;
 426
 427     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 428
 429     my $rs = $schema->resultset("NaturalDiversity::NdExperimentprop")->search( { 'nd_experiment_stocks.stock_id' => $cross_id }, { join => { 'nd_experiment' =>  'nd_experiment_stocks' }});
 430
 431     my $props = {};
 432
 433     print STDERR "PROPS LEN ".$rs->count()."\n";
 434
 435     while (my $prop = $rs->next()) {
 436         push @{$props->{$prop->type->name()}}, [ $prop->get_column('value'), $prop->get_column('nd_experimentprop_id') ];
 437     }
 438
 439     print STDERR Dumper($props);
 440     $c->stash->{rest} = { props => $props };
 441
 442
 443 }
 444
 445 sub save_property_check :Path('/cross/property/check') Args(1) {
 446     my $self = shift;
 447     my $c = shift;
 448     my $cross_id = shift;
 449
 450     my $type = $c->req->param("type");
 451     my $value = $c->req->param("value");
 452
 453
 454     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 455     my $type_row = $schema->resultset('Cv::Cvterm')->find( { name => $type } );
 456
 457     if (! $type_row) {
 458         $c->stash->{rest} = { error => "The type '$type' does not exist in the database" };
 459         return;
 460     }
 461
 462     my $type_id = $type_row->cvterm_id();
 463
 464     my %suggested_values = (
 465         cross_type =>  { 'biparental'=>1, 'self'=>1, 'open pollinated'=>1, 'bulk'=>1, 'bulk selfed'=>1, 'bulk and open pollinated'=>1, 'doubled haplotype'=>1 },
 466         number_of_flowers => '\d+',
 467         number_of_seeds => '\d+',
 468         date => '\d{4}\\/\d{2}\\/\d{2}',
 469         time => '\d+\:\d+',
 470         operator => '.*',
 471         cross_name => '.*',
 472         );
 473
 474     my %example_values = (
 475         date => '2014/03/29',
 476         time => '10:00',
 477         number_of_flowers => 23,
 478         number_of_seeds => 42,
 479         operator => 'Alfonso',
 480         cross_name => 'nextgen_cross',
 481         );
 482
 483     if (ref($suggested_values{$type})) {
 484         if (!exists($suggested_values{$type}->{$value})) { # don't make this case insensitive!
 485             $c->stash->{rest} =  { message => 'The provided value is not in the suggested list of terms. This could affect downstream data processing.' };
 486             return;
 487         }
 488     }
 489     else {
 490         if ($value !~ m/^$suggested_values{$type}$/) {
 491             $c->stash->{rest} = { error => 'The provided value is not of the correct type. Format example: "'.$example_values{$type}.'"' };
 492             return;
 493         }
 494     }
 495     $c->stash->{rest} = { success => 1 };
 496 }
 497
 498 sub cross_property_save :Path('/cross/property/save') Args(1) {
 499     my $self = shift;
 500     my $c = shift;
 501
 502     if (!$c->user()) {
 503         $c->stash->{rest} = { error => "You must be logged in add properties." };
 504         return;
 505     }
 506     if (!($c->user()->has_role('submitter') or $c->user()->has_role('curator'))) {
 507         $c->stash->{rest} = { error => "You do not have sufficient privileges to add properties." };
 508         return;
 509     }
 510
 511     my $cross_id = $c->req->param("cross_id");
 512     my $type  = $c->req->param("type");
 513     my $value    = $c->req->param("value");
 514
 515     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 516
 517     my $exp_id = $schema->resultset("NaturalDiversity::NdExperiment")->search( { 'nd_experiment_stocks.stock_id' => $cross_id }, { join => 'nd_experiment_stocks' })->first()->get_column('nd_experiment_id');
 518
 519     my $type_id;
 520     my $type_row = $schema->resultset("Cv::Cvterm")->find( { 'me.name' => $type, 'cv.name' => 'nd_experiment_property' }, { join => { 'cv'}});
 521     if ($type_row) {
 522         $type_id = $type_row->cvterm_id();
 523     }
 524     else {
 525         $c->stash->{rest} = { error => "The type $type does not exist in the database." };
 526         return;
 527     }
 528
 529     my $rs = $schema->resultset("NaturalDiversity::NdExperimentprop")->search( { 'nd_experiment_stocks.stock_id' => $cross_id, 'me.type_id' => $type_id }, { join => { 'nd_experiment' => { 'nd_experiment_stocks' }}});
 530
 531     my $row = $rs->first();
 532     if (!$row) {
 533         $row = $schema->resultset("NaturalDiversity::NdExperimentprop")->create( { 'nd_experiment_stocks.stock_id' => $cross_id, 'me.type_id' => $type_id, 'me.value'=>$value, 'me.nd_experiment_id' => $exp_id }, { join => {'nd_experiment' => {'nd_experiment_stocks' }}});
 534         $row->insert();
 535     }
 536     else {
 537
 538         $row->set_column( 'value' => $value );
 539         $row->update();
 540     }
 541
 542     $c->stash->{rest} = { success => 1 };
 543 }
 544
 545
 546 sub add_more_progeny :Path('/cross/progeny/add') Args(1) {
 547     my $self = shift;
 548     my $c = shift;
 549     my $cross_id = shift;
 550
 551     if (!$c->user()) {
 552         $c->stash->{rest} = { error => "You must be logged in add progeny." };
 553         return;
 554     }
 555     if (!($c->user()->has_role('submitter') or $c->user()->has_role('curator'))) {
 556         $c->stash->{rest} = { error => "You do not have sufficient privileges to add progeny." };
 557         return;
 558     }
 559
 560     my $basename = $c->req->param("basename");
 561     my $start_number = $c->req->param("start_number");
 562     my $progeny_count = $c->req->param("progeny_count");
 563     my $cross_name = $c->req->param("cross_name");
 564
 565     my @progeny_names = ();
 566     foreach my $n (1..$progeny_count) {
 567         push @progeny_names, $basename. (sprintf "%03d", $n + $start_number -1);
 568     }
 569
 570     print STDERR Dumper(\@progeny_names);
 571
 572     my $chado_schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 573     my $metadata_schema = $c->dbic_schema("CXGN::Metadata::Schema");
 574     my $phenome_schema = $c->dbic_schema("CXGN::Phenome::Schema");
 575     my $dbh = $c->dbc->dbh;
 576
 577     my $owner_name = $c->user()->get_object()->get_username();
 578
 579     my $progeny_add = CXGN::Pedigree::AddProgeny
 580         ->new({
 581             chado_schema => $chado_schema,
 582             phenome_schema => $phenome_schema,
 583             dbh => $dbh,
 584             cross_name => $cross_name,
 585             progeny_names => \@progeny_names,
 586             owner_name => $owner_name,
 587               });
 588     if (!$progeny_add->add_progeny()){
 589       $c->stash->{rest} = {error_string => "Error adding progeny. Please change the input parameters and try again.",};
 590       #should delete crosses and other progeny if add progeny fails?
 591       return;
 592     }
 593
 594     $c->stash->{rest} = { success => 1};
 595
 596 }
 597
 598
 599
 600 ###
 601 1;#
 602 ###