cgi-bin/tools/seedbac/sbfinder.pl

   1
   2 =head1 NAME
   3
   4 sbfinder.pl - a web script that displays potential seedbacs given a marker of the F2-2000 map
   5
   6 =head1 DESCRIPTION
   7
   8 sbfinder.pl will query the physical database bac_marker_matches materialized view for information about BAC - genetic map associations. There are three association types: overgo (experimentally determined associations), computational (associations determined by blast) and manual associations. (the materialized view is created from data of other tables in the physical and sgn databases using the script add_bac_marker_matches_view.pl (found in sgn-tools/stable/physical_tools/bin/ ). See perldoc of that script for more information.
   9
  10 Note: As of 6/2006, the overgo analysis has only been performed on the HindIII library. The computational analysis was done on the HindIII, EcoRI, and MboI library, based on BAC end sequence data (a small part of the normally not known full BAC sequence). Manual annotations are made based on publications and other experimental data.
  11
  12 =head1 AUTHOR(S)
  13
  14 Lukas Mueller (lam87@cornell.edu)
  15
  16 =cut
  17
  18
  19 use CXGN::Page;
  20 use strict;
  21 use DBI;
  22 use CXGN::DB::Connection;
  23
  24 my $sbf = seedbac_finder -> new();
  25 $sbf -> get_args();
  26 if (!$sbf -> has_data()) {
  27     $sbf -> input_page();
  28 }
  29 else {
  30     $sbf -> display_results();
  31 }
  32 $sbf -> clean_up();
  33
  34
  35 package seedbac_finder;
  36
  37 1;
  38
  39 sub new {
  40     my $class = shift;
  41     my $args = {};
  42     my $self = bless $args, $class;
  43     our $page = CXGN::Page->new();
  44     $self->{page} = $page;
  45     $self->{dbh} = CXGN::DB::Connection->new();
  46     return $self;
  47 }
  48
  49 sub has_data {
  50     my $self = shift;
  51     if ($self->get_marker()) {
  52         return 1;
  53     }
  54     else {
  55         return 0;
  56     }
  57 }
  58
  59 sub set_marker {
  60     my $self = shift;
  61     $self->{marker} = shift;
  62 }
  63
  64 sub get_marker {
  65     my $self = shift;
  66     return $self->{marker};
  67 }
  68
  69 sub input_page {
  70     my $self=shift;
  71     $self->{page}->header();
  72
  73     $self->input_box();
  74
  75     $self->{page}->footer();
  76
  77 }
  78
  79 sub input_box {
  80     my $self = shift;
  81     my $marker = $self->get_marker();
  82     print <<HTML;
  83
  84     <h3>Seedbac finder</h3>
  85     This tool will suggest a seed bac given a marker name from the tomato F2-2000 map. Experimental (overgo), computational (blast) and manual (curated from experimental evidence) associations are reported.<br /><br />
  86         <form action=\"sbfinder.pl\">
  87         Marker name: <input name="marker"  value="$marker" />
  88         <input type="submit" value="Submit" />
  89         </form>
  90
  91 HTML
  92
  93 }
  94
  95 sub get_args {
  96     my $self = shift;
  97
  98     my ($marker) = $self->{page}->get_arguments("marker");
  99     $self->set_marker($marker);
 100
 101 }
 102
 103 sub display_results {
 104     my $self = shift;
 105     my %bacs = ();
 106     (@{$bacs{overgo}}) = $self->get_bacs("overgo");
 107     (@{$bacs{computational}}) = $self->get_bacs("computational");
 108     (@{$bacs{manual}}) = $self ->get_bacs("manual");
 109
 110     $self->{page}->header();
 111
 112     $self->input_box();
 113
 114     print "<br /><h3>Suggested Seedbacs for marker ".$self->get_marker()."</h3>";
 115
 116     print qq { <table cellspacing="10"> };
 117     print "<tr><td>BAC name</td><td>estimated length</td><td>contig name</td><td>contig size</td><td>top pick</td></tr>";
 118     foreach my $a_type ("overgo", "computational", "manual") {
 119         print qq { <tr><td colspan="4"><b>$a_type associations</b></td></tr> };
 120         if (!@{$bacs{$a_type}}) {
 121             print qq { <tr><td colspan="4">None found.</td></tr> };
 122         }
 123         foreach my $b (@{$bacs{$a_type}}) {
 124
 125             my ($bac_id, $bac, $len, $name, $contigs) = split /\t/, $b;
 126             my $toppick="<td>&nbsp;</td>";
 127             my $contig_id=0;
 128             if ($name =~ /ctg(\d+)/) { $contig_id = $1; }
 129
 130             if ($len>120000 && $contigs > 0) { $toppick="<td bgcolor=00FF00>&nbsp;</td>"; }
 131             print qq{ <tr><td><B><a href="/maps/physical/clone_info.pl?id=$bac_id">$bac</a></B></td><td>$len</td><td><a href="http://www.genome.arizona.edu//WebAGCoL/WebFPC/WebFPC_Direct_v2.1.cgi?name=tomato&contig=$contig_id">$name</a><td>$contigs</td>$toppick</tr> };
 132         }
 133     }
 134     print "</table>";
 135     $self->{page}->footer();
 136
 137 }
 138
 139 sub get_bacs {
 140
 141     my $self = shift;
 142     my $marker_name = $self->get_marker();
 143     my $association_type = shift;
 144
 145 #    my $physical = $self->{dbh}->qualify_schema('physical');
 146
 147 #    my $query = "SELECT cornell_clone_name, estimated_length, contig_name, number_of_contigs, number_of_markers FROM $physical.bac_marker_matches WHERE marker_name=? GROUP BY bac_id, cornell_clone_name, estimated_length, contig_name, number_of_contigs, number_of_markers ORDER BY estimated_length desc, number_of_contigs";
 148     my $query = "SELECT distinct bac_id, arizona_clone_name, estimated_length, contig_name, number_of_bacs, lg.lg_order, bmm.position, alias, marker_id  FROM physical.bac_marker_matches AS bmm inner join linkage_group as lg using(lg_id) WHERE alias ilike ? AND association_type=? ORDER BY lg.lg_order, bmm.position, alias, estimated_length desc, number_of_bacs desc, arizona_clone_name, contig_name desc";
 149
 150     my $sth = $self->{dbh}->prepare($query);
 151     $sth->execute($marker_name, $association_type);
 152
 153     my @bacs;
 154     while (my @line = $sth -> fetchrow_array()) {
 155
 156         my $line = join ("\t", @line);
 157
 158         push @bacs, $line;
 159      }
 160
 161      return @bacs;
 162 }
 163
 164 sub clean_up {
 165     my $self = shift;
 166 #    $self->{dbh}->disconnect();
 167 }
 168