lib/SGN/Controller/AJAX/Accessions.pm

   1
   2 =head1 NAME
   3
   4 SGN::Controller::AJAX::Accessions - a REST controller class to provide the
   5 backend for managing accessions
   6
   7 =head1 DESCRIPTION
   8
   9 Managing accessions
  10
  11 =head1 AUTHOR
  12
  13 Jeremy Edwards <jde22@cornell.edu>
  14
  15 =cut
  16
  17 package SGN::Controller::AJAX::Accessions;
  18
  19 use Moose;
  20 use JSON -support_by_pp;
  21 use List::MoreUtils qw /any /;
  22 use CXGN::Stock::StockLookup;
  23 use CXGN::BreedersToolbox::Accessions;
  24 use CXGN::BreedersToolbox::StocksFuzzySearch;
  25 use CXGN::BreedersToolbox::OrganismFuzzySearch;
  26 use CXGN::Stock::Accession;
  27 use CXGN::Chado::Stock;
  28 use CXGN::List;
  29 use Data::Dumper;
  30 use Try::Tiny;
  31 use CXGN::Stock::ParseUpload;
  32 use CXGN::BreederSearch;
  33 #use JSON;
  34
  35 BEGIN { extends 'Catalyst::Controller::REST' }
  36
  37 __PACKAGE__->config(
  38     default   => 'application/json',
  39     stash_key => 'rest',
  40     map       => { 'application/json' => 'JSON', 'text/html' => 'JSON' },
  41    );
  42
  43 sub verify_accession_list : Path('/ajax/accession_list/verify') : ActionClass('REST') { }
  44
  45 sub verify_accession_list_GET : Args(0) {
  46     my $self = shift;
  47     my $c = shift;
  48     $self->verify_accession_list_POST($c);
  49 }
  50
  51 sub verify_accession_list_POST : Args(0) {
  52   my ($self, $c) = @_;
  53
  54   my $accession_list_json = $c->req->param('accession_list');
  55   my $organism_list_json = $c->req->param('organism_list');
  56   my @accession_list = @{_parse_list_from_json($accession_list_json)};
  57   my @organism_list = $organism_list_json ? @{_parse_list_from_json($organism_list_json)} : [];
  58
  59   my $do_fuzzy_search = $c->req->param('do_fuzzy_search');
  60
  61   if ($do_fuzzy_search) {
  62       $self->do_fuzzy_search($c, \@accession_list, \@organism_list);
  63   }
  64   else {
  65       $self->do_exact_search($c, \@accession_list, \@organism_list);
  66   }
  67
  68 }
  69
  70 sub do_fuzzy_search {
  71     my $self = shift;
  72     my $c = shift;
  73     my $accession_list = shift;
  74     my $organism_list = shift;
  75     print STDERR "DoFuzzySearch 1".localtime()."\n";
  76
  77     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
  78     my $fuzzy_accession_search = CXGN::BreedersToolbox::StocksFuzzySearch->new({schema => $schema});
  79     my $fuzzy_organism_search = CXGN::BreedersToolbox::OrganismFuzzySearch->new({schema => $schema});
  80     my $max_distance = 0.2;
  81     my @accession_list = @$accession_list;
  82     my @organism_list = @$organism_list;
  83     my $found_accessions;
  84     my $fuzzy_accessions;
  85     my $absent_accessions;
  86     my $found_organisms;
  87     my $fuzzy_organisms;
  88     my $absent_organisms;
  89
  90     if (!$c->user()) {
  91         $c->stash->{rest} = {error => "You need to be logged in to add accessions." };
  92         return;
  93     }
  94     if (!any { $_ eq "curator" || $_ eq "submitter" } ($c->user()->roles)  ) {
  95         $c->stash->{rest} = {error =>  "You have insufficient privileges to add accessions." };
  96         return;
  97     }
  98     #remove all trailing and ending spaces from accessions and organisms
  99     s/^\s+|\s+$//g for @accession_list;
 100     s/^\s+|\s+$//g for @organism_list;
 101
 102     my $fuzzy_search_result = $fuzzy_accession_search->get_matches(\@accession_list, $max_distance, 'accession');
 103     #print STDERR "\n\nAccessionFuzzyResult:\n".Data::Dumper::Dumper($fuzzy_search_result)."\n\n";
 104     print STDERR "DoFuzzySearch 2".localtime()."\n";
 105
 106     $found_accessions = $fuzzy_search_result->{'found'};
 107     $fuzzy_accessions = $fuzzy_search_result->{'fuzzy'};
 108     $absent_accessions = $fuzzy_search_result->{'absent'};
 109
 110     if (scalar @organism_list > 0){
 111         my $fuzzy_organism_result = $fuzzy_organism_search->get_matches(\@organism_list, $max_distance);
 112         $found_organisms = $fuzzy_organism_result->{'found'};
 113         $fuzzy_organisms = $fuzzy_organism_result->{'fuzzy'};
 114         $absent_organisms = $fuzzy_organism_result->{'absent'};
 115         #print STDERR "\n\nOrganismFuzzyResult:\n".Data::Dumper::Dumper($fuzzy_organism_result)."\n\n";
 116     }
 117
 118     print STDERR "DoFuzzySearch 3".localtime()."\n";
 119     #print STDERR Dumper $fuzzy_accessions;
 120
 121     $c->stash->{rest} = {
 122         success => "1",
 123         absent => $absent_accessions,
 124         fuzzy => $fuzzy_accessions,
 125         found => $found_accessions,
 126         absent_organisms => $absent_organisms,
 127         fuzzy_organisms => $fuzzy_organisms,
 128         found_organisms => $found_organisms
 129     };
 130     return;
 131 }
 132
 133 sub do_exact_search {
 134     my $self = shift;
 135     my $c = shift;
 136     my $accession_list = shift;
 137
 138     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 139
 140     my @found_accessions;
 141     my @fuzzy_accessions;
 142
 143     my $validator = CXGN::List::Validate->new();
 144     my @absent_accessions = @{$validator->validate($schema, 'accessions', $accession_list)->{'missing'}};
 145     my %accessions_missing_hash = map { $_ => 1 } @absent_accessions;
 146
 147     foreach (@$accession_list){
 148         if (!exists($accessions_missing_hash{$_})){
 149             push @found_accessions, { unique_name => $_,  matched_string => $_};
 150             push @fuzzy_accessions, { unique_name => $_,  matched_string => $_};
 151         }
 152     }
 153
 154     my $rest = {
 155         success => "1",
 156         absent => \@absent_accessions,
 157         found => \@found_accessions,
 158         fuzzy => \@fuzzy_accessions
 159     };
 160     #print STDERR Dumper($rest);
 161     $c->stash->{rest} = $rest;
 162 }
 163
 164 sub verify_accessions_file : Path('/ajax/accessions/verify_accessions_file') : ActionClass('REST') { }
 165 sub verify_accessions_file_POST : Args(0) {
 166     my ($self, $c) = @_;
 167     my $user_id;
 168     my $user_name;
 169     my $user_role;
 170     my $session_id = $c->req->param("sgn_session_id");
 171
 172     if ($session_id){
 173         my $dbh = $c->dbc->dbh;
 174         my @user_info = CXGN::Login->new($dbh)->query_from_cookie($session_id);
 175         if (!$user_info[0]){
 176             $c->stash->{rest} = {error=>'You must be logged in to upload this seedlot info!'};
 177             $c->detach();
 178         }
 179         $user_id = $user_info[0];
 180         $user_role = $user_info[1];
 181         my $p = CXGN::People::Person->new($dbh, $user_id);
 182         $user_name = $p->get_username;
 183     } else {
 184         if (!$c->user){
 185             $c->stash->{rest} = {error=>'You must be logged in to upload this seedlot info!'};
 186             $c->detach();
 187         }
 188         $user_id = $c->user()->get_object()->get_sp_person_id();
 189         $user_name = $c->user()->get_object()->get_username();
 190         $user_role = $c->user->get_object->get_user_type();
 191     }
 192
 193     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 194     my $upload = $c->req->upload('new_accessions_upload_file');
 195     my $subdirectory = "accessions_spreadsheet_upload";
 196     my $upload_original_name = $upload->filename();
 197     my $upload_tempfile = $upload->tempname;
 198     my $time = DateTime->now();
 199     my $timestamp = $time->ymd()."_".$time->hms();
 200
 201     ## Store uploaded temporary file in archive
 202     my $uploader = CXGN::UploadFile->new({
 203         tempfile => $upload_tempfile,
 204         subdirectory => $subdirectory,
 205         archive_path => $c->config->{archive_path},
 206         archive_filename => $upload_original_name,
 207         timestamp => $timestamp,
 208         user_id => $user_id,
 209         user_role => $user_role
 210     });
 211     my $archived_filename_with_path = $uploader->archive();
 212     my $md5 = $uploader->get_md5($archived_filename_with_path);
 213     if (!$archived_filename_with_path) {
 214         $c->stash->{rest} = {error => "Could not save file $upload_original_name in archive",};
 215         $c->detach();
 216     }
 217     unlink $upload_tempfile;
 218
 219     my @editable_stock_props = split ',', $c->config->{editable_stock_props};
 220     my $parser = CXGN::Stock::ParseUpload->new(chado_schema => $schema, filename => $archived_filename_with_path, editable_stock_props=>\@editable_stock_props);
 221     $parser->load_plugin('AccessionsXLS');
 222     my $parsed_data = $parser->parse();
 223     #print STDERR Dumper $parsed_data;
 224
 225     if (!$parsed_data) {
 226         my $return_error = '';
 227         my $parse_errors;
 228         if (!$parser->has_parse_errors() ){
 229             $c->stash->{rest} = {error_string => "Could not get parsing errors"};
 230             $c->detach();
 231         } else {
 232             $parse_errors = $parser->get_parse_errors();
 233             #print STDERR Dumper $parse_errors;
 234
 235             foreach my $error_string (@{$parse_errors->{'error_messages'}}){
 236                 $return_error .= $error_string."<br>";
 237             }
 238         }
 239         $c->stash->{rest} = {error_string => $return_error, missing_species => $parse_errors->{'missing_species'}};
 240         $c->detach();
 241     }
 242
 243     my $full_data = $parsed_data->{parsed_data};
 244     my @accession_names;
 245     my %full_accessions;
 246     while (my ($k,$val) = each %$full_data){
 247         push @accession_names, $val->{germplasmName};
 248         $full_accessions{$val->{germplasmName}} = $val;
 249     }
 250     my $new_list_id = CXGN::List::create_list($c->dbc->dbh, "AccessionsIn".$upload_original_name.$timestamp, 'Autocreated when upload accessions from file '.$upload_original_name.$timestamp, $user_id);
 251     my $list = CXGN::List->new( { dbh => $c->dbc->dbh, list_id => $new_list_id } );
 252     $list->add_bulk(\@accession_names);
 253     $list->type('accessions');
 254
 255     $c->stash->{rest} = {
 256         success => "1",
 257         list_id => $new_list_id,
 258         full_data => \%full_accessions,
 259         absent => $parsed_data->{absent_accessions},
 260         fuzzy => $parsed_data->{fuzzy_accessions},
 261         found => $parsed_data->{found_accessions},
 262         absent_organisms => $parsed_data->{absent_organisms},
 263         fuzzy_organisms => $parsed_data->{fuzzy_organisms},
 264         found_organisms => $parsed_data->{found_organisms}
 265     };
 266 }
 267
 268 sub verify_fuzzy_options : Path('/ajax/accession_list/fuzzy_options') : ActionClass('REST') { }
 269
 270 sub verify_fuzzy_options_POST : Args(0) {
 271     my ($self, $c) = @_;
 272     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 273     my $accession_list_id = $c->req->param('accession_list_id');
 274     my $fuzzy_option_hash = decode_json($c->req->param('fuzzy_option_data'));
 275     my $names_to_add = decode_json($c->req->param('names_to_add'));
 276     #print STDERR Dumper $fuzzy_option_hash;
 277     my $list = CXGN::List->new( { dbh => $c->dbc()->dbh(), list_id => $accession_list_id } );
 278
 279     my %names_to_add = map {$_ => 1} @$names_to_add;
 280     foreach my $form_name (keys %$fuzzy_option_hash){
 281         my $item_name = $fuzzy_option_hash->{$form_name}->{'fuzzy_name'};
 282         my $select_name = $fuzzy_option_hash->{$form_name}->{'fuzzy_select'};
 283         my $fuzzy_option = $fuzzy_option_hash->{$form_name}->{'fuzzy_option'};
 284         if ($fuzzy_option eq 'replace'){
 285             $list->replace_by_name($item_name, $select_name);
 286             delete $names_to_add{$item_name};
 287         } elsif ($fuzzy_option eq 'keep'){
 288             $names_to_add{$item_name} = 1;
 289         } elsif ($fuzzy_option eq 'remove'){
 290             $list->remove_by_name($item_name);
 291             delete $names_to_add{$item_name};
 292         } elsif ($fuzzy_option eq 'synonymize'){
 293             my $stock_id = $schema->resultset('Stock::Stock')->find({uniquename=>$select_name})->stock_id();
 294             my $stock = CXGN::Chado::Stock->new($schema, $stock_id);
 295             $stock->add_synonym($item_name);
 296             #$list->replace_by_name($item_name, $select_name);
 297             delete $names_to_add{$item_name};
 298         }
 299     }
 300
 301     my @names_to_add = sort keys %names_to_add;
 302     my $rest = {
 303         success => "1",
 304         names_to_add => \@names_to_add
 305     };
 306     #print STDERR Dumper($rest);
 307     $c->stash->{rest} = $rest;
 308 }
 309
 310
 311 sub add_accession_list : Path('/ajax/accession_list/add') : ActionClass('REST') { }
 312
 313 sub add_accession_list_POST : Args(0) {
 314     my ($self, $c) = @_;
 315     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 316     #print STDERR Dumper $c->req->param('full_info');
 317     my $full_info = $c->req->param('full_info') ? decode_json $c->req->param('full_info') : '';
 318     my $allowed_organisms = $c->req->param('allowed_organisms') ? decode_json $c->req->param('allowed_organisms') : [];
 319     my %allowed_organisms = map {$_=>1} @$allowed_organisms;
 320     my $phenome_schema = $c->dbic_schema("CXGN::Phenome::Schema");
 321
 322     if (!$c->user()) {
 323         $c->stash->{rest} = {error => "You need to be logged in to submit accessions." };
 324         return;
 325     }
 326     my $user_id = $c->user()->get_object()->get_sp_person_id();
 327
 328     if (!any { $_ eq "curator" || $_ eq "submitter" } ($c->user()->roles)  ) {
 329         $c->stash->{rest} = {error =>  "You have insufficient privileges to submit accessions." };
 330         return;
 331     }
 332
 333     my $type_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'accession', 'stock_type')->cvterm_id();
 334     my $main_production_site_url = $c->config->{main_production_site_url};
 335     my @added_fullinfo_stocks;
 336     my @added_stocks;
 337     my $coderef_bcs = sub {
 338         foreach (@$full_info){
 339             if (exists($allowed_organisms{$_->{species}})){
 340                 my $stock = CXGN::Stock::Accession->new({
 341                     schema=>$schema,
 342                     check_name_exists=>0,
 343                     main_production_site_url=>$main_production_site_url,
 344                     type=>'accession',
 345                     type_id=>$type_id,
 346                     species=>$_->{species},
 347                     #genus=>$_->{genus},
 348                     stock_id=>$_->{stock_id}, #For adding properties to an accessions
 349                     name=>$_->{defaultDisplayName},
 350                     uniquename=>$_->{germplasmName},
 351                     organization_name=>$_->{organizationName},
 352                     population_name=>$_->{populationName},
 353                     description=>$_->{description},
 354                     accessionNumber=>$_->{accessionNumber},
 355                     germplasmPUI=>$_->{germplasmPUI},
 356                     pedigree=>$_->{pedigree},
 357                     germplasmSeedSource=>$_->{germplasmSeedSource},
 358                     synonyms=>$_->{synonyms},
 359                     #commonCropName=>$_->{commonCropName},
 360                     instituteCode=>$_->{instituteCode},
 361                     instituteName=>$_->{instituteName},
 362                     biologicalStatusOfAccessionCode=>$_->{biologicalStatusOfAccessionCode},
 363                     countryOfOriginCode=>$_->{countryOfOriginCode},
 364                     typeOfGermplasmStorageCode=>$_->{typeOfGermplasmStorageCode},
 365                     #speciesAuthority=>$_->{speciesAuthority},
 366                     #subtaxa=>$_->{subtaxa},
 367                     #subtaxaAuthority=>$_->{subtaxaAuthority},
 368                     donors=>$_->{donors},
 369                     acquisitionDate=>$_->{acquisitionDate},
 370                     transgenic=>$_->{transgenic},
 371                     notes=>$_->{notes},
 372                     state=>$_->{state},
 373                     variety=>$_->{variety},
 374                     genomeStructure=>$_->{genomeStructure},
 375                     ploidyLevel=>$_->{ploidyLevel},
 376                     locationCode=>$_->{locationCode},
 377                     introgression_parent=>$_->{introgression_parent},
 378                     introgression_backcross_parent=>$_->{introgression_backcross_parent},
 379                     introgression_map_version=>$_->{introgression_map_version},
 380                     introgression_chromosome=>$_->{introgression_chromosome},
 381                     introgression_start_position_bp=>$_->{introgression_start_position_bp},
 382                     introgression_end_position_bp=>$_->{introgression_end_position_bp}
 383                 });
 384                 my $added_stock_id = $stock->store();
 385                 push @added_stocks, $added_stock_id;
 386                 push @added_fullinfo_stocks, [$added_stock_id, $_->{germplasmName}];
 387             }
 388         }
 389     };
 390
 391     my $coderef_phenome = sub {
 392         foreach my $stock_id (@added_stocks) {
 393             $phenome_schema->resultset("StockOwner")->find_or_create({
 394                 stock_id     => $stock_id,
 395                 sp_person_id =>  $user_id,
 396             });
 397         }
 398     };
 399
 400     my $transaction_error;
 401     my $transaction_error_phenome;
 402     try {
 403         $schema->txn_do($coderef_bcs);
 404     } catch {
 405         $transaction_error =  $_;
 406     };
 407     try {
 408         $phenome_schema->txn_do($coderef_phenome);
 409     } catch {
 410         $transaction_error_phenome =  $_;
 411     };
 412     if ($transaction_error || $transaction_error_phenome) {
 413         $c->stash->{rest} = {error =>  "Transaction error storing stocks: $transaction_error $transaction_error_phenome" };
 414         print STDERR "Transaction error storing stocks: $transaction_error $transaction_error_phenome\n";
 415         return;
 416     }
 417
 418     my $dbh = $c->dbc->dbh();
 419     my $bs = CXGN::BreederSearch->new( { dbh=>$dbh, dbname=>$c->config->{dbname}, } );
 420     my $refresh = $bs->refresh_matviews($c->config->{dbhost}, $c->config->{dbname}, $c->config->{dbuser}, $c->config->{dbpass}, 'stockprop');
 421
 422     #print STDERR Dumper \@added_fullinfo_stocks;
 423     $c->stash->{rest} = {
 424         success => "1",
 425         added => \@added_fullinfo_stocks
 426     };
 427     return;
 428 }
 429
 430 sub possible_seedlots : Path('/ajax/accessions/possible_seedlots') : ActionClass('REST') { }
 431 sub possible_seedlots_POST : Args(0) {
 432   my ($self, $c) = @_;
 433   my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 434   my $people_schema = $c->dbic_schema('CXGN::People::Schema');
 435   my $phenome_schema = $c->dbic_schema('CXGN::Phenome::Schema');
 436
 437   my $names = $c->req->body_data->{'names'};
 438   my $type = $c->req->body_data->{'type'};
 439
 440   my $stock_lookup = CXGN::Stock::StockLookup->new(schema => $schema);
 441   my $accession_manager = CXGN::BreedersToolbox::Accessions->new(schema=>$schema, people_schema=>$people_schema, phenome_schema=>$phenome_schema);
 442
 443   my $synonyms;
 444   my @uniquenames;
 445   if ($type eq 'accessions'){
 446       $synonyms = $stock_lookup->get_stock_synonyms('any_name','accession',$names);
 447       @uniquenames = keys %{$synonyms};
 448   } else {
 449       @uniquenames = @$names;
 450   }
 451
 452   my $seedlots = $accession_manager->get_possible_seedlots(\@uniquenames, $type);
 453
 454   $c->stash->{rest} = {
 455       success => "1",
 456       seedlots=> $seedlots,
 457       synonyms=>$synonyms
 458   };
 459   return;
 460 }
 461
 462 sub fuzzy_response_download : Path('/ajax/accession_list/fuzzy_download') : ActionClass('REST') { }
 463
 464 sub fuzzy_response_download_POST : Args(0) {
 465     my ($self, $c) = @_;
 466     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 467     my $fuzzy_json = $c->req->param('fuzzy_response');
 468     my $fuzzy_response = decode_json $fuzzy_json;
 469     #print STDERR Dumper $fuzzy_response;
 470
 471     my $synonym_hash_lookup = CXGN::Stock::StockLookup->new({schema => $schema})->get_synonym_hash_lookup();
 472     my @data_out;
 473     push @data_out, ['In Your List', 'Database Accession Match', 'Database Synonym Match', 'Database Saved Synonyms', 'Distance'];
 474     foreach (@$fuzzy_response){
 475         my $matches = $_->{matches};
 476         my $name = $_->{name};
 477         foreach my $m (@$matches){
 478             my $match_name = $m->{name};
 479             my $synonym_of = '';
 480             my $distance = $m->{distance};
 481             if ($m->{is_synonym}){
 482                 $match_name = $m->{synonym_of};
 483                 $synonym_of = $m->{name};
 484             }
 485             my $synonyms = $synonym_hash_lookup->{$match_name};
 486             my $synonyms_string = $synonyms ? join ',', @$synonyms : '';
 487             push @data_out, [$name, $match_name, $synonym_of, $synonyms_string, $distance];
 488         }
 489     }
 490     my $string ='';
 491     foreach (@data_out){
 492         $string .= join("," , map {qq("$_")} @$_);
 493         $string .= "\n";
 494     }
 495     $c->res->content_type("text/plain");
 496     $c->res->body($string);
 497 }
 498
 499 sub populations : Path('/ajax/manage_accessions/populations') : ActionClass('REST') { }
 500
 501 sub populations_GET : Args(0) {
 502     my $self = shift;
 503     my $c = shift;
 504
 505     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 506     my $ac = CXGN::BreedersToolbox::Accessions->new( { schema=>$schema });
 507     my $populations = $ac->get_all_populations();
 508
 509     $c->stash->{rest} = { populations => $populations };
 510 }
 511
 512 sub population_members : Path('/ajax/manage_accessions/population_members') : ActionClass('REST') { }
 513
 514 sub population_members_GET : Args(1) {
 515     my $self = shift;
 516     my $c = shift;
 517     my $stock_id = shift;
 518
 519     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
 520     my $ac = CXGN::BreedersToolbox::Accessions->new( { schema=>$schema });
 521     my $members = $ac->get_population_members($stock_id);
 522
 523     $c->stash->{rest} = { data => $members };
 524 }
 525
 526 sub _parse_list_from_json {
 527   my $list_json = shift;
 528   my $json = new JSON;
 529   if ($list_json) {
 530     my $decoded_list = $json->allow_nonref->utf8->relaxed->escape_slash->loose->allow_singlequote->allow_barekey->decode($list_json);
 531     #my $decoded_list = decode_json($list_json);
 532     my @array_of_list_items = @{$decoded_list};
 533     return \@array_of_list_items;
 534   }
 535   else {
 536     return;
 537   }
 538 }
 539
 540
 541 1;