Merge branch 'master-upstream' into bug/brapi-studies-fixes-additions

bin/download_trials.pl

@@ -0,0 +1,188 @@
+
+=head1 NAME
+
+download_trials.pl - script to download trials
+
+=head1 DESCRIPTION
+
+perl download_trials.pl -i trial_id -H host -D dbname -U dbuser -P dbpass
+
+Downloads trials whose ids are provided as a comma separated list for the -i parameter.
+
+=head1 AUTHOR
+
+Lukas Mueller <[email protected]>
+
+=cut
+
+use strict;
+
+use Getopt::Std;
+use Data::Dumper;
+
+use Bio::Chado::Schema;
+use CXGN::Metadata::Schema;
+use CXGN::Phenome::Schema;
+use CXGN::DB::InsertDBH;
+use CXGN::Trial;
+
+our ($opt_H, $opt_D, $opt_U, $opt_P, $opt_b, $opt_i, $opt_n, $opt_t, $opt_r);
+
+getopts('H:D:U:P:b:i:t:r:n');
+
+my $dbhost = $opt_H;
+my $dbname = $opt_D;
+my $dbuser = $opt_U;
+my $dbpass = $opt_P;
+my $trial_ids = $opt_i;
+my $trial_names = $opt_t;
+my $non_interactive = $opt_n;
+
+my $dbh = CXGN::DB::InsertDBH->new( { dbhost=>$dbhost,
+				      dbname=>$dbname,
+				      dbargs => {AutoCommit => 0,
+				      RaiseError => 1}
+				    }
+    );
+
+print STDERR "Connecting to database...\n";
+my $schema= Bio::Chado::Schema->connect(  sub { $dbh->get_actual_dbh() } );
+my $metadata_schema = CXGN::Metadata::Schema->connect( sub { $dbh->get_actual_dbh() });
+my $phenome_schema = CXGN::Phenome::Schema->connect( sub { $dbh->get_actual_dbh() });
+
+my @trial_ids = split ",", $trial_ids;
+my @trial_names = split ",", $trial_names;
+
+foreach my $name (@trial_names) { 
+    my $trial = $schema->resultset("Project::Project")->find( { name => $name });
+    if (!$trial) { print STDERR "Trial $name not found. Skipping...\n"; next; }
+    push @trial_ids, $trial->project_id();
+}
+
+my @spreadsheet;
+my %trial_data;
+my %trial_cols;
+
+foreach my $trial_id (@trial_ids) { 
+    print STDERR "Retrieving trial information for trial $trial_id...\n";
+
+    my $t = CXGN::Trial->new({
+        bcs_schema => $schema,
+        metadata_schema => $metadata_schema,
+        phenome_schema => $phenome_schema,
+        trial_id => $trial_id
+    });
+
+    my $location = $t->get_location();
+
+    my $breeding_programs = $t->get_breeding_programs();
+
+    my $breeding_program_name = $t->get_breeding_program();
+
+    my $planting_date = $t->get_planting_date();
+
+    my $harvest_date = $t->get_harvest_date();
+
+    my $breeding_program_id;
+    my $breeding_program_description;
+
+    foreach my $bp (@$breeding_programs) {
+	if ($bp->[1] eq $breeding_program_name) {
+	    $breeding_program_id = $bp->[0];
+	    $breeding_program_description = $bp->[2];
+	}
+    }
+
+    my $trial_name = $t->get_name();
+
+    my $traits = $t->get_traits_assayed();
+
+    my $year = $t->get_year();
+
+    my $trial_id = $t->get_trial_id();
+
+    my $design_type = $t->get_design_type();
+
+    my $plot_width = $t->get_plot_width();
+
+    my $plot_length = $t->get_plot_length();
+
+    print STDERR "Traits assayed = ".Dumper($traits);
+
+    my @trait_names = map { $_->[1] } @$traits;
+    my @trait_ids = map { $_->[0] } @$traits;
+
+    print STDERR "trait_ids = ". Dumper(\@trait_ids);
+
+    my $data = $t->get_stock_phenotypes_for_traits(\@trait_ids, 'all', ['plot_of','plant_of'], 'accession', 'subject');
+
+    print STDERR Dumper($data);
+
+
+    $trial_data{$trial_id} = $data;
+    $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] ];
+
+
+}
+
+my @trial_header = qw | studyYear programDbId breeding_programName programDescription studyDbId studyName studyDesign plotWidth plotLength fieldSize fieldTrialIsPlannedToBeGenotyped fieldTrialIsPlannedToCross plantingDate harvestDate, locationDbId, locationName |;
+
+# first organize traits in hash structure
+my %obs;
+my %traits;
+my %plots;
+my %plot_ids;
+foreach my $trial_id (keys %trial_data) { 
+    foreach my $line (@{$trial_data{$trial_id}}) {
+	# keys: {trial_id} -> {accession}-> {plot} -> {trait} = value
+	$obs{$trial_id}->{$line->[9]}->{$line->[1]}->{$line->[3]} = $line->[7];
+	$traits{$line->[3]}++;
+	$plots{$line->[1]} = $line->[0];
+    }
+
+}
+
+
+# get plot metadata
+
+my %plot_data;
+foreach my $p (keys %plots) {
+    my $rs= $schema->resultset("Stock::Stockprop")->search( { stock_id => $plots{$p} }, { join => 'type', '+select' => 'type.name', '+as'=> 'cvterm_name' });
+
+    while (my $row = $rs->next()) {
+	print STDERR "stockprop: ".$row->get_column("cvterm_name"). " ".$row->value()."\n";
+	$plot_data{$p}->{$row->get_column("cvterm_name")} = $row->value();
+    }
+}
+
+
+print STDERR "observations: ".Dumper(\%obs);
+
+print STDERR "Traits: ".Dumper(\%traits);
+
+print join("\t", (@trial_header, 'accession',  'plot', 'replicate', 'blockNumber', 'plotNumber', 'rowNumber', 'colNumber', 'entryType', sort(keys(%traits))))."\n";
+
+foreach my $trial_id (keys(%obs)) {
+
+    foreach my $accession (keys %{$obs{$trial_id}}) {
+
+	foreach my $plot (keys %{$obs{$trial_id}->{$accession}}) { 
+
+
+	    my @out = ( @{$trial_cols{$trial_id}}, $accession, $plot );
+
+	    foreach my $prop (qw| replicate block_number plot_number row_number col_number entry_type |) {
+		push @out, $plot_data{$plot}->{$prop};
+	    }
+
+
+	    foreach my $trait (sort(keys %traits)) {
+		push @out, $obs{$trial_id}->{$accession}->{$plot}->{$trait};
+	    }
+	    print join("\t", @out)."\n";
+	}
+    }
+}
+
+
+#print STDERR "spreadsheet : ". Dumper(\@spreadsheet);	

