lib/SGN/Controller/AJAX/Pedigrees.pm

   1
   2 package SGN::Controller::AJAX::Pedigrees;
   3
   4 use Moose;
   5 use List::Util qw | any |;
   6 use File::Slurp qw | read_file |;
   7 use Data::Dumper;
   8 use Bio::GeneticRelationships::Individual;
   9 use Bio::GeneticRelationships::Pedigree;
  10 use CXGN::Pedigree::AddPedigrees;
  11
  12 BEGIN { extends 'Catalyst::Controller::REST'; }
  13
  14 __PACKAGE__->config(
  15     default   => 'application/json',
  16     stash_key => 'rest',
  17     map       => { 'application/json' => 'JSON', 'text/html' => 'JSON' },
  18    );
  19
  20 has 'schema' => (
  21                  is       => 'rw',
  22                  isa      => 'DBIx::Class::Schema',
  23                  lazy_build => 1,
  24                 );
  25
  26
  27 sub upload_pedigrees : Path('/ajax/pedigrees/upload') Args(0)  {
  28     my $self = shift;
  29     my $c = shift;
  30
  31     if (!$c->user()) {
  32         print STDERR "User not logged in... not uploading pedigrees.\n";
  33         $c->stash->{rest} = {error => "You need to be logged in to upload pedigrees." };
  34         return;
  35     }
  36
  37     if (!any { $_ eq "curator" || $_ eq "submitter" } ($c->user()->roles)  ) {
  38         $c->stash->{rest} = {error =>  "You have insufficient privileges to add pedigrees." };
  39         return;
  40     }
  41
  42     my $time = DateTime->now();
  43     my $user_id = $c->user()->get_object()->get_sp_person_id();
  44     my $user_name = $c->user()->get_object()->get_username();
  45     my $timestamp = $time->ymd()."_".$time->hms();
  46     my $subdirectory = 'pedigree_upload';
  47
  48     my $upload = $c->req->upload('pedigrees_uploaded_file');
  49     my $upload_tempfile  = $upload->tempname;
  50
  51 #    my $temp_contents = read_file($upload_tempfile);
  52 #    $c->stash->{rest} = { error => $temp_contents };
  53 #    return;
  54
  55     my $upload_original_name  = $upload->filename();
  56
  57     # check file type by file name extension
  58     #
  59     if ($upload_original_name =~ /\.xls$|\.xlsx/) {
  60         $c->stash->{rest} = { error => "Pedigree upload requires a tab delimited file. Excel files (.xls and .xlsx) are currently not supported. Please convert the file and try again." };
  61         return;
  62     }
  63
  64     my $md5;
  65
  66     my $uploader = CXGN::UploadFile->new();
  67
  68     my %upload_metadata;
  69   ## Store uploaded temporary file in archive
  70     print STDERR "TEMP FILE: $upload_tempfile\n";
  71     my $archived_filename_with_path = $uploader->archive($c, $subdirectory, $upload_tempfile, $upload_original_name, $timestamp);
  72
  73     if (!$archived_filename_with_path) {
  74         $c->stash->{rest} = {error => "Could not save file $upload_original_name in archive",};
  75         return;
  76     }
  77
  78     $md5 = $uploader->get_md5($archived_filename_with_path);
  79     unlink $upload_tempfile;
  80
  81     # check if all accessions exist
  82     #
  83     open(my $F, "<", $archived_filename_with_path) || die "Can't open archive file $archived_filename_with_path";
  84     my $schema = $c->dbic_schema("Bio::Chado::Schema");
  85     my %stocks;
  86
  87     my $header = <$F>;
  88     my %legal_cross_types = ( biparental => 1, open => 1, self => 1);
  89     my %errors;
  90
  91     while (<$F>) {
  92         chomp;
  93         $_ =~ s/\r//g;
  94         my @acc = split /\t/;
  95         for(my $i=0; $i<3; $i++) {
  96             if ($acc[$i] =~ /\,/) {
  97                 my @a = split /\s*\,\s*/, $acc[$i];  # a comma separated list for an open pollination can be given
  98                 foreach (@a) { $stocks{$_}++ if $_ };
  99             }
 100             else {
 101                 $stocks{$acc[$i]}++ if $acc[$i];
 102             }
 103         }
 104         # check if the cross types are recognized...
 105         if ($acc[3] && !exists($legal_cross_types{lc($acc[3])})) {
 106             $errors{"not legal cross type: $acc[3] (should be biparental, self, or open)"}=1;
 107         }
 108     }
 109     my @unique_stocks = keys(%stocks);
 110     %errors = $self->check_stocks($c, \@unique_stocks);
 111
 112     if (%errors) {
 113         $c->stash->{rest} = { error => "There were problems loading the pedigree for the following accessions: ".(join ",", keys(%errors)).". Please fix these errors and try again. (errors: ".(join ", ", values(%errors)).")" };
 114         return;
 115     }
 116     close($F);
 117
 118     open($F, "<", $archived_filename_with_path) || die "Can't open file $archived_filename_with_path";
 119     $header = <$F>;
 120     my $female_parent;
 121     my $male_parent;
 122     my $child;
 123
 124     my $cross_type = "";
 125
 126     my @pedigrees;
 127
 128     ## NEW FILE STRUCTURE: progeny_name, female parent, male parent, cross_type
 129
 130     while (<$F>) {
 131         chomp;
 132         $_ =~ s/\r//g;
 133         my ($progeny, $female, $male, $cross_type) = split /\t/;
 134
 135         if (!$female && !$male) {
 136             print STDERR "No parents specified... skipping.\n";
 137             next;
 138         }
 139         if (!$progeny) {
 140             print STDERR "No progeny specified... skipping.\n";
 141             next;
 142         }
 143
 144         if (($female eq $male) && ($cross_type ne 'self')) {
 145             $cross_type = "self";
 146         }
 147
 148         elsif ($female && !$male) {
 149             if ($cross_type ne 'open') {
 150                 print STDERR "No male parent specified and cross_type is not open... setting to unknown\n";
 151                 $cross_type = 'unknown';
 152             }
 153         }
 154
 155         if($cross_type eq "self") {
 156             $female_parent = Bio::GeneticRelationships::Individual->new( { name => $female });
 157             $male_parent = Bio::GeneticRelationships::Individual->new( { name => $female });
 158         }
 159         elsif($cross_type eq "biparental") {
 160             $female_parent = Bio::GeneticRelationships::Individual->new( { name => $female });
 161             $male_parent = Bio::GeneticRelationships::Individual->new( { name => $male });
 162         }
 163         elsif($cross_type eq "open") {
 164              $female_parent = Bio::GeneticRelationships::Individual->new( { name => $female });
 165              my $population_name = "";
 166              my @male_parents = split /\s*\,\s*/, $male;
 167
 168              if ($male) {
 169                  $population_name = join "_", @male_parents;
 170              }
 171              else {
 172                  $population_name = $female."_open";
 173              }
 174              $male_parent = Bio::GeneticRelationships::Population->new( { name => $population_name});
 175              $male_parent->set_members(\@male_parents);
 176
 177
 178              my $population_cvterm_id = $c->model("Cvterm")->get_cvterm_row($schema, "population", "stock_type");
 179              my $male_parent_cvterm_id = $c->model("Cvterm")->get_cvterm_row($schema, "male_parent", "stock_relationship");
 180
 181              # create population stock entry
 182              #
 183              my $pop_rs = $schema->resultset("Stock::Stock")->create(
 184                  {
 185                      name => $population_name,
 186                      uniquename => $population_name,
 187                      type_id => $population_cvterm_id->cvterm_id(),
 188                  });
 189
 190               # generate population connections to the male parents
 191              foreach my $p (@male_parents) {
 192                  my $p_row = $schema->resultset("Stock::Stock")->find({ uniquename => $p });
 193                  my $connection = $schema->resultset("Stock::StockRelationship")->create(
 194                      {
 195                          subject_id => $pop_rs->stock_id,
 196                          object_id => $p_row->stock_id,
 197                          type_id => $male_parent_cvterm_id->cvterm_id(),
 198                      });
 199              }
 200              $male = $population_name;
 201         }
 202
 203         my $p = Bio::GeneticRelationships::Pedigree->new(
 204             {
 205                 cross_type => $cross_type,
 206                 female_parent => $female_parent,
 207                 male_parent => $male_parent,
 208                 name => $progeny,
 209             });
 210         push @pedigrees, $p;
 211     }
 212
 213     my $add = CXGN::Pedigree::AddPedigrees->new( { schema=>$c->dbic_schema("Bio::Chado::Schema"), pedigrees=>\@pedigrees });
 214     eval {
 215         my $ok = $add->validate_pedigrees();
 216         $add->add_pedigrees();
 217     };
 218     if ($@) {
 219         $c->stash->{rest} = { error => "An error occurred while storing the provided pedigree. Please check your file and try again ($@)\n" };
 220     }
 221
 222     $c->stash->{rest} = { success => 1 };
 223 }
 224
 225 sub check_stocks {
 226     my $self = shift;
 227     my $c = shift;
 228     my $stock_names = shift;
 229
 230     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 231
 232     my %errors;
 233     my $error_alert = "";
 234
 235     foreach my $stock_name (@$stock_names) {
 236         my $stock;
 237         my $number_of_stocks_found;
 238         my $stock_lookup = CXGN::Stock::StockLookup->new(schema => $schema);
 239         $stock_lookup->set_stock_name($stock_name);
 240         $stock = $stock_lookup->get_stock();
 241         $number_of_stocks_found = $stock_lookup->get_matching_stock_count();
 242         if ($number_of_stocks_found > 1) {
 243             $errors{$stock_name} = "Multiple stocks found matching $stock_name\n";
 244         }
 245         if (!$number_of_stocks_found) {
 246             $errors{$stock_name} = "No stocks found matching $stock_name\n";
 247         }
 248     }
 249
 250     return %errors;
 251 }
 252
 253
 254
 255 1;