lib/SGN/Controller/AJAX/PCRBasedGenotypeData.pm

   1
   2 =head1 NAME
   3
   4 SGN::Controller::AJAX::PCRBasedGenotypeData
   5
   6 =head1 DESCRIPTION
   7
   8
   9 =head1 AUTHOR
  10
  11
  12 =cut
  13
  14 package SGN::Controller::AJAX::PCRBasedGenotypeData;
  15
  16 use Moose;
  17 use Try::Tiny;
  18 use DateTime;
  19 use File::Slurp;
  20 use File::Spec::Functions;
  21 use File::Copy;
  22 use Data::Dumper;
  23 use List::MoreUtils qw /any /;
  24 use CXGN::BreederSearch;
  25 use CXGN::UploadFile;
  26 use CXGN::Genotype::ParseUpload;
  27 use CXGN::Login;
  28 use CXGN::People::Person;
  29 use CXGN::Genotype::Protocol;
  30 use CXGN::Genotype::StorePCRMarkerInfo;
  31 use File::Basename qw | basename dirname|;
  32
  33 BEGIN { extends 'Catalyst::Controller::REST' }
  34
  35 __PACKAGE__->config(
  36     default   => 'application/json',
  37     stash_key => 'rest',
  38     map       => { 'application/json' => 'JSON', 'text/html' => 'JSON'  },
  39    );
  40
  41 sub upload_ssr_protocol : Path('/ajax/genotype/upload_ssr_protocol') : ActionClass('REST'){ }
  42
  43 sub upload_ssr_protocol_POST : Args(0) {
  44     my $self = shift;
  45     my $c = shift;
  46     my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
  47     my $chado_schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado', $sp_person_id);
  48     my $metadata_schema = $c->dbic_schema("CXGN::Metadata::Schema", undef, $sp_person_id);
  49     my $phenome_schema = $c->dbic_schema("CXGN::Phenome::Schema", undef, $sp_person_id);
  50     my $dbh = $c->dbc->dbh;
  51     my $upload = $c->req->upload('xls_ssr_protocol_file');
  52     my $upload_type = 'SSRProtocolExcel';
  53     my $parser;
  54     my $parsed_data;
  55     my $upload_original_name = $upload->filename();
  56     my $upload_tempfile = $upload->tempname;
  57     my $subdirectory = "ssr_upload";
  58     my $archived_filename_with_path;
  59     my $md5;
  60     my $validate_file;
  61     my $parsed_file;
  62     my $parse_errors;
  63     my %parsed_data;
  64     my %upload_metadata;
  65     my $time = DateTime->now();
  66     my $timestamp = $time->ymd()."_".$time->hms();
  67     my $user_role;
  68     my $user_id;
  69     my $user_name;
  70     my $owner_name;
  71     my $session_id = $c->req->param("sgn_session_id");
  72
  73     if ($session_id){
  74         my $dbh = $c->dbc->dbh;
  75         my @user_info = CXGN::Login->new($dbh)->query_from_cookie($session_id);
  76         if (!$user_info[0]){
  77             $c->stash->{rest} = {error=>'You must be logged in to upload SSR marker info!'};
  78             $c->detach();
  79         }
  80         $user_id = $user_info[0];
  81         $user_role = $user_info[1];
  82         my $p = CXGN::People::Person->new($dbh, $user_id);
  83         $user_name = $p->get_username;
  84     } else {
  85         if (!$c->user){
  86             $c->stash->{rest} = {error=>'You must be logged in to upload progenies!'};
  87             $c->detach();
  88         }
  89         $user_id = $c->user()->get_object()->get_sp_person_id();
  90         $user_name = $c->user()->get_object()->get_username();
  91         $user_role = $c->user->get_object->get_user_type();
  92     }
  93
  94     my $uploader = CXGN::UploadFile->new({
  95         tempfile => $upload_tempfile,
  96         subdirectory => $subdirectory,
  97         archive_path => $c->config->{archive_path},
  98         archive_filename => $upload_original_name,
  99         timestamp => $timestamp,
 100         user_id => $user_id,
 101         user_role => $user_role
 102     });
 103
 104     ## Store uploaded temporary file in arhive
 105     $archived_filename_with_path = $uploader->archive();
 106     $md5 = $uploader->get_md5($archived_filename_with_path);
 107     if (!$archived_filename_with_path) {
 108         $c->stash->{rest} = {error => "Could not save file $upload_original_name in archive",};
 109         return;
 110     }
 111     unlink $upload_tempfile;
 112
 113     my $protocol_name = $c->req->param('upload_ssr_protocol_name');
 114     my $protocol_description = $c->req->param('upload_ssr_protocol_description_input');
 115     my $species_name = $c->req->param('upload_ssr_species_name_input');
 116 #    my $sample_type = $c->req->param('upload_ssr_sample_type_select');
 117     my $sample_type = 'tissue_sample_or_accession';
 118
 119     my $organism_check = "SELECT organism_id FROM organism WHERE species = ?";
 120     my @found_organisms;
 121     my $h = $chado_schema->storage->dbh()->prepare($organism_check);
 122     $h->execute($species_name);
 123     while (my ($organism_id) = $h->fetchrow_array()){
 124         push @found_organisms, $organism_id;
 125     }
 126     if (scalar(@found_organisms) == 0){
 127         $c->stash->{rest} = { error => 'The organism species you provided is not in the database! Please contact us.' };
 128         $c->detach();
 129     }
 130     if (scalar(@found_organisms) > 1){
 131         $c->stash->{rest} = { error => 'The organism species you provided is not unique in the database! Please contact us.' };
 132         $c->detach();
 133     }
 134     my $organism_id = $found_organisms[0];
 135
 136  #   print STDERR "PROTOCOL NAME =".Dumper($protocol_name)."\n";
 137 #    print STDERR "PROTOCOL DESCRIPTION =".Dumper($protocol_description)."\n";
 138 #    print STDERR "SPECIES NAME =".Dumper($species_name)."\n";
 139
 140     $upload_metadata{'archived_file'} = $archived_filename_with_path;
 141     $upload_metadata{'archived_file_type'}="ssr upload file";
 142     $upload_metadata{'user_id'}=$user_id;
 143     $upload_metadata{'date'}="$timestamp";
 144
 145     #parse uploaded file with appropriate plugin
 146     $parser = CXGN::Genotype::ParseUpload->new(chado_schema => $chado_schema, filename => $archived_filename_with_path, observation_unit_type_name => $sample_type);
 147     $parser->load_plugin($upload_type);
 148     $parsed_data = $parser->parse();
 149 #    print STDERR "PARSED DATA =". Dumper($parsed_data)."\n";
 150
 151     if (!$parsed_data){
 152         my $return_error = '';
 153         my $parse_errors;
 154         if (!$parser->has_parse_errors() ){
 155             $c->stash->{rest} = {error_string => "Could not get parsing errors"};
 156         } else {
 157             $parse_errors = $parser->get_parse_errors();
 158             #print STDERR Dumper $parse_errors;
 159
 160             foreach my $error_string (@{$parse_errors->{'error_messages'}}){
 161                 $return_error .= $error_string."<br>";
 162             }
 163         }
 164         $c->stash->{rest} = {error_string => $return_error};
 165         $c->detach();
 166     }
 167
 168     my $pcr_markers = CXGN::Genotype::StorePCRMarkerInfo->new({
 169         bcs_schema => $chado_schema,
 170         protocol_name => $protocol_name,
 171         protocol_description => $protocol_description,
 172         species_name => $species_name,
 173         sample_observation_unit_type_name => $sample_type,
 174         marker_type => 'SSR',
 175         marker_details => $parsed_data
 176     });
 177
 178     my $protocol_id = $pcr_markers->store_pcr_marker_info();
 179 #    print STDERR "PROTOCOL ID =".Dumper($protocol_id)."\n";
 180
 181     if (!$protocol_id) {
 182         $c->stash->{rest} = {error_string => "Error saving PCR marker info",};
 183         return;
 184     }
 185
 186     $c->stash->{rest} = {success => "1", protocol_id => $protocol_id};
 187
 188 }
 189
 190
 191 ###
 192 1;#
 193 ###