bin/merge_stocks.pl

@@ -59,34 +59,67 @@ =head1 AUTHOR
 open(my $F, "<", $file) || die "Can't open file $file.\n";
 
 my $header = <$F>;
+
+my @merged_stocks_to_delete = ();
+
 print STDERR "Skipping header line $header\n";
 eval {
     while (<$F>) {
         print STDERR "Read line: $_\n";
 	chomp;
 	my ($merge_stock_name, $good_stock_name) = split /\t/;
 	print STDERR "bad name: $merge_stock_name, good name: $good_stock_name\n";
-	my $stock_row = $schema->resultset("Stock::Stock")->find( { uniquename => $good_stock_name } );
+
+	# for now, only allow accessions to be merged!
+	my $accession_type_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'accession', 'stock_type')->cvterm_id();
+
+	print STDERR "Working with accession type id of $accession_type_id...\n";
+
+	my $stock_row = $schema->resultset("Stock::Stock")->find( { uniquename => $good_stock_name, type_id=>$accession_type_id } );
 	if (!$stock_row) {
-	    print STDERR "Stock $good_stock_name not found. Skipping...\n";
+	    print STDERR "Stock $good_stock_name (of type accession) not found. Skipping...\n";
 
 	    next();
 	}
 
-	my $merge_row = $schema->resultset("Stock::Stock")->find( { uniquename => $merge_stock_name } );
+	my $merge_row = $schema->resultset("Stock::Stock")->find( { uniquename => $merge_stock_name, type_id => $accession_type_id  } );
 	if (!$merge_row) {
-	    print STDERR "Stock $merge_stock_name not available for merging. Skipping\n";
+	    print STDERR "Stock $merge_stock_name (of type accession) not available for merging. Skipping\n";
 	    next();
 	}
 
 	my $good_stock = CXGN::Stock->new( { schema => $schema, stock_id => $stock_row->stock_id });
 	my $merge_stock = CXGN::Stock->new( { schema => $schema, stock_id => $merge_row->stock_id });
 
 	print STDERR "Merging stock $merge_stock_name into $good_stock_name... ";
-	$good_stock->merge($merge_stock->stock_id(), $delete_merged_stock);
+	$good_stock->merge($merge_stock->stock_id());
+
+	if ($delete_merged_stock) {
+	    push @merged_stocks_to_delete, $merge_stock->stock_id();
+	}
+
 	print STDERR "Done.\n";
     }
 
