lib/SGN/Controller/solGS/Trait.pm

   1 package SGN::Controller::solGS::Trait;
   2
   3 use Moose;
   4 use namespace::autoclean;
   5
   6 use URI::FromHash 'uri';
   7 use File::Path qw / mkpath  /;
   8 use File::Spec::Functions qw / catfile catdir/;
   9 use File::Temp qw / tempfile tempdir /;
  10 use File::Slurp qw /write_file read_file/;
  11 use File::Copy;
  12 use File::Basename;
  13 use Cache::File;
  14 use Try::Tiny;
  15 use List::MoreUtils qw /uniq/;
  16 use Array::Utils qw(:all);
  17 use JSON;
  18 use SGN::Controller::solGS::Utils;
  19
  20
  21 BEGIN { extends 'Catalyst::Controller' }
  22
  23
  24 sub solgs_details_trait :Path('/solgs/details/trait/') Args(1) {
  25     my ($self, $c, $trait_id) = @_;
  26
  27     $trait_id = $c->req->param('trait_id') if !$trait_id;
  28
  29     my $ret->{status} = undef;
  30
  31     if ($trait_id)
  32     {
  33         $self->get_trait_details($c, $trait_id);
  34         $ret->{name}    = $c->stash->{trait_name};
  35         $ret->{def}     = $c->stash->{trait_def};
  36         $ret->{abbr}    = $c->stash->{trait_abbr};
  37         $ret->{id}      = $c->stash->{trait_id};
  38         $ret->{status}  = 1;
  39     }
  40
  41     $ret = to_json($ret);
  42
  43     $c->res->content_type('application/json');
  44     $c->res->body($ret);
  45
  46 }
  47
  48
  49 sub get_trait_details {
  50     my ($self, $c, $trait) = @_;
  51
  52     $trait = $c->stash->{trait_id} if !$trait;
  53
  54     die "Can't get trait details with out trait id or name: $!\n" if !$trait;
  55
  56     my ($trait_name, $trait_def, $trait_id, $trait_abbr);
  57
  58     my $model = $c->controller('solGS::Search')->model($c);
  59
  60     if ($trait =~ /^\d+$/)
  61     {
  62         $trait = $model->trait_name($trait);
  63     }
  64
  65     if ($trait)
  66     {
  67         my $rs = $model->trait_details($trait);
  68
  69         while (my $row = $rs->next)
  70         {
  71             $trait_id   = $row->id;
  72             $trait_name = $row->name;
  73             $trait_def  = $row->definition;
  74             $trait_abbr = $c->controller('solGS::Utils')->abbreviate_term($trait_name);
  75         }
  76     }
  77
  78     my $abbr = $c->controller('solGS::Utils')->abbreviate_term($trait_name);
  79
  80     $c->stash->{trait_id}   = $trait_id;
  81     $c->stash->{trait_name} = $trait_name;
  82     $c->stash->{trait_def}  = $trait_def;
  83     $c->stash->{trait_abbr} = $abbr;
  84
  85 }
  86
  87
  88 sub get_trait_details_of_trait_abbr {
  89     my ($self, $c) = @_;
  90
  91     my $trait_abbr = $c->stash->{trait_abbr};
  92
  93     my $acronym_pairs = $self->get_acronym_pairs($c, $c->stash->{training_pop_id});
  94
  95     if ($acronym_pairs)
  96     {
  97                 foreach my $r (@$acronym_pairs)
  98                 {
  99                     if ($r->[0] eq $trait_abbr)
 100                     {
 101                                 my $trait_name =  $r->[1];
 102                                 $trait_name    =~ s/^\s+|\s+$//g;
 103
 104                 # my $model = $c->controller('solGS::Search')->model($c);
 105                                 my $trait_id = $c->controller('solGS::Search')->model($c)->get_trait_id($trait_name);
 106                                 $self->get_trait_details($c, $trait_id);
 107                     }
 108                 }
 109     }
 110
 111 }
 112
 113
 114 sub phenotype_graph :Path('/solgs/phenotype/graph') Args(0) {
 115     my ($self, $c) = @_;
 116
 117     my $pop_id        = $c->req->param('pop_id');
 118     my $trait_id      = $c->req->param('trait_id');
 119     my $combo_pops_id = $c->req->param('combo_pops_id');
 120
 121     my $protocol_id = $c->req->param('genotyping_protocol_id');
 122     $c->controller('solGS::genotypingProtocol')->stash_protocol_id($c, $protocol_id);
 123
 124     $self->get_trait_details($c, $trait_id);
 125
 126     $c->stash->{training_pop_id}        = $pop_id;
 127     $c->stash->{combo_pops_id} = $combo_pops_id;
 128
 129     $c->stash->{data_set_type} = 'combined_populations' if $combo_pops_id;
 130
 131     $c->controller("solGS::Files")->model_phenodata_file($c);
 132
 133     my $model_pheno_file = $c->{stash}->{model_phenodata_file};
 134     my $model_data = $c->controller("solGS::Utils")->read_file_data($model_pheno_file);
 135
 136     my $ret->{status} = 'failed';
 137
 138     if (@$model_data)
 139     {
 140         $ret->{status} = 'success';
 141         $ret->{trait_data} = $model_data;
 142     }
 143
 144     $ret = to_json($ret);
 145
 146     $c->res->content_type('application/json');
 147     $c->res->body($ret);
 148
 149 }
 150
 151
 152 sub save_single_trial_traits {
 153     my ($self, $c, $pop_id) = @_;
 154
 155     $pop_id = $c->stash->{training_pop_id} if !$pop_id;
 156
 157     $c->controller('solGS::Files')->traits_list_file($c, $pop_id);
 158     my $traits_file = $c->stash->{traits_list_file};
 159
 160     if (!-s $traits_file)
 161     {
 162         my $trait_names = $c->controller('solGS::Utils')->get_clean_trial_trait_names($c, $pop_id);
 163
 164         $trait_names = join("\t", @$trait_names);
 165         write_file($traits_file, {binmode => ':utf8'}, $trait_names);
 166     }
 167
 168 }
 169
 170
 171 sub get_all_traits {
 172     my ($self, $c, $pop_id) = @_;
 173
 174     $pop_id = $c->stash->{training_pop_id} if !$pop_id;
 175
 176     $c->controller('solGS::Files')->traits_list_file($c, $pop_id);
 177     my $traits_file = $c->stash->{traits_list_file};
 178
 179     if (!-s $traits_file)
 180     {
 181         my $page = $c->req->path;
 182         if ($page =~ /solgs\/population\/|anova\/|correlation\/|acronyms/ && $pop_id !~ /\D+/)
 183         {
 184             $self->save_single_trial_traits($c, $pop_id);
 185         }
 186     }
 187
 188     my $traits = read_file($traits_file, {binmode => ':utf8'});
 189
 190     $c->controller('solGS::Files')->traits_acronym_file($c, $pop_id);
 191     my $acronym_file = $c->stash->{traits_acronym_file};
 192
 193     unless (-s $acronym_file)
 194     {
 195         my @filtered_traits = split(/\t/, $traits);
 196         my $acronymized_traits = $c->controller('solGS::Utils')->acronymize_traits(\@filtered_traits);
 197         my $acronym_table = $acronymized_traits->{acronym_table};
 198
 199         $self->traits_acronym_table($c, $acronym_table, $pop_id);
 200     }
 201
 202     $self->create_trait_data($c, $pop_id);
 203 }
 204
 205
 206 sub create_trait_data {
 207     my ($self, $c, $pop_id) = @_;
 208
 209     my $acronym_pairs = $self->get_acronym_pairs($c, $pop_id);
 210
 211     my @pop_traits_details;
 212     if (@$acronym_pairs)
 213     {
 214         my $table = 'trait_id' . "\t" . 'trait_name' . "\t" . 'acronym' . "\n";
 215         foreach (@$acronym_pairs)
 216         {
 217             my $trait_name = $_->[1];
 218             $trait_name    =~ s/\n//g;
 219
 220             my $trait_id = $c->controller('solGS::Search')->model($c)->get_trait_id($trait_name);
 221
 222             if ($trait_id)
 223             {
 224                 $table .= $trait_id . "\t" . $trait_name . "\t" . $_->[0] . "\n";
 225
 226         push @pop_traits_details, [$trait_id, $trait_name, $_->[0]];
 227             }
 228         }
 229
 230         $c->controller('solGS::Files')->all_traits_file($c, $pop_id);
 231         my $traits_file =  $c->stash->{all_traits_file};
 232         write_file($traits_file, {binmode => ':utf8'}, $table);
 233
 234     $c->stash->{training_pop_traits_details} = \@pop_traits_details;
 235     }
 236 }
 237
 238
 239 sub get_acronym_pairs {
 240     my ($self, $c, $pop_id) = @_;
 241
 242     $pop_id = $c->stash->{training_pop_id} if !$pop_id;
 243     #$pop_id = $c->stash->{combo_pops_id} if !$pop_id;
 244
 245     my $dir    = $c->stash->{solgs_cache_dir};
 246     opendir my $dh, $dir
 247         or die "can't open $dir: $!\n";
 248
 249     no warnings 'uninitialized';
 250
 251     my ($file)   =  grep(/traits_acronym_pop_${pop_id}/, readdir($dh));
 252     $dh->close;
 253
 254     my $acronyms_file = catfile($dir, $file);
 255
 256     my @acronym_pairs;
 257     if (-f $acronyms_file)
 258     {
 259         @acronym_pairs =  map { [ split(/\t/) ] }  read_file($acronyms_file, {binmode => ':utf8'});
 260         shift(@acronym_pairs); # remove header;
 261     }
 262
 263     @acronym_pairs = sort {uc $a->[0] cmp uc $b->[0] } @acronym_pairs;
 264
 265     $c->stash->{acronym} = \@acronym_pairs;
 266
 267     return \@acronym_pairs;
 268
 269 }
 270
 271
 272 sub traits_acronym_table {
 273     my ($self, $c, $acronym_table, $pop_id) = @_;
 274
 275     $pop_id = $c->stash->{training_pop_id} if !$pop_id;
 276
 277     if (keys %$acronym_table)
 278     {
 279         my $table = 'Acronym' . "\t" . 'Trait name' . "\n";
 280
 281         foreach (keys %$acronym_table)
 282         {
 283             $table .= $_ . "\t" . $acronym_table->{$_} . "\n";
 284         }
 285
 286         $c->controller('solGS::Files')->traits_acronym_file($c, $pop_id);
 287         my $acronym_file =  $c->stash->{traits_acronym_file};
 288
 289         write_file($acronym_file, {binmode => ':utf8'}, $table);
 290     }
 291
 292 }
 293
 294
 295 sub begin : Private {
 296     my ($self, $c) = @_;
 297
 298     $c->controller('solGS::Files')->get_solgs_dirs($c);
 299
 300 }
 301
 302
 303 __PACKAGE__->meta->make_immutable;
 304
 305 1;