bin/download_trials.pl

   1
   2 =head1 NAME
   3
   4 download_trials.pl - script to download trials
   5
   6 =head1 DESCRIPTION
   7
   8 perl download_trials.pl -i trial_id -H host -D dbname -U dbuser -P dbpass
   9
  10 Downloads trials whose ids are provided as a comma separated list for the -i parameter.
  11
  12 =head1 AUTHOR
  13
  14 Lukas Mueller <lam87@cornell.edu>
  15
  16 =cut
  17
  18 use strict;
  19
  20 use Getopt::Std;
  21 use Data::Dumper;
  22
  23 use Bio::Chado::Schema;
  24 use CXGN::Metadata::Schema;
  25 use CXGN::Phenome::Schema;
  26 use CXGN::DB::InsertDBH;
  27 use CXGN::Trial;
  28
  29 our ($opt_H, $opt_D, $opt_U, $opt_P, $opt_b, $opt_i, $opt_n, $opt_t, $opt_r);
  30
  31 getopts('H:D:U:P:b:i:t:r:n');
  32
  33 my $dbhost = $opt_H;
  34 my $dbname = $opt_D;
  35 my $dbuser = $opt_U;
  36 my $dbpass = $opt_P;
  37 my $trial_ids = $opt_i;
  38 my $trial_names = $opt_t;
  39 my $non_interactive = $opt_n;
  40
  41 my $dbh = CXGN::DB::InsertDBH->new( { dbhost=>$dbhost,
  42                                       dbname=>$dbname,
  43                                       dbargs => {AutoCommit => 0,
  44                                       RaiseError => 1}
  45                                     }
  46     );
  47
  48 print STDERR "Connecting to database...\n";
  49 my $schema= Bio::Chado::Schema->connect(  sub { $dbh->get_actual_dbh() } );
  50 my $metadata_schema = CXGN::Metadata::Schema->connect( sub { $dbh->get_actual_dbh() });
  51 my $phenome_schema = CXGN::Phenome::Schema->connect( sub { $dbh->get_actual_dbh() });
  52
  53 my @trial_ids = split ",", $trial_ids;
  54 my @trial_names = split ",", $trial_names;
  55
  56 foreach my $name (@trial_names) {
  57     my $trial = $schema->resultset("Project::Project")->find( { name => $name });
  58     if (!$trial) { print STDERR "Trial $name not found. Skipping...\n"; next; }
  59     push @trial_ids, $trial->project_id();
  60 }
  61
  62 my @spreadsheet;
  63 my %trial_data;
  64 my %trial_cols;
  65
  66 foreach my $trial_id (@trial_ids) {
  67     print STDERR "Retrieving trial information for trial $trial_id...\n";
  68
  69     my $t = CXGN::Trial->new({
  70         bcs_schema => $schema,
  71         metadata_schema => $metadata_schema,
  72         phenome_schema => $phenome_schema,
  73         trial_id => $trial_id
  74     });
  75
  76     my $location = $t->get_location();
  77
  78     my $breeding_programs = $t->get_breeding_programs();
  79
  80     my $breeding_program_name = $t->get_breeding_program();
  81
  82     my $planting_date = $t->get_planting_date();
  83
  84     my $harvest_date = $t->get_harvest_date();
  85
  86     my $breeding_program_id;
  87     my $breeding_program_description;
  88
  89     foreach my $bp (@$breeding_programs) {
  90         if ($bp->[1] eq $breeding_program_name) {
  91             $breeding_program_id = $bp->[0];
  92             $breeding_program_description = $bp->[2];
  93         }
  94     }
  95
  96     my $trial_name = $t->get_name();
  97
  98     my $traits = $t->get_traits_assayed();
  99
 100     my $year = $t->get_year();
 101
 102     my $trial_id = $t->get_trial_id();
 103
 104     my $design_type = $t->get_design_type();
 105
 106     my $plot_width = $t->get_plot_width();
 107
 108     my $plot_length = $t->get_plot_length();
 109
 110     print STDERR "Traits assayed = ".Dumper($traits);
 111
 112     my @trait_names = map { $_->[1] } @$traits;
 113     my @trait_ids = map { $_->[0] } @$traits;
 114
 115     print STDERR "trait_ids = ". Dumper(\@trait_ids);
 116
 117     my $data = $t->get_stock_phenotypes_for_traits(\@trait_ids, 'all', ['plot_of','plant_of'], 'accession', 'subject');
 118
 119     print STDERR Dumper($data);
 120
 121
 122     $trial_data{$trial_id} = $data;
 123     $trial_cols{$trial_id} = [ $year, $breeding_program_id, $breeding_program_name, $breeding_program_description, $trial_id, $trial_name, $design_type, $plot_width, $plot_length, '', '', '', $planting_date, $harvest_date, $location->[0], $location->[1] ];
 124
 125
 126 }
 127
 128 my @trial_header = qw | studyYear programDbId breeding_programName programDescription studyDbId studyName studyDesign plotWidth plotLength fieldSize fieldTrialIsPlannedToBeGenotyped fieldTrialIsPlannedToCross plantingDate harvestDate, locationDbId, locationName |;
 129
 130 # first organize traits in hash structure
 131 my %obs;
 132 my %traits;
 133 my %plots;
 134 my %plot_ids;
 135 foreach my $trial_id (keys %trial_data) {
 136     foreach my $line (@{$trial_data{$trial_id}}) {
 137         # keys: {trial_id} -> {accession}-> {plot} -> {trait} = value
 138         $obs{$trial_id}->{$line->[9]}->{$line->[1]}->{$line->[3]} = $line->[7];
 139         $traits{$line->[3]}++;
 140         $plots{$line->[1]} = $line->[0];
 141     }
 142
 143 }
 144
 145
 146 # get plot metadata
 147
 148 my %plot_data;
 149 foreach my $p (keys %plots) {
 150     my $rs= $schema->resultset("Stock::Stockprop")->search( { stock_id => $plots{$p} }, { join => 'type', '+select' => 'type.name', '+as'=> 'cvterm_name' });
 151
 152     while (my $row = $rs->next()) {
 153         print STDERR "stockprop: ".$row->get_column("cvterm_name"). " ".$row->value()."\n";
 154         $plot_data{$p}->{$row->get_column("cvterm_name")} = $row->value();
 155     }
 156 }
 157
 158
 159 print STDERR "observations: ".Dumper(\%obs);
 160
 161 print STDERR "Traits: ".Dumper(\%traits);
 162
 163 print join("\t", (@trial_header, 'accession',  'plot', 'replicate', 'blockNumber', 'plotNumber', 'rowNumber', 'colNumber', 'entryType', sort(keys(%traits))))."\n";
 164
 165 foreach my $trial_id (keys(%obs)) {
 166
 167     foreach my $accession (keys %{$obs{$trial_id}}) {
 168
 169         foreach my $plot (keys %{$obs{$trial_id}->{$accession}}) {
 170
 171
 172             my @out = ( @{$trial_cols{$trial_id}}, $accession, $plot );
 173
 174             foreach my $prop (qw| replicate block_number plot_number row_number col_number entry_type |) {
 175                 push @out, $plot_data{$plot}->{$prop};
 176             }
 177
 178
 179             foreach my $trait (sort(keys %traits)) {
 180                 push @out, $obs{$trial_id}->{$accession}->{$plot}->{$trait};
 181             }
 182             print join("\t", @out)."\n";
 183         }
 184     }
 185 }
 186
 187
 188 #print STDERR "spreadsheet : ". Dumper(\@spreadsheet);