lib/CXGN/Trial/TrialDesignStore/PhenotypingTrial.pm

   1
   2 package CXGN::Trial::TrialDesignStore::PhenotypingTrial;
   3
   4 use Moose;
   5 use Try::Tiny;
   6 use JSON;
   7 use Data::Dumper;
   8
   9 extends 'CXGN::Trial::TrialDesignStore::AbstractTrial';
  10
  11 sub BUILD {   # adjust the cvterm ids for phenotyping trials
  12     my $self = shift;
  13
  14     #print STDERR "PhenotypingTrial BUILD setting stock type id etc....\n";
  15     $self->set_nd_experiment_type_id(SGN::Model::Cvterm->get_cvterm_row($self->get_bcs_schema(), 'field_layout', 'experiment_type')->cvterm_id());
  16     $self->set_stock_type_id($self->get_plot_cvterm_id);
  17     $self->set_stock_relationship_type_id($self->get_plot_of_cvterm_id);
  18     $self->set_source_stock_types([$self->get_accession_cvterm_id, $self->get_cross_cvterm_id, $self->get_family_name_cvterm_id]);
  19
  20     $self->set_valid_properties(
  21         [
  22         'seedlot_name',
  23         'num_seed_per_plot',
  24         'weight_gram_seed_per_plot',
  25         'stock_name',
  26         'plot_name',
  27         'plot_number',
  28         'block_number',
  29         'rep_number',
  30         'is_a_control',
  31         'range_number',
  32         'row_number',
  33         'col_number',
  34         'plant_names',
  35         'plot_num_per_block',
  36         'subplots_names', #For splotplot
  37         'treatments', #For splitplot
  38         'subplots_plant_names', #For splitplot
  39         'additional_info' # For brapi additional info storage
  40         ]);
  41
  42 }
  43
  44 sub validate_design {
  45     my $self = shift;
  46
  47     #print STDERR "validating design\n";
  48     my $chado_schema = $self->get_bcs_schema;
  49     my $design_type = $self->get_design_type;
  50     my %design = %{$self->get_design};
  51     my $error = '';
  52
  53     if (defined $design_type){
  54         if ($design_type ne 'CRD' && $design_type ne 'Alpha' && $design_type ne 'MAD' && $design_type ne 'Lattice' && $design_type ne 'Augmented' && $design_type ne 'RCBD' && $design_type ne 'RRC' && $design_type ne 'p-rep' && $design_type ne 'splitplot' && $design_type ne 'greenhouse' && $design_type ne 'Westcott' && $design_type ne 'Analysis'){
  55             $error .= "Design $design_type type must be either: CRD, Alpha, Augmented, Lattice, RCBD, RRC, MAD, p-rep, greenhouse, Westcott or splitplot";
  56             return $error;
  57         }
  58     }
  59
  60     my @valid_properties = @{$self->get_valid_properties()};
  61     my %allowed_properties = map {$_ => 1} @valid_properties;
  62
  63     my %seen_stock_names;
  64     my %seen_source_names;
  65     my %seen_accession_names;
  66     my %seen_plot_numbers;
  67     my @plot_numbers;
  68
  69     foreach my $stock (keys %design){
  70         if ($stock eq 'treatments'){
  71             next;
  72         }
  73         if (!exists($design{$stock}->{plot_number})) {
  74             $error .= "Property: plot_number is required for stock" . $stock;
  75         }
  76
  77         foreach my $property (keys %{$design{$stock}}){
  78             if (!exists($allowed_properties{$property})) {
  79                 $error .= "Property: $property not allowed! ";
  80             }
  81             if ($property eq 'stock_name') {
  82                 my $stock_name = $design{$stock}->{$property};
  83                 $seen_accession_names{$stock_name}++;
  84             }
  85             if ($property eq 'seedlot_name') {
  86                 my $stock_name = $design{$stock}->{$property};
  87                 if ($stock_name){
  88                     $seen_source_names{$stock_name}++;
  89                 }
  90             }
  91             if ($property eq 'plot_name') {
  92                 my $plot_name = $design{$stock}->{$property};
  93                 # Check that there are no plant names, if so, this could be a lookup value for an existing plot
  94                 # So, we don't validate that the plot name is unique
  95                 if ($design{$stock}->{plant_names} && scalar $design{$stock}->{plant_names} > 0) { next; }
  96                 $seen_stock_names{$plot_name}++;
  97             }
  98             if ($property eq 'plant_names') {
  99                 my $plant_names = $design{$stock}->{$property};
 100                 foreach (@$plant_names) {
 101                     $seen_stock_names{$_}++;
 102                 }
 103             }
 104             if ($property eq 'subplots_names') {
 105                 my $subplot_names = $design{$stock}->{$property};
 106                 foreach (@$subplot_names) {
 107                     $seen_stock_names{$_}++;
 108                 }
 109             }
 110
 111             if ($property eq 'plot_number') {
 112                 my $plot_number = $design{$stock}->{$property};
 113                 if ($design{$stock}->{plant_names} && scalar $design{$stock}->{plant_names} > 0) { next; }
 114                 $seen_plot_numbers{$plot_number}++;
 115                 push @plot_numbers, $plot_number;
 116             }
 117         }
 118     }
 119
 120     my @stock_names = keys %seen_stock_names;
 121     my @source_names = keys %seen_source_names;
 122     my @accession_names = keys %seen_accession_names;
 123     if(scalar(@stock_names)<1){
 124         $error .= "You cannot create a trial with less than one plot.";
 125     }
 126     #if(scalar(@source_names)<1){
 127     #   $error .= "You cannot create a trial with less than one seedlot.";
 128     #}
 129     if(scalar(@accession_names)<1){
 130         $error .= "You cannot create a trial with less than one accession.";
 131     }
 132     my $subplot_type_id = $self->get_subplot_cvterm_id();      #SGN::Model::Cvterm->get_cvterm_row($chado_schema, 'subplot', 'stock_type')->cvterm_id();
 133     my $plot_type_id = $self->get_plot_cvterm_id();            #SGN::Model::Cvterm->get_cvterm_row($chado_schema, 'plot', 'stock_type')->cvterm_id();
 134     my $plant_type_id = $self->get_plant_cvterm_id();          #SGN::Model::Cvterm->get_cvterm_row($chado_schema, 'plant', 'stock_type')->cvterm_id();
 135     my $tissue_type_id = $self->get_tissue_sample_cvterm_id(); #SGN::Model::Cvterm->get_cvterm_row($chado_schema, 'tissue_sample', 'stock_type')->cvterm_id();
 136     my $stocks = $chado_schema->resultset('Stock::Stock')->search({
 137         type_id=>[$subplot_type_id, $plot_type_id, $plant_type_id, $tissue_type_id],
 138         uniquename=>{-in=>\@stock_names}
 139     });
 140     while (my $s = $stocks->next()) {
 141         $error .= sprintf("Name %s already exists in the database.", $s->uniquename);
 142     }
 143
 144     my $seedlot_validator = CXGN::List::Validate->new();
 145     my @seedlots_missing = @{$seedlot_validator->validate($chado_schema,'seedlots',\@source_names)->{'missing'}};
 146     if (scalar(@seedlots_missing) > 0) {
 147         $error .=  "The following seedlots are not in the database as uniquenames or synonyms: ".join(',',@seedlots_missing);
 148     }
 149
 150     my @source_stock_types = @{$self->get_source_stock_types()};
 151
 152     print STDERR "Source Stock types = ".join(", ",@source_stock_types)."\n";
 153     print STDERR "Accession names = ".join(", ", @accession_names)."\n";
 154
 155     my %found_data;
 156     foreach my $a (@accession_names) {
 157         my $rs = $chado_schema->resultset('Stock::Stock')->search({
 158             'is_obsolete' => { '!=' => 't' },
 159             'type_id' => { -in => \@source_stock_types },
 160             'uniquename' => { ilike => $a } });
 161
 162         while (my $s = $rs->next()) {
 163             print STDERR "FOUND ".$s->uniquename()."\n";
 164             $found_data{$s->uniquename} = 1;
 165         }
 166     }
 167     foreach (@accession_names){
 168         if (!$found_data{$_}){
 169             $error .= "The following name is not in the database: $_ .";
 170         }
 171     }
 172
 173     # Check that the plot numbers are unique in the db for the given study
 174     my $trial_layout_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($chado_schema, 'trial_layout_json', 'project_property')->cvterm_id();
 175     my $plot_number_select = "select projectprop.value from project " .
 176         "join projectprop on projectprop.project_id = project.project_id " .
 177         "where type_id = $trial_layout_cvterm_id and project.project_id = ?";
 178     my $sth = $chado_schema->storage->dbh->prepare($plot_number_select);
 179     $sth->execute($self->get_trial_id());
 180     while (my ($trial_layout_json) = $sth->fetchrow_array()) {
 181         my $trial_layout_json = decode_json($trial_layout_json);
 182         foreach my $key (keys %{$trial_layout_json}) {
 183             if (defined %seen_plot_numbers{$key}) {
 184                 $error .= "Plot number '$key' already exists in the database for that study. Plot number must be unique.";
 185             }
 186         }
 187     }
 188
 189     return $error;
 190 }
 191
 192
 193
 194 1;