bin/load_qtl_loci.pl

   1
   2 =head1 NAME
   3
   4 load_qtl_loci.pl - load the qtls as loci
   5
   6 =head1 DESCRIPTION
   7
   8 Loads the QTL markers in a map file as loci into the locus database and attributes them to sp_person_id provided by -p option. It connects the loci to the map location. Note that the map needs to be loaded, using load_map_data.pl, before this script is run.
   9
  10 =head1 SYNOPSYS
  11
  12 perl load_qtl_loci.pl -H hostname -D dbname -p locus_owner_id -c common_name_id <-t> marker_file
  13
  14 Note: with the -t flag, data is not actually stored (test run).
  15 The marker file is the same as for map loading (see load_map_data.pl).
  16
  17 =head1 AUTHOR(S)
  18
  19 Lukas Mueller <lam87@cornell.edu>
  20
  21 =cut
  22
  23 use Modern::Perl;
  24
  25 use CXGN::Phenome::Locus;
  26 use CXGN::Phenome::LocusMarker;
  27
  28 use CXGN::DB::InsertDBH;
  29 use Getopt::Std;
  30
  31 our(%opts);
  32 getopts('H:D:p:tc:', \%opts);
  33
  34 if (!exists($opts{p})) {
  35     die "need -p parameter (sp_person_id of locus owner)";
  36 }
  37
  38 if (!exists($opts{c})) {
  39     die "need -c parameter (common_name_id)";
  40 }
  41
  42 my $file = shift;
  43
  44
  45 my $dbh = CXGN::DB::InsertDBH->new({ dbname => $opts{D},
  46                                    dbhost => $opts{H}});
  47
  48 open(my $F, "<", $file) || die "Can't open file $file\n";
  49 my $count = 0;
  50 while (<$F>) {
  51     my ($qtl, $chr, $pos, $protocol, $confidence, $description, $pubmed_id) = split /\t/;
  52
  53
  54     if ($protocol =~ /QTL/i) {
  55         my $l = CXGN::Phenome::Locus->new($dbh);
  56
  57         print STDERR "Setting locus name and symbol ($qtl)...\n";
  58         $l->set_locus_name($qtl);
  59         my $symbol = $qtl;
  60         if ($symbol =~ /.*\_(.*\d+\_\d+)/) {
  61             $symbol = $1;
  62             $symbol =~ s/\_/\./g;
  63         }
  64         $l->set_locus_symbol($symbol);
  65         $l->set_common_name_id($opts{c});
  66         print STDERR "Setting description...\n";
  67         $l->set_description($description);
  68         $l->set_sp_person_id($opts{p});
  69
  70         print STDERR "Adding publication $pubmed_id...\n";
  71         my $sth = $dbh->prepare("SELECT dbxref_id FROM dbxref WHERE accession=?");
  72         $sth->execute($pubmed_id);
  73         my ($dbxref_id) = $sth->fetchrow_array();
  74         if ($dbxref_id) {
  75             print STDERR "Adding dbxref_id $dbxref_id...\n";
  76             my $dbxref = CXGN::Chado::Dbxref->new($dbh, $dbxref_id);
  77             $dbxref->set_sp_person_id($opts{p});
  78             $dbxref->set_accession($pubmed_id);
  79             $dbxref->set_db_name('PMID');
  80             $l->add_locus_dbxref($dbxref) if $dbxref;
  81         }
  82
  83
  84         if (!$opts{t}) {
  85             print STDERR "Storing...\n";
  86             my $locus_id = $l->store();
  87
  88             $l->add_owner($opts{p});
  89
  90             my $sth = $dbh -> prepare("SELECT marker_id FROM sgn.marker_alias WHERE alias =?");
  91             $sth->execute($qtl);
  92
  93             my ($marker_id) = $sth->fetchrow_array();
  94
  95             if (!$marker_id) { die "Couldn't find a marker for $qtl!"; }
  96             print STDERR "Found marker $marker_id. Associating it...\n";
  97
  98             my $lm = CXGN::Phenome::LocusMarker->new($dbh);
  99             $lm->set_marker_id($marker_id);
 100             $lm->set_locus_id($locus_id);
 101
 102
 103             $lm->store();
 104
 105             $l->add_locus_marker($lm);
 106
 107
 108         }
 109
 110         else {
 111             print STDERR "NOT storing (-t in effect!)\n";
 112         }
 113         $count++;
 114     }
 115
 116
 117
 118         ###$l->associate_publication($pubmed, $opts{p});
 119
 120
 121 }
 122
 123 if (!$opts{t}) {
 124     print STDERR "Committing!!!!!\n";
 125     $dbh->commit;
 126 }
 127
 128 print STDERR "Done. Processed $count qtls\n";