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

   1 package CXGN::Pedigree::ParseUpload::Plugin::IntercrossCSV;
   2
   3 use File::Slurp;
   4 use Text::CSV;
   5 use Moose::Role;
   6 use CXGN::Stock::StockLookup;
   7 use SGN::Model::Cvterm;
   8 use Data::Dumper;
   9 use CXGN::List::Validate;
  10
  11
  12 sub _validate_with_plugin {
  13     my $self = shift;
  14     my $filename = $self->get_filename();
  15     my $schema = $self->get_chado_schema();
  16     my $delimiter = ',';
  17     my @error_messages;
  18     my %errors;
  19
  20     my $csv = Text::CSV->new({ sep_char => ',' });
  21
  22     open(my $fh, '<', $filename)
  23         or die "Could not open file '$filename' $!";
  24
  25     if (!$fh) {
  26         $errors{'error_messages'} = "Could not read file.";
  27         $self->_set_parse_errors(\%errors);
  28         return;
  29     }
  30
  31     my $header_row = <$fh>;
  32     my @columns;
  33     if ($csv->parse($header_row)) {
  34         @columns = $csv->fields();
  35     } else {
  36         $errors{'error_messages'} = "Could not parse header row.";
  37         $self->_set_parse_errors(\%errors);
  38         return;
  39     }
  40
  41     #  Check headers
  42     if ($columns[0] ne 'crossDbId'){
  43         push @error_messages, "File contents incorrect. The first column must be crossDbId.";
  44     }
  45
  46     if ($columns[1] ne 'femaleObsUnitDbId'){
  47         push @error_messages, "File contents incorrect. The second column must be femaleObsUnitDbId.";
  48     }
  49
  50     if ($columns[2] ne 'maleObsUnitDbId'){
  51         push @error_messages, "File contents incorrect. The third column must be maleObsUnitDbId.";
  52     }
  53
  54     if ($columns[3] ne 'timestamp'){
  55         push @error_messages, "File contents incorrect. The fourth column must be timestamp.";
  56     }
  57
  58     if ($columns[4] ne 'person'){
  59         push @error_messages, "File contents incorrect. The fifth column must be person.";
  60     }
  61
  62     if ($columns[5] ne 'experiment'){
  63         push @error_messages, "File contents incorrect. The sixth column must be experiment.";
  64     }
  65
  66     if ($columns[6] ne 'type'){
  67         push @error_messages, "File contents incorrect. The seventh column must be type.";
  68     }
  69
  70     if ($columns[7] ne 'fruits'){
  71         push @error_messages, "File contents incorrect. The eighth column must be fruits.";
  72     }
  73
  74     if ($columns[8] ne 'flowers'){
  75         push @error_messages, "File contents incorrect. The ninth column must be flowers.";
  76     }
  77
  78     if ($columns[9] ne 'seeds'){
  79         push @error_messages, "File contents incorrect. The tenth column must be seeds.";
  80     }
  81
  82     my %parent_names;
  83     my %experiment;
  84     while ( my $row = <$fh> ){
  85         my @column_values;
  86         if ($csv->parse($row)) {
  87             @column_values = $csv->fields();
  88         } else {
  89             $errors{'error_messages'} = "Could not parse row $row.";
  90             $self->_set_parse_errors(\%errors);
  91             return;
  92         }
  93
  94         my $crossing_experiment_name = $column_values[5];
  95         $experiment{$crossing_experiment_name}++;
  96         my $crossing_experiment_rs = $schema->resultset("Project::Project")->find( { name => $crossing_experiment_name });
  97
  98         if (!$crossing_experiment_rs) {
  99             push @error_messages, "Error! Crossing experiment: $crossing_experiment_name was not found in the database.\n";
 100         }
 101
 102         my $female_parent = $column_values[1];
 103         $parent_names{$female_parent}++;
 104
 105         my $male_parent = $column_values[2];
 106         $parent_names{$male_parent}++;
 107
 108     }
 109
 110     my @experiment_list = keys %experiment;
 111     if (scalar(@experiment_list) > 1) {
 112         push @error_messages, "All of the crosses in each Intercross file should be in the same crossing_experiment";
 113     }
 114
 115     my @parent_list = keys %parent_names;
 116     my $parent_validator = CXGN::List::Validate->new();
 117
 118     my @parents_missing = @{$parent_validator->validate($schema,'accessions_or_populations_or_plots_or_plants',\@parent_list)->{'missing'}};
 119
 120     if (scalar(@parents_missing) > 0) {
 121         push @error_messages, "The following parents are not in the database, or are not in the database as accession names, plot names or plant names: ".join(',',@parents_missing);
 122     }
 123
 124     if (scalar(@error_messages) >= 1) {
 125         $errors{'error_messages'} = \@error_messages;
 126         $self->_set_parse_errors(\%errors);
 127         return;
 128     }
 129
 130     return 1;
 131 }
 132
 133
 134 sub _parse_with_plugin {
 135     my $self = shift;
 136     my $filename = $self->get_filename();
 137     my $schema = $self->get_chado_schema();
 138     my $delimiter = ',';
 139
 140     my $csv = Text::CSV->new({ sep_char => ',' });
 141     my %data;
 142
 143     open(my $fh, '<', $filename)
 144         or die "Could not open file '$filename' $!";
 145
 146     if (!$fh) {
 147         return;
 148     }
 149
 150     my $header_row = <$fh>;
 151     my @header_columns;
 152     if ($csv->parse($header_row)) {
 153         @header_columns = $csv->fields();
 154     } else {
 155         return;
 156     }
 157
 158     while ( my $row = <$fh> ){
 159         my @columns;
 160         if ($csv->parse($row)) {
 161             @columns = $csv->fields();
 162         } else {
 163             return;
 164         }
 165
 166         my $transaction_id = $columns[0];
 167         my $female_parent = $columns[1];
 168         my $male_parent = $columns[2];
 169         my $timestamp = $columns[3];
 170         my $person = $columns[4];
 171         my $crossing_experiment = $columns[5];
 172         my $cross_type = $columns[6];
 173         my $number_of_fruits = $columns[7];
 174         my $number_of_flowers = $columns[8];
 175         my $number_of_seeds = $columns[9];
 176
 177         my $crossing_experiment_id = $schema->resultset("Project::Project")->find({ name => $crossing_experiment })->project_id();
 178         my $female_parent_id = $schema->resultset("Stock::Stock")->find({ name => $female_parent })->stock_id();
 179         my $male_parent_id = $schema->resultset("Stock::Stock")->find({ name => $male_parent })->stock_id();
 180
 181         my $cross_identifier = $crossing_experiment_id.'_'.$female_parent_id.'_'.$male_parent_id;
 182 #        print STDERR "CROSS IDENTIFIER =".Dumper($cross_identifier)."\n";
 183         $data{'crossing_experiment_name'} = $crossing_experiment;
 184         $data{'crosses'}{$cross_identifier}{'intercross_female_parent'} = $female_parent;
 185         $data{'crosses'}{$cross_identifier}{'intercross_male_parent'} = $male_parent;
 186         $data{'crosses'}{$cross_identifier}{'cross_type'} = $cross_type;
 187         $data{'crosses'}{$cross_identifier}{'activities'}{$transaction_id}{'Timestamp'} = $timestamp;
 188         $data{'crosses'}{$cross_identifier}{'activities'}{$transaction_id}{'Operator'} = $person;
 189         $data{'crosses'}{$cross_identifier}{'activities'}{$transaction_id}{'Number of Fruits'} = $number_of_fruits;
 190         $data{'crosses'}{$cross_identifier}{'activities'}{$transaction_id}{'Number of Flowers'} = $number_of_flowers;
 191         $data{'crosses'}{$cross_identifier}{'activities'}{$transaction_id}{'Number of Seeds'} = $number_of_seeds;
 192     }
 193
 194     my $parsed_result = \%data;
 195 #    print STDERR "DATA =".Dumper($parsed_result)."\n";
 196
 197     $self->_set_parsed_data($parsed_result);
 198
 199     return 1;
 200
 201 }
 202
 203 1;