lib/SGN/Controller/solGS/AnalysisSave.pm

   1 package SGN::Controller::solGS::AnalysisSave;
   2
   3 use Moose;
   4 use namespace::autoclean;
   5
   6 use Carp qw/ carp confess croak /;
   7 use DateTime;
   8 use Data::Dumper;
   9 use File::Find::Rule;
  10 use File::Path qw / mkpath  /;
  11 use File::Spec::Functions qw / catfile catdir/;
  12 use File::Slurp qw /write_file read_file/;
  13 use JSON;
  14 use Scalar::Util 'reftype';
  15 use Storable qw/ nstore retrieve /;
  16 use Try::Tiny;
  17 use URI;
  18
  19 BEGIN { extends 'Catalyst::Controller::REST' };
  20
  21 __PACKAGE__->config(
  22     default => 'application/json',
  23     stash_key => 'rest',
  24     map => { 'application/json' => 'JSON', 'text/html' => 'JSON'  },
  25     );
  26
  27
  28 sub check_analysis_result :Path('/solgs/check/stored/analysis/') Args() {
  29     my ($self, $c) = @_;
  30
  31         my $args = $c->req->param('arguments');
  32     $c->controller('solGS::Utils')->stash_json_args($c, $args);
  33
  34     my $analysis_id = $self->check_stored_analysis($c);
  35         $c->stash->{rest} {analysis_id} = $analysis_id;
  36
  37         if ($analysis_id)
  38         {
  39         $c->stash->{rest}{error} = "This model GEBVs are already in the database.";
  40         }
  41
  42 }
  43
  44
  45 sub result_details :Path('/solgs/analysis/result/details') Args() {
  46     my ($self, $c) = @_;
  47
  48         my $args = $c->req->param('arguments');
  49     $c->controller('solGS::Utils')->stash_json_args($c, $args);
  50
  51         my $stored = $self->check_stored_analysis($c);
  52
  53         if (!$stored)
  54         {
  55                 my $params = decode_json($args);
  56                 my $analysis_details;
  57
  58                 eval
  59                 {
  60                         $analysis_details = $self->structure_gebvs_result_details($c, $params);
  61                 };
  62
  63                 if ($@)
  64                 {
  65                         print STDERR "\n$@\n";
  66                         $c->stash->{rest}{error} = 'Something went wrong structuring the analysis result';
  67                 }
  68                 else
  69                 {
  70                 $c->stash->{rest}{analysis_details} = $analysis_details;
  71                 }
  72         }
  73
  74 }
  75
  76
  77 sub structure_gebvs_result_details {
  78         my ($self, $c, $params) = @_;
  79
  80         my $gebvs = $self->structure_gebvs_values($c, $params);
  81         my @accessions = keys %$gebvs;
  82
  83         my $trait_names         = $self->analysis_traits($c);
  84         my $model_details   = $self->model_details($c);
  85         my $app_details         = $self->app_details();
  86         my $log                     = $self->get_analysis_job_info($c);
  87         my $analysis_name   = $log->{analysis_name};
  88
  89         my $test_trait_names = encode_json($trait_names);
  90         my $test_log = encode_json($log);
  91
  92     my $details = {
  93                 'analysis_to_save_boolean' => 'yes',
  94                 'analysis_name' => $log->{analysis_name},
  95                 'analysis_description' => $log->{training_pop_desc},
  96                 'analysis_year' => $self->analysis_year($c),
  97                 'analysis_breeding_program_id' => $self->analysis_breeding_prog($c),
  98                 'analysis_protocol' => $model_details->{protocol},
  99                 'analysis_dataset_id' => '',
 100                 'analysis_accession_names' => encode_json(\@accessions),
 101                 'analysis_trait_names' => encode_json($trait_names),
 102                 'analysis_precomputed_design_optional' =>'',
 103                 'analysis_result_values' => to_json($gebvs),
 104                 'analysis_result_values_type' => 'analysis_result_values_match_accession_names',
 105                 'analysis_result_summary' => '',
 106                 'analysis_result_trait_compose_info' =>  "",
 107                 'analysis_statistical_ontology_term' =>  $model_details->{stat_ont_term},
 108                 'analysis_model_application_version' => $app_details->{version},
 109                 'analysis_model_application_name' => $app_details->{name},
 110                 'analysis_model_language' => $model_details->{model_lang},
 111                 'analysis_model_is_public' => 'yes',
 112                 'analysis_model_description' =>  $model_details->{model_desc},
 113                 'analysis_model_name' => $log->{analysis_name},
 114                 'analysis_model_type' => $model_details->{model_type},
 115         };
 116
 117         return $details;
 118
 119 }
 120
 121
 122 sub app_details {
 123         my $self = shift;
 124
 125         my $ver = qx / git describe --tags --abbrev=0 /;
 126
 127         my $details = {
 128                 'name' => 'solGS',
 129                 'version' => $ver
 130         };
 131
 132         return $details;
 133
 134 }
 135
 136
 137 sub analysis_traits {
 138         my ($self, $c) = @_;
 139
 140         my $log = $self->get_analysis_job_info($c);
 141         my $trait_ids = $log->{trait_id};
 142         my @trait_names;
 143         foreach my $tr_id (@$trait_ids)
 144         {
 145                 my $extended_name = $self->extended_trait_name($c, $tr_id);
 146                 push @trait_names, $extended_name;
 147         }
 148
 149         return \@trait_names;
 150
 151 }
 152
 153
 154 sub analysis_breeding_prog {
 155         my ($self, $c) = @_;
 156
 157         my $log = $self->get_analysis_job_info($c);
 158
 159         my $trial_id = $log->{training_pop_id}[0];
 160         if ($log->{data_set_type} =~ /combined/)
 161         {
 162                 my $trials_ids = $c->controller('solGS::combinedTrials')->get_combined_pops_list($c, $trial_id);
 163                 $trial_id = $trials_ids->[0];
 164         }
 165
 166         if ($trial_id =~ /list/)
 167         {
 168                 $trial_id = $c->controller('solGS::List')->get_trial_id_plots_list($c, $trial_id);
 169         }
 170
 171         my $program_id;
 172         if ($trial_id =~ /^\d+$/)
 173         {
 174                 $program_id = $c->controller('solGS::Search')->model($c)->trial_breeding_program_id($trial_id);
 175         }
 176
 177         return $program_id;
 178
 179 }
 180
 181
 182 sub model_details {
 183         my ($self, $c) = @_;
 184
 185         my $model_type = 'gblup_model_rrblup';
 186         my $stat_ont_term = 'GEBVs using GBLUP from rrblup R package|SGNSTAT:0000038';
 187         my $protocol = "GBLUP model from RRBLUP R Package";
 188         my $log = $self->get_analysis_job_info($c);
 189         my $model_page = $log->{analysis_page};
 190         my $model_desc= qq | <a href="$model_page">Go to model detail page</a>|;
 191         #my $model_desc = 'test desc';
 192
 193         my $details = {
 194                 'model_type' => $model_type,
 195                 'model_page' => $model_page,
 196                 'model_desc' => $model_desc,
 197                 'model_lang' => 'R',
 198                 'stat_ont_term' => $stat_ont_term,
 199                 'protocol' => $protocol
 200         };
 201
 202         return $details;
 203 }
 204
 205
 206 sub analysis_year {
 207         my ($self, $c) = @_;
 208
 209         my $log = $self->get_analysis_job_info($c);
 210         my $time = $log->{analysis_time};
 211
 212         $time= (split(/\s+/, $time))[0];
 213         my $year = (split(/\//, $time))[2];
 214
 215         return $year;
 216
 217 }
 218
 219
 220 sub check_stored_analysis {
 221         my ($self, $c) = @_;
 222
 223         my $log = $self->get_analysis_job_info($c);
 224         my $analysis_name = $log->{analysis_name};
 225         my $analysis_id;
 226         if ($analysis_name)
 227         {
 228                 my $schema = $self->schema($c);
 229         my $analysis = $schema->resultset("Project::Project")->find({ name => $analysis_name });
 230
 231                 if ($analysis)
 232                 {
 233                         $analysis_id = $analysis->project_id;
 234                 }
 235         }
 236
 237         return $analysis_id;
 238
 239 }
 240
 241
 242 sub extended_trait_name {
 243         my ($self, $c, $trait_id) = @_;
 244
 245         my $schema = $self->schema($c);
 246         # foreach my $tr_id (@$trait_ids) {
 247                 #$c->controller('solGS::Trait')->get_trait_details($c, $tr_id);
 248                 my $extended_name = SGN::Model::Cvterm::get_trait_from_cvterm_id($schema, $trait_id, 'extended');
 249                 # push @trait_names, $extended_name;
 250         # }
 251
 252         return $extended_name;
 253
 254 }
 255
 256
 257 sub gebvs_values {
 258         my ($self, $c, $params) = @_;
 259
 260         my $training_pop_id = $params->{training_pop_id};
 261         my $selection_pop_id = $params->{selection_pop_id};
 262         my $trait_id = $params->{trait_id};
 263         my $protocol_id = $params->{genotyping_protocol_id};
 264
 265         $c->stash->{genotyping_protocol_id} = $protocol_id;
 266
 267         my $analysis_page = $params->{analysis_page};
 268         $analysis_page = $c->controller('solGS::Path')->page_type($c, $analysis_page);
 269
 270         my $gebvs_file;
 271         if ($analysis_page =~ /training_model/)
 272         {
 273                 $gebvs_file = $c->controller('solGS::Files')->rrblup_training_gebvs_file($c, $training_pop_id, $trait_id);
 274         }
 275         elsif ($analysis_page =~ /selection_prediction/)
 276         {
 277                 $gebvs_file = $c->controller('solGS::Files')->rrblup_selection_gebvs_file($c, $training_pop_id, $selection_pop_id, $trait_id);
 278         }
 279
 280         my $gebvs = $c->controller('solGS::Utils')->read_file_data($gebvs_file);
 281
 282         return $gebvs;
 283
 284 }
 285
 286
 287 sub structure_gebvs_values {
 288         my ($self, $c, $params) = @_;
 289
 290         my $trait_name = $self->extended_trait_name($c, $params->{trait_id});
 291
 292         my $gebvs = $self->gebvs_values($c, $params);
 293         my $gebvs_ref = $c->controller('solGS::Utils')->convert_arrayref_to_hashref($gebvs);
 294
 295         my %gebvs_hash;
 296         my $now = DateTime->now();
 297         my $timestamp = $now->ymd()."T".$now->hms();
 298
 299         my $user = $c->controller('solGS::AnalysisQueue')->get_user_detail($c);
 300         my $user_name = $user->{user_name};
 301
 302         my @accessions = keys %$gebvs_ref;
 303
 304         foreach my $accession (@accessions)
 305         {
 306                 $gebvs_hash{$accession} = {
 307                         $trait_name => [$gebvs_ref->{$accession}, $timestamp, $user_name, "", ""]
 308                 };
 309         }
 310
 311         return \%gebvs_hash;
 312
 313 }
 314
 315
 316 sub get_analysis_job_info {
 317         my ($self, $c) = @_;
 318
 319         my $files = $self->all_users_analyses_logs($c);
 320         my $analysis_page = $c->stash->{analysis_page};
 321         my @log;
 322
 323         foreach my $log_file (@$files) {
 324                 my @logs = read_file($log_file, {binmode => ':utf8'});
 325                 my ($log) = grep{ $_ =~ /$analysis_page/} @logs;
 326
 327                 @log = split(/\t/, $log);
 328                 last if $log;
 329         }
 330
 331         if (@log) {
 332                 my $analysis_info = decode_json($log[5]);
 333                 return $analysis_info;
 334         } else {
 335                 return;
 336         }
 337
 338 }
 339
 340
 341 sub all_users_analyses_logs {
 342         my ($self, $c) = @_;
 343
 344         my $dir = $c->stash->{analysis_log_dir};
 345         my @files = File::Find::Rule->file()
 346                             ->name( 'analysis_log*' )
 347                             ->in( $dir );
 348
 349         return \@files;
 350
 351 }
 352
 353
 354 sub schema {
 355         my ($self, $c) = @_;
 356
 357         return  $c->dbic_schema("Bio::Chado::Schema", "sgn_chado");
 358 }
 359
 360
 361 sub begin : Private {
 362     my ($self, $c) = @_;
 363
 364     $c->controller('solGS::Files')->get_solgs_dirs($c);
 365
 366 }
 367
 368
 369
 370
 371 __PACKAGE__->meta->make_immutable;
 372
 373
 374 ####
 375 1;
 376 ####