db/00152/SaveChromosomeRankInNdProtocolFix.pm

   1 #!/usr/bin/env perl
   2
   3
   4 =head1 NAME
   5
   6  SaveChromosomeRankInNdProtocolFix
   7
   8 =head1 SYNOPSIS
   9
  10 mx-run SaveChromosomeRankInNdProtocolFix [options] -H hostname -D dbname -u username [-F]
  11
  12 this is a subclass of L<CXGN::Metadata::Dbpatch>
  13 see the perldoc of parent class for more details.
  14
  15 =head1 DESCRIPTION
  16 This patch saves the genotypeprop rank of the chromosomes in the nd_protocolprop JSONb.
  17 This subclass uses L<Moose>. The parent class uses L<MooseX::Runnable>
  18
  19 =head1 AUTHOR
  20
  21 Nick Morales<nm529@cornell.edu>
  22
  23 =head1 COPYRIGHT & LICENSE
  24
  25 Copyright 2010 Boyce Thompson Institute for Plant Research
  26
  27 This program is free software; you can redistribute it and/or modify
  28 it under the same terms as Perl itself.
  29
  30 =cut
  31
  32
  33 package SaveChromosomeRankInNdProtocolFix;
  34
  35 use Moose;
  36 use Bio::Chado::Schema;
  37 use Try::Tiny;
  38 use SGN::Model::Cvterm;
  39 use JSON;
  40 use Data::Dumper;
  41
  42 extends 'CXGN::Metadata::Dbpatch';
  43
  44
  45 has '+description' => ( default => <<'' );
  46 This patch saves the genotypeprop rank of the chromosomes in the nd_protocolprop JSONb
  47
  48 has '+prereq' => (
  49         default => sub {
  50         [],
  51     },
  52
  53   );
  54
  55 sub patch {
  56     my $self=shift;
  57
  58     print STDOUT "Executing the patch:\n " .   $self->name . ".\n\nDescription:\n  ".  $self->description . ".\n\nExecuted by:\n " .  $self->username . " .";
  59
  60     print STDOUT "\nChecking if this db_patch was executed before or if previous db_patches have been executed.\n";
  61
  62     print STDOUT "\nExecuting the SQL commands.\n";
  63     my $schema = Bio::Chado::Schema->connect( sub { $self->dbh->clone } );
  64
  65
  66     my $vcf_map_details_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'vcf_map_details', 'protocol_property')->cvterm_id();
  67     my $vcf_map_details_markers_array_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'vcf_map_details_markers_array', 'protocol_property')->cvterm_id();
  68     my $geno_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'genotyping_experiment', 'experiment_type')->cvterm_id();
  69     my $snp_vcf_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'vcf_snp_genotyping', 'genotype_property')->cvterm_id();
  70
  71     my $q = "SELECT nd_protocol.nd_protocol_id, markers_array.value
  72         FROM nd_protocol
  73         JOIN nd_protocolprop AS markers_array ON(markers_array.nd_protocol_id=nd_protocol.nd_protocol_id AND markers_array.type_id=$vcf_map_details_markers_array_cvterm_id)
  74         ;";
  75     # print STDERR Dumper $q;
  76     my $h = $schema->storage->dbh()->prepare($q);
  77     $h->execute();
  78
  79     my $q1_1 = "SELECT nd_experiment_stock.stock_id
  80         FROM nd_protocol
  81         JOIN nd_experiment_protocol ON(nd_protocol.nd_protocol_id=nd_experiment_protocol.nd_protocol_id)
  82         JOIN nd_experiment ON(nd_experiment.nd_experiment_id=nd_experiment_protocol.nd_experiment_id AND nd_experiment.type_id=$geno_cvterm_id)
  83         JOIN nd_experiment_stock ON(nd_experiment.nd_experiment_id=nd_experiment_stock.nd_experiment_id)
  84         WHERE nd_protocol.nd_protocol_id=?
  85         ;";
  86     my $h1_1 = $schema->storage->dbh()->prepare($q1_1);
  87
  88     my %unique_chromosomes;
  89     while (my ($nd_protocol_id, $markers_array_json) = $h->fetchrow_array()) {
  90         my $markers_array = $markers_array_json ? decode_json $markers_array_json : [];
  91         if (scalar(@$markers_array)>0) {
  92             foreach (@$markers_array) {
  93                 $unique_chromosomes{$nd_protocol_id}->{$_->{chrom}}->{marker_count}++;
  94             }
  95         }
  96     }
  97     print STDERR Dumper \%unique_chromosomes;
  98
  99     my %protocols_hash;
 100     while (my($nd_protocol_id, $chroms) = each %unique_chromosomes) {
 101         $h1_1->execute($nd_protocol_id);
 102         my ($stock_id) = $h1_1->fetchrow_array();
 103
 104         $protocols_hash{$nd_protocol_id} = {
 105             chroms => $chroms,
 106             stock_id => $stock_id
 107         };
 108     }
 109     print STDERR Dumper \%protocols_hash;
 110
 111     my $q2 = "SELECT genotypeprop.genotypeprop_id, genotype.genotype_id, genotypeprop.rank, genotypeprop.value->>'CHROM'
 112         FROM genotypeprop
 113         JOIN genotype ON(genotypeprop.genotype_id=genotype.genotype_id)
 114         JOIN nd_experiment_genotype ON(genotype.genotype_id=nd_experiment_genotype.genotype_id)
 115         JOIN nd_experiment ON(nd_experiment.nd_experiment_id=nd_experiment_genotype.nd_experiment_id AND nd_experiment.type_id=$geno_cvterm_id)
 116         JOIN nd_experiment_stock ON(nd_experiment.nd_experiment_id=nd_experiment_stock.nd_experiment_id)
 117         JOIN nd_experiment_protocol ON(nd_experiment.nd_experiment_id=nd_experiment_protocol.nd_experiment_id)
 118         WHERE stock_id=? AND genotypeprop.type_id=$snp_vcf_cvterm_id AND nd_protocol_id=?;";
 119     my $h2 = $schema->storage->dbh()->prepare($q2);
 120
 121     my %protocol_chrom_rank;
 122     while (my($nd_protocol_id, $o) = each %protocols_hash) {
 123         my $chroms = $o->{chroms};
 124         my $stock_id = $o->{stock_id};
 125         $h2->execute($stock_id, $nd_protocol_id);
 126         while (my ($genotypeprop_id, $genotype_id, $rank, $chrom) = $h2->fetchrow_array()) {
 127             print STDERR "$nd_protocol_id, $stock_id, $genotype_id, $genotypeprop_id, $rank, $chrom \n";
 128             $protocol_chrom_rank{$nd_protocol_id}->{$chrom} = $rank;
 129         }
 130     }
 131     print STDERR Dumper \%protocol_chrom_rank;
 132
 133     my %protocol_chrom_rank_result;
 134     while (my($nd_protocol_id, $o) = each %protocols_hash) {
 135         my $chroms = $o->{chroms};
 136         my %chromosomes;
 137         while (my($chrom,$p) = each %$chroms) {
 138             my $marker_count = $p->{marker_count};
 139             my $rank = $protocol_chrom_rank{$nd_protocol_id}->{$chrom} || 0;
 140             $chromosomes{$chrom} = {
 141                 rank => $rank,
 142                 marker_count => $marker_count
 143             };
 144         }
 145         $protocol_chrom_rank_result{$nd_protocol_id} = \%chromosomes;
 146     }
 147     print STDERR Dumper \%protocol_chrom_rank_result;
 148
 149     my $q3 = "SELECT value,nd_protocolprop_id FROM nd_protocolprop WHERE nd_protocol_id=? AND type_id=$vcf_map_details_id;";
 150     my $h3 = $schema->storage->dbh()->prepare($q3);
 151
 152     my $q4 = "UPDATE nd_protocolprop SET value=? WHERE nd_protocolprop_id=?;";
 153     my $h4 = $schema->storage->dbh()->prepare($q4);
 154
 155     while (my($nd_protocol_id,$chroms) = each %protocol_chrom_rank_result) {
 156         $h3->execute($nd_protocol_id);
 157         my ($prop_json, $nd_protocolprop_id) = $h3->fetchrow_array();
 158         my $prop = decode_json $prop_json;
 159         $prop->{chromosomes} = $chroms;
 160         my $prop_save = encode_json $prop;
 161         $h4->execute($prop_save, $nd_protocolprop_id);
 162         # print STDERR Dumper $prop_save;
 163     }
 164
 165     print "You're done!\n";
 166 }
 167
 168
 169 ####
 170 1; #
 171 ####