db/00151/SaveChromosomeRankInNdProtocol.pm

   1 #!/usr/bin/env perl
   2
   3
   4 =head1 NAME
   5
   6  SaveChromosomeRankInNdProtocol
   7
   8 =head1 SYNOPSIS
   9
  10 mx-run SaveChromosomeRankInNdProtocol [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 SaveChromosomeRankInNdProtocol;
  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 %protocols_hash;
  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             my %unique_chromosomes;
  93             foreach (@$markers_array) {
  94                 # print STDERR Dumper $_;
  95                 $unique_chromosomes{$_->{chrom}}->{marker_count}++;
  96             }
  97
  98             $h1_1->execute($nd_protocol_id);
  99             my ($stock_id) = $h1_1->fetchrow_array();
 100
 101             $protocols_hash{$nd_protocol_id} = {
 102                 chroms => \%unique_chromosomes,
 103                 stock_id => $stock_id
 104             };
 105         }
 106     }
 107     print STDERR Dumper \%protocols_hash;
 108
 109     my $q2 = "SELECT genotypeprop.genotypeprop_id, genotype.genotype_id, genotypeprop.rank, genotypeprop.value->>'CHROM'
 110         FROM genotypeprop
 111         JOIN genotype ON(genotypeprop.genotype_id=genotype.genotype_id)
 112         JOIN nd_experiment_genotype ON(genotype.genotype_id=nd_experiment_genotype.genotype_id)
 113         JOIN nd_experiment ON(nd_experiment.nd_experiment_id=nd_experiment_genotype.nd_experiment_id AND nd_experiment.type_id=$geno_cvterm_id)
 114         JOIN nd_experiment_stock ON(nd_experiment.nd_experiment_id=nd_experiment_stock.nd_experiment_id)
 115         JOIN nd_experiment_protocol ON(nd_experiment.nd_experiment_id=nd_experiment_protocol.nd_experiment_id)
 116         WHERE stock_id=? AND genotypeprop.type_id=$snp_vcf_cvterm_id AND nd_protocol_id=?;";
 117     my $h2 = $schema->storage->dbh()->prepare($q2);
 118
 119     my %protocol_chrom_rank;
 120     while (my($nd_protocol_id, $o) = each %protocols_hash) {
 121         my $chroms = $o->{chroms};
 122         my $stock_id = $o->{stock_id};
 123         $h2->execute($stock_id, $nd_protocol_id);
 124         while (my ($genotypeprop_id, $genotype_id, $rank, $chrom) = $h2->fetchrow_array()) {
 125             print STDERR "$nd_protocol_id, $stock_id, $genotype_id, $genotypeprop_id, $rank, $chrom \n";
 126             $protocol_chrom_rank{$nd_protocol_id}->{$chrom} = $rank;
 127         }
 128     }
 129     print STDERR Dumper \%protocol_chrom_rank;
 130
 131     my %protocol_chrom_rank_result;
 132     while (my($nd_protocol_id, $o) = each %protocols_hash) {
 133         my $chroms = $o->{chroms};
 134         my %chromosomes;
 135         while (my($chrom,$p) = each %$chroms) {
 136             my $marker_count = $p->{marker_count};
 137             my $rank = $protocol_chrom_rank{$nd_protocol_id}->{$chrom} || 0;
 138             $chromosomes{$chrom} = {
 139                 rank => $rank,
 140                 marker_count => $marker_count
 141             };
 142         }
 143         $protocol_chrom_rank_result{$nd_protocol_id} = \%chromosomes;
 144     }
 145     print STDERR Dumper \%protocol_chrom_rank_result;
 146
 147     my $q3 = "SELECT value,nd_protocolprop_id FROM nd_protocolprop WHERE nd_protocol_id=? AND type_id=$vcf_map_details_id;";
 148     my $h3 = $schema->storage->dbh()->prepare($q3);
 149
 150     my $q4 = "UPDATE nd_protocolprop SET value=? WHERE nd_protocolprop_id=?;";
 151     my $h4 = $schema->storage->dbh()->prepare($q4);
 152
 153     while (my($nd_protocol_id,$chroms) = each %protocol_chrom_rank_result) {
 154         $h3->execute($nd_protocol_id);
 155         my ($prop_json, $nd_protocolprop_id) = $h3->fetchrow_array();
 156         my $prop = decode_json $prop_json;
 157         $prop->{chromosomes} = $chroms;
 158         my $prop_save = encode_json $prop;
 159         $h4->execute($prop_save, $nd_protocolprop_id);
 160         # print STDERR Dumper $prop_save;
 161     }
 162
 163     print "You're done!\n";
 164 }
 165
 166
 167 ####
 168 1; #
 169 ####