cgi-bin/maps/physical/list_bacs_by_plate.pl

   1 ######################################################################
   2 #
   3 #  This is a script to list BACs from the database.  It will perform
   4 #  various types of BAC listing operations, depending on the calling
   5 #  paramaters.
   6 #
   7 ######################################################################
   8
   9 use strict;
  10 use CXGN::Page;
  11 use CXGN::DB::Physical;
  12 use CXGN::DB::Connection;
  13 use CXGN::Page::FormattingHelpers qw/page_title_html blue_section_html columnar_table_html/;
  14
  15 my $map_id = CXGN::DB::Physical::get_current_map_id();
  16 warn $map_id;
  17
  18 # Presets.
  19 my $link_pages = {'marker_page' => '/search/markers/markerinfo.pl?marker_id=',
  20                   'map_page' => '/cview/map.pl?map_id=',
  21                   'overgo_report_page' => '/maps/physical/overgo_stats.pl',
  22                   'agi_page' => 'http://www.genome.arizona.edu/fpc/tomato/',
  23                   'bac_page' => '/maps/physical/clone_info.pl?bac_id=',
  24                   'sgn_search_page' => '/search/direct_search.pl',
  25                   'list_bacs_by_plate' => '/maps/physical/list_bacs_by_plate.pl?by_plate=',
  26                   'plate_design_page' => '/maps/physical/list_overgo_plate_probes.pl?plate_no='};
  27 $$link_pages{'physical_map_page'} = $$link_pages{'map_page'} . '9&amp;physical=1';
  28 $$link_pages{'contig_page'} = $$link_pages{'agi_page'};
  29
  30 # Connect to the physical database.
  31 my $dbh = CXGN::DB::Connection->new('physical');
  32 our $page = CXGN::Page->new( "BAC List by Plate", "Robert Ahrens");
  33
  34 # Parse arguments.
  35 my %params = $page->get_all_encoded_arguments;
  36
  37 my $by_plate = $params{'by_plate'} || list_page($dbh, 0, $link_pages);
  38 print page_title_html("Plate $by_plate");
  39 my $overgo_version = $params{'overgo_version'} || 0;
  40 my $fpc_version = $params{'fpc_version'} || 0;
  41
  42 # Get version stuff from the db.
  43 $fpc_version ||= CXGN::DB::Physical::get_current_fpc_version($dbh);
  44 $overgo_version ||= CXGN::DB::Physical::get_current_overgo_version($dbh);
  45
  46 # Get max bacid and prepare the arrays.
  47 my $max_bacid_sth = $dbh->prepare("SELECT bac_id FROM bacs ORDER by bac_id DESC");
  48 $max_bacid_sth->execute();
  49 my $max_bacid = $max_bacid_sth->fetchrow_array;
  50 $max_bacid_sth->finish;
  51 my @bacs;
  52 my @contigs;
  53 for (my $i=0; $i<=$max_bacid; $i++) {
  54     $bacs[$i] = undef;
  55     $contigs[$i] = undef;
  56 }
  57
  58 # Get the FPC information.
  59 my $fpc_stm = "SELECT b.bac_id, bc.contig_name, bc.bac_contig_id FROM bacs AS b INNER JOIN bac_associations AS ba ON b.bac_id=ba.bac_id INNER JOIN bac_contigs AS bc ON ba.bac_contig_id=bc.bac_contig_id WHERE b.bad_clone!=1 AND bc.fpc_version=?";
  60 my $fpc_sth = $dbh->prepare($fpc_stm);
  61 $fpc_sth->execute($fpc_version);
  62 while (my ($bac_id, $contig, $ctg_id) = $fpc_sth->fetchrow_array) {
  63     $contigs[$bac_id] = $contig;
  64 }
  65
  66 # Get that BAC list plus overgo information.
  67 my $sgn = $dbh->qualify_schema('sgn');
  68 my $overgo_stm = "SELECT b.cornell_clone_name, b.arizona_clone_name, b.bac_id, ma.alias, ma.marker_id FROM bacs AS b INNER JOIN overgo_associations AS oa ON b.bac_id=oa.bac_id INNER JOIN oa_plausibility AS oap USING(overgo_assoc_id) INNER JOIN probe_markers AS pm ON oa.overgo_probe_id=pm.overgo_probe_id INNER JOIN overgo_plates AS op ON pm.overgo_plate_id=op.plate_id INNER JOIN $sgn.marker_alias AS ma ON pm.marker_id=ma.marker_id WHERE b.bad_clone!=1 AND oap.plausible=1 AND oa.overgo_version=? AND op.plate_number=? AND oap.map_id=? AND ma.preferred=true";
  69 my $overgo_sth = $dbh->prepare($overgo_stm);
  70 $overgo_sth->execute($overgo_version, $by_plate, $map_id);
  71 my $baccount=0;
  72 while (my ($clone, $az_name, $bacid, $probe, $mrkr_dbid) = $overgo_sth->fetchrow_array) {
  73     $baccount ++;
  74     $bacs[$bacid] = [ qq|<a href="$$link_pages{bac_page}$bacid">$clone</a>|,
  75                       $az_name,
  76                       qq|<a href="$$link_pages{marker_page}$mrkr_dbid">$probe</a>|,
  77                       $contigs[$bacid]
  78                     ];
  79 }
  80
  81 # Print the list of viable plates if this plate is not one of them.
  82 $baccount || list_page($dbh, $by_plate, $link_pages);
  83
  84 # Print the page.
  85 $page->header("BAC list for plate $by_plate");
  86 print page_title_html(qq|BAC list for <a href="$$link_pages{plate_design_page}$by_plate">plate $by_plate</a> ($baccount BACs)|);
  87
  88 my @headings = ('BAC','AGI Clone name','Probe matches','FPC Contigs');
  89
  90 my @rows = grep {$_} @bacs;
  91
  92 print blue_section_html('BAC list',
  93                         columnar_table_html(headings => \@headings,
  94                                             data => \@rows,
  95                                             __alt_freq => 3,
  96                                             __border => 1,
  97                                            )
  98                         . plate_link_list($dbh, $by_plate, $link_pages)
  99                        );
 100
 101
 102 # Links.
 103 print_links($link_pages, 0, $by_plate);
 104 $page->footer;
 105
 106
 107
 108 ######################################################################
 109 #
 110 #  Subroutines
 111 #
 112 ######################################################################
 113
 114 sub list_page {
 115
 116     my ($dbh, $by_plate, $link_pages) = @_;
 117     my $title = "Overgo plate BAC list";
 118     our $page = CXGN::Page->new( $title, "Robert Ahrens");
 119     $page->header;
 120     print page_title_html($title);
 121     if ($by_plate) {
 122         print "No data for plate $by_plate are currently loaded in the SGN database.\n";
 123     }
 124     print_full_plate_list($dbh, $by_plate, $link_pages);
 125     print_links($link_pages, 4);
 126     $page->footer;
 127     exit;
 128
 129 }
 130
 131
 132 sub plate_link_list {
 133
 134     my ($dbh, $by_plate, $link_pages, $overgo_version) = @_;
 135
 136     # Get the data.
 137     my $stm = "SELECT DISTINCT op.plate_number FROM overgo_plates AS op INNER JOIN probe_markers AS pm ON op.plate_id=pm.overgo_plate_id INNER JOIN overgo_associations AS oa ON pm.overgo_probe_id=oa.overgo_probe_id " . ($overgo_version ? " WHERE oa.overgo_version=$overgo_version " : "") . "ORDER  BY op.plate_number";
 138     my $sth = $dbh->prepare($stm);
 139     $sth->execute();
 140     # Print the section.
 141     my $html = qq|<div style="text-align: center; font-size: 120%; margin-bottom: 2em;">\n Go to plate: |.
 142       join('&nbsp;&nbsp;',
 143            map {
 144              my $pn = $_->[0];
 145              $pn == $by_plate ? "<b>$pn</b>"
 146                : qq|<a href="$$link_pages{list_bacs_by_plate}$pn">$pn</a>|;
 147            } @{$sth->fetchall_arrayref}
 148           )
 149         ."</div>\n"
 150           .qq|<span class="tinytype">Please note that this list contains only those BACs which have a <i>clean and unambiguous</i> match to a probe on plate $by_plate.  A complete list of BACs in this project would run into hundreds or thousands and is not available on SGN at this time.  However, downloadable data from this project will be forthcoming to our ftp site shortly.</span>|;
 151
 152     $sth->finish;
 153
 154     return $html;
 155 }
 156
 157
 158 sub print_full_plate_list {
 159
 160     my ($dbh, $by_plate, $link_pages, $overgo_version) = @_;
 161     # Get the data.
 162     my $stm = "SELECT DISTINCT op.plate_number FROM overgo_plates AS op INNER JOIN probe_markers AS pm ON op.plate_id=pm.overgo_plate_id INNER JOIN overgo_associations AS oa ON pm.overgo_probe_id=oa.overgo_probe_id " . ($overgo_version ? " WHERE oa.overgo_version=$overgo_version " : "") . "ORDER BY op.plate_number";
 163     my $sth = $dbh->prepare($stm);
 164     $sth->execute();
 165
 166     # Print the section.
 167     print blue_section_html('BACs listed by overgo plate',qq|<center>\n|.
 168                             do {
 169                               my @rows;
 170                               while (my ($pn) = $sth->fetchrow_array) {
 171                                 my $bac_count = CXGN::DB::Physical::count_all_bacs_which_hit_plate_n($dbh, $pn, $overgo_version, $map_id);
 172                                 push @rows, [qq|<a href="$$link_pages{plate_design_page}$pn"><b>$pn</b></a>|,
 173                                              qq|<a href="$$link_pages{list_bacs_by_plate}$pn">$bac_count BACs</a>|,
 174                                             ];
 175                               }
 176                               columnar_table_html(headings => ['Plate','# BACs'],
 177                                                   data => \@rows,
 178                                                   __border => 1,
 179                                                   __tableattrs => 'width="60%" cellspacing="0" summary=""',
 180                                                  );
 181                             }
 182                             .qq|</center>\n|
 183                            );
 184     $sth->finish;
 185 }
 186
 187
 188 sub print_links {
 189
 190     my ($link_pages, $colspan, $plate_no) = @_;
 191     my $pnlink = $plate_no ? qq|<li><a href="$$link_pages{plate_design_page}$plate_no">Show Overgo Probes on plate $plate_no</a></li>| : '';
 192     print blue_section_html('Related Pages',<<EOH);
 193 <ul>
 194 $pnlink
 195 <li><a href="$$link_pages{overgo_report_page}">Report on the Overgo Plating process</a></li>
 196 <li><a href="$$link_pages{physical_map_page}">Tomato Physical Map on SGN</a></li>
 197 <li><a href="$$link_pages{agi_page}">Web FPC pages at the Arizona Genomics Institute</a></li>
 198 <li><a href="$$link_pages{sgn_search_page}">Search SGN</a></li>
 199 </ul>
 200 EOH
 201
 202 }