lib/CXGN/Pedigree/ParseUpload/Plugin/PedigreesGeneric.pm

   1 package CXGN::Pedigree::ParseUpload::Plugin::PedigreesGeneric;
   2
   3 use Moose::Role;
   4 use CXGN::File::Parse;
   5 use CXGN::Stock::StockLookup;
   6 use SGN::Model::Cvterm;
   7 use Data::Dumper;
   8 use CXGN::List::Validate;
   9 use CXGN::Pedigree::AddPedigrees;
  10
  11 sub _validate_with_plugin {
  12     my $self = shift;
  13
  14     my $filename = $self->get_filename();
  15     my $schema = $self->get_chado_schema();
  16
  17     my @error_messages;
  18     my %errors;
  19
  20     my $parser = CXGN::File::Parse->new (
  21         file => $filename,
  22         required_columns => [ 'progeny name', 'female parent accession', 'type' ],
  23         optional_columns => [ 'male parent accession' ],
  24         column_aliases => {
  25             'progeny name' => ['progeny_name', 'progeny'],
  26             'female parent accession' => ['female_parent_accession', 'female_parent', 'female parent'],
  27             'type' => ['cross_type', 'cross type'],
  28             'male parent accession' => ['male_parent_accession', 'male_parent', 'male parent']
  29         }
  30     );
  31     my $parsed = $parser->parse();
  32     my $parsed_errors = $parsed->{errors};
  33     my $parsed_columns = $parsed->{columns};
  34     my $parsed_data = $parsed->{data};
  35     my $parsed_values = $parsed->{values};
  36     my $additional_columns = $parsed->{additional_columns};
  37
  38     # return if parsing error
  39     if ( $parsed_errors && scalar(@$parsed_errors) > 0 ) {
  40         $errors{'error_messages'} = $parsed_errors;
  41         $self->_set_parse_errors(\%errors);
  42         return;
  43     }
  44
  45     if ( $additional_columns && scalar(@$additional_columns) > 0 ) {
  46         $errors{'error_messages'} = [
  47             "The following columns are not recognized: " . join(', ', @$additional_columns) . ". Please check the spreadsheet format for the allowed columns."
  48         ];
  49         $self->_set_parse_errors(\%errors);
  50         return;
  51     }
  52
  53     my %supported_cross_types = ( biparental => 1, open => 1, self => 1, sib => 1, polycross => 1, backcross => 1, reselected => 1, doubled_haploid => 1, dihaploid_induction => 1 );
  54     my $seen_cross_types = $parsed_values->{'type'};
  55     my $seen_progenies = $parsed_values->{'progeny name'};
  56     my $seen_female_parents = $parsed_values->{'female parent accession'};
  57     my $seen_male_parents = $parsed_values->{'male parent accession'};
  58     my @all_stocks;
  59     push @all_stocks, @$seen_progenies;
  60     push @all_stocks, @$seen_female_parents;
  61     push @all_stocks, @$seen_male_parents;
  62
  63     foreach my $type (@$seen_cross_types) {
  64         if (!exists $supported_cross_types{$type}) {
  65             push @error_messages, "Cross type not supported: $type. Cross type should be biparental, self, open, sib, backcross, reselected, polycross, doubled_haploid or dihaploid_induction";
  66         }
  67     }
  68
  69     my $accession_validator = CXGN::List::Validate->new();
  70     my @accessions_missing = @{$accession_validator->validate($schema,'accessions_or_populations_or_vector_constructs',\@all_stocks)->{'missing'}};
  71     my $cross_validator = CXGN::List::Validate->new();
  72     my @stocks_missing = @{$cross_validator->validate($schema,'crosses',\@accessions_missing)->{'missing'}};
  73     if (scalar(@stocks_missing) > 0) {
  74         push @error_messages, "The following accessions are not in the database, or are not in the database as uniquenames: ".join(',',@stocks_missing);
  75     }
  76
  77     my @pedigrees;
  78     foreach my $row (@$parsed_data) {
  79         my $female_parent;
  80         my $male_parent;
  81
  82         my $progeny = $row->{'progeny name'};
  83         my $female = $row->{'female parent accession'};
  84         my $male = $row->{'male parent accession'};
  85         my $cross_type = $row->{'type'};
  86         my $line_number = $row->{'_row'};
  87
  88         if ($female eq $male) {
  89             if ($cross_type ne 'self' && $cross_type ne 'sib' && $cross_type ne 'reselected' && $cross_type ne 'doubled_haploid' && $cross_type ne 'dihaploid_induction'){
  90                 push @error_messages, "Female parent and male parent are the same on line $line_number, but cross type is not self, sib, reselected, doubled_haploid or dihaploid_induction.";
  91             }
  92         }
  93         if (($female && !$male) && ($cross_type ne 'open')) {
  94             push @error_messages, "For $progeny on line number $line_number no male parent specified and cross_type is not open...";
  95         }
  96         if ($cross_type eq 'biparental') {
  97             if (!$male){
  98                 push @error_messages, "For $progeny Cross Type is biparental, but no male parent given";
  99             }
 100         }
 101         if($cross_type eq 'backcross') {
 102             if (!$male){
 103                 push @error_messages, "For $progeny Cross Type is backcross, but no male parent given";
 104             }
 105         }
 106         elsif($cross_type eq "sib") {
 107             if (!$male){
 108                 push @error_messages, "For $progeny Cross Type is sib, but no male parent given";
 109             }
 110         }
 111         elsif($cross_type eq "polycross") {
 112             if (!$male){
 113                 push @error_messages, "For $progeny Cross Type is polycross, but no male parent given";
 114             }
 115         }
 116     }
 117
 118     if (scalar(@error_messages) >= 1) {
 119         $errors{'error_messages'} = \@error_messages;
 120         $self->_set_parse_errors(\%errors);
 121         return;
 122     }
 123
 124     $self->_set_parsed_data($parsed);
 125     return 1;
 126
 127 }
 128
 129 sub _parse_with_plugin {
 130     my $self = shift;
 131     my $schema = $self->get_chado_schema();
 132     my $parsed = $self->_parsed_data();
 133     my $parsed_data = $parsed->{data};
 134
 135     my $pedigrees = CXGN::Pedigree::AddPedigrees->new({ schema => $schema });
 136     my $generated_pedigrees = $pedigrees->generate_pedigrees($parsed_data);
 137
 138     my $validate = CXGN::Pedigree::AddPedigrees->new({ schema => $schema, pedigrees => $generated_pedigrees });
 139     my $error;
 140     my $pedigree_check = $validate->validate_pedigrees();
 141
 142     my %return;
 143     if (!$pedigree_check){
 144         $return{'error_messages'} = "There was a problem validating pedigrees. Pedigrees were not stored.";
 145         $self->_set_parse_errors(\%return);
 146         return;
 147     } else {
 148         $return{'pedigree_check'} = $pedigree_check->{error};
 149         $return{'pedigree_data'} = $parsed_data;
 150     }
 151
 152     $self->_set_parsed_data(\%return);
 153     return 1;
 154 }
 155
 156
 157 1;