+
+    if ($delete_merged_stock) {
+	print STDERR "Delete merged stocks ( -x option)...\n";
+	foreach my $remove_stock_id (@merged_stocks_to_delete) {
+	    my $q = "delete from phenome.stock_owner where stock_id=?";
+	    my $h = $dbh->prepare($q);
+	    $h->execute($remove_stock_id);
+
+	    $q = "delete from phenome.stock_image where stock_id=?";
+	    $h = $dbh->prepare($q);
+	    $h->execute($remove_stock_id);
+
+	    my $row = $schema->resultset('Stock::Stock')->find( { stock_id => $remove_stock_id });
+	    print STDERR "Deleting stock ".$row->uniquename." (id=$remove_stock_id)\n";
+	    $row->delete();
+	}
+	print STDERR "Done with deletions.\n";
+    }
+
 };
 if ($@) {
     print STDERR "An ERROR occurred ($@). Rolling back changes...\n";

db/00143/AddCatalogRelatedCvterms.pm

@@ -0,0 +1,86 @@
+#!/usr/bin/env perl
+
+
+=head1 NAME
+
+AddCatalogRelatedCvterms
+
+=head1 SYNOPSIS
+
+mx-run AddCatalogRelatedCvterms [options] -H hostname -D dbname -u username [-F]
+
+this is a subclass of L<CXGN::Metadata::Dbpatch>
+see the perldoc of parent class for more details.
+
+=head1 DESCRIPTION
+This patch adds stock_catalog_json stock_property and catalog_items list_types cvterm
+This subclass uses L<Moose>. The parent class uses L<MooseX::Runnable>
+
+=head1 AUTHOR
+
+Titima Tantikanjana <[email protected]>
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2010 Boyce Thompson Institute for Plant Research
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+
+package AddCatalogRelatedCvterms;
+
+use Moose;
+use Bio::Chado::Schema;
+use Try::Tiny;
+extends 'CXGN::Metadata::Dbpatch';
+
+
+has '+description' => ( default => <<'' );
+This patch adds the 'stock_catalog_json stock_property cvterm and catalog_items list_types cvterm
+
+has '+prereq' => (
+	default => sub {
+        [],
+    },
+
+);
+
+sub patch {
+    my $self=shift;
+
+    print STDOUT "Executing the patch:\n " .   $self->name . ".\n\nDescription:\n  ".  $self->description . ".\n\nExecuted by:\n " .  $self->username . " .";
+
+    print STDOUT "\nChecking if this db_patch was executed before or if previous db_patches have been executed.\n";
+
+    print STDOUT "\nExecuting the SQL commands.\n";
+    my $schema = Bio::Chado::Schema->connect( sub { $self->dbh->clone } );
+
+
+    print STDERR "INSERTING CV TERMS...\n";
+
+	my $terms = {
+	    'stock_property' => [
+            'stock_catalog_json'],
+        'list_types' => [
+            'catalog_items']
+	};
+
+	foreach my $t (keys %$terms){
+		foreach (@{$terms->{$t}}){
+			$schema->resultset("Cv::Cvterm")->create_with({
+				name => $_,
+				cv => $t
+			});
+		}
+	}
+
+    print "You're done!\n";
+}
+
+
+####
+1; #
+####