cgi-bin/maps/physical/clone_info.pl

   1 use strict;
   2 use warnings;
   3
   4 use POSIX;
   5 use List::Util qw/sum/;
   6
   7 use Carp;
   8
   9 use Bio::Range;
  10 use Bio::Graphics::Gel;
  11
  12 use CXGN::Apache::Error;
  13
  14 use CXGN::TomatoGenome::BACSubmission;
  15 use CXGN::DB::Connection;
  16 use CXGN::DB::Physical;
  17 use CXGN::DB::DBICFactory;
  18
  19 use CXGN::Fish;    # helper routines for FISH data.
  20
  21 use CXGN::Genomic::Search::Clone;
  22 use CXGN::Login;
  23 use CXGN::Map;
  24 use CXGN::Marker;
  25 use CXGN::Page;
  26
  27 use CXGN::Page::FormattingHelpers qw/ page_title_html
  28   info_section_html
  29   info_table_html
  30   columnar_table_html
  31   commify_number
  32   simple_selectbox_html
  33   truncate_string
  34   tooltipped_text
  35   /;
  36 use CXGN::People;
  37 use CXGN::People::BACStatusLog;
  38 use CXGN::People::PageComment;
  39 use CXGN::People::Person;
  40 use CXGN::Search::CannedForms;
  41 use CXGN::TomatoGenome::BACPublish;
  42 use CXGN::Tools::Identifiers qw/link_identifier/;
  43 use CXGN::Tools::List qw/all distinct any min max str_in/;
  44 use CXGN::Tools::Text;
  45
  46 use CatalystX::GlobalContext '$c';
  47
  48 # some of the newer parts of the page are in a controller object
  49 my $self = $c->controller('Clone::Genomic');
  50
  51 our %link_pages = (
  52     marker_page        => '/search/markers/markerinfo.pl?marker_id=',
  53     map_page           => '/cview/map.pl?map_id=',
  54     overgo_report_page => '/maps/physical/overgo_stats.pl',
  55     agi_page           => 'http://www.genome.arizona.edu/fpc/tomato/',
  56     bac_page           => '/maps/physical/clone_info.pl?id=',
  57     sgn_search_page    => '/search/direct_search.pl',
  58     plate_design_page => '/maps/physical/list_overgo_plate_probes.pl?plate_no=',
  59     list_bacs_by_plate => '/maps/physical/list_bacs_by_plate.pl?by_plate=',
  60     mapviewer          => '/cview/view_chromosome.pl?show_physical=1&map_id=',
  61     overgo_explanation => '/maps/physical/overgo_process_explained.pl',
  62     read_info_page     => '/maps/physical/clone_read_info.pl'
  63 );
  64 $link_pages{physical_map_page} = $link_pages{'map_page'} . '1&physical=1';
  65 $link_pages{contig_page}       = $link_pages{'agi_page'};
  66
  67 # Start a new SGN page.
  68 my $page  = CXGN::Page->new( 'BAC Data', 'Rob Buels' );
  69 my $dbh   = CXGN::DB::Connection->new();
  70 my $chado = CXGN::DB::DBICFactory->open_schema('Bio::Chado::Schema');
  71
  72 $page->jsan_use(qw/ MochiKit.Base MochiKit.Async /);
  73
  74 # Get arguments from Apache.
  75 my %params = $page->get_all_encoded_arguments;
  76
  77 #### bac status stuff ####
  78 #if someone is logged in, get their information so they can have the option of updating the status of this bac
  79 our ( $person, $person_id, $fname, $lname, $username, $user_type ) =
  80   ( '', '', '', '', '', '' );
  81 my @person_projects;
  82 $person_id = CXGN::Login->new($dbh)->has_session();
  83 if ($person_id) {
  84     $person = CXGN::People::Person->new( $dbh, $person_id );
  85     if ($person) {
  86         $person_id       = $person->get_sp_person_id();
  87         $fname           = $person->get_first_name() || '';
  88         $lname           = $person->get_last_name() || '';
  89         $username        = "$fname $lname";
  90         $user_type       = $person->get_user_type();
  91         @person_projects = $person->get_projects_associated_with_person;
  92     }
  93 }
  94
  95 ## get the clone in question ###
  96 #support legacy identifiers, but complain
  97 my $clone;
  98 my $clonequery = CXGN::Genomic::Search::Clone->new->new_query;
  99 $clonequery->from_request( \%params );
 100
 101 #is a random clone wanted?
 102 if ( $params{random} and $params{random} eq 'yes' ) {
 103     ( $params{id} ) = $dbh->selectrow_array(<<EOSQL);
 104 select clone_id from genomic.clone
 105 where bad_clone is null or bad_clone='0'
 106 order by random()
 107 limit 1
 108 EOSQL
 109 }
 110
 111 if ( $params{id} ) {
 112     $clone = CXGN::Genomic::Clone->retrieve(
 113         $params{id} + 0 )    #the +0 makes sure it's numeric
 114       or clone_not_found_page( $page,
 115         "No clone with id $params{id} could be found.", $clonequery );
 116
 117 }
 118 elsif ( $params{bac_id} ) {
 119
 120     $clone = CXGN::Genomic::Clone->retrieve( $params{bac_id} + 0 )
 121       or clone_not_found_page( $page,
 122         "No clone with id $params{bac_id} could be found.", $clonequery );
 123
 124 }
 125 elsif ( $params{cu_name} || $params{az_name} ) {
 126     my $search         = CXGN::Genomic::Search::Clone->new;
 127     my $query          = $search->new_query;
 128     my $clonename      = $params{cu_name} || $params{az_name};
 129     my $orig_clonename = $clonename;
 130     $clonename =~ s/^P(\d{3})(\D{1})(\d{2})/LE_HBa0$1$2$3/;
 131     $query->clone_name("='$clonename'");
 132     my $result = $search->do_search($query);
 133     $result->total_results > 1
 134       and $page->error_page(
 135         "SGN bug: multiple clones with clone name $orig_clonename were found.");
 136
 137 #clone_not_found_page($page, "Multiple clones with clone name $orig_clonename (a.k.a. $clonename) were found.  That's an internal bug.", $link_pages, \%params,$clonequery);
 138     $result->total_results < 1
 139       and clone_not_found_page( $page,
 140         "No clones with clone name $orig_clonename were found.", $clonequery );
 141
 142     $clone = $result->next_result;
 143 }
 144
 145 # make sure we have a clone at this point
 146 unless ( $clone && $clone->clone_id ) {
 147     clone_not_found_page( $page,
 148         "No clones found matching the search criteria.", $clonequery );
 149 }
 150
 151 my $clone_id = $clone->clone_id;
 152
 153 ####################################
 154 # OUTPUT THE PAGE
 155 ####################################
 156
 157 my $head_extra = <<EOEXTRA;
 158 <style type="text/css">
 159 <!--
 160 FORM.changebutton {
 161    display: inline;
 162 }
 163
 164 /*FORM.changebutton BUTTON[type="submit"] {
 165   padding-left: 2px;
 166   padding-right: 2px;
 167   line-height: 1.3;
 168   background-color: #fff;
 169   color: #009;
 170   border: none;
 171   margin: none;
 172 }*/
 173
 174 FORM.changebutton BUTTON {
 175   margin: 0;
 176   padding: 0;
 177   background-color: #fff;
 178   color: #009;
 179   border: 1px solid #fff;
 180   font-size: 10px;
 181 }
 182
 183 FORM.changebutton BUTTON:hover {
 184   border: 1px solid #444;
 185 }
 186
 187
 188 SPAN.bgcolorstatus1 FORM.changebutton BUTTON,
 189 SPAN.bgcolorstatus1 SPAN.colorme {
 190    background-color: #ddd;
 191    color: #000;
 192    border: 1px solid #444;
 193 }
 194
 195 SPAN.bgcolorstatus2 FORM.changebutton BUTTON,
 196 SPAN.bgcolorstatus2 SPAN.colorme {
 197    background-color: #ffff66;
 198    color: #000;
 199    border: 1px solid #444;
 200 }
 201 SPAN.bgcolorstatus3 FORM.changebutton BUTTON,
 202 SPAN.bgcolorstatus3 SPAN.colorme {
 203         background-color: #66ff66;
 204    color: #000;
 205    border: 1px solid #444;
 206 }
 207 SPAN.bgcolorstatus4 FORM.changebutton BUTTON,
 208 SPAN.bgcolorstatus4 SPAN.colorme {
 209         background-color: #9999ff;
 210    color: #000;
 211    border: 1px solid #444;
 212 }
 213 SPAN.colorme {
 214    white-space: nowrap;
 215 }
 216 -->
 217 </style>
 218 EOEXTRA
 219
 220 my $az_name = $clone->clone_name;
 221 $page->header( "Clone $az_name", undef, $head_extra );
 222 print page_title_html("Clone $az_name");
 223
 224 print info_section_html(
 225     title       => 'Clone &amp; library',
 226     collapsible => 1,
 227     contents    => '<table style="margin: 0 auto"><tr><td>'
 228       . $c->render_mason( '/genomic/clone/clone_summary.mas', clone => $clone )
 229       . '</td><td>'
 230       . $c->render_mason(
 231         '/genomic/library/library_summary.mas',
 232         library => $clone->library_object
 233       )
 234       . info_table_html(
 235         __title => 'Ordering Information',
 236         'BAC Clones' =>
 237 'BAC clones can be ordered from the <a href="http://ted.bti.cornell.edu/cgi-bin/TFGD/order/order.cgi?item=clone">clone ordering page at TFGD</a>',
 238         __tableattrs => 'width="100%" height="100%"',
 239       )
 240       . '</td></tr></table>'
 241 );
 242
 243 my $overgo_html = render_overgo( $clone, $dbh );
 244
 245 #get data on our computational associations with markers
 246 my $computational_associations_html =
 247   render_computational_associations( $clone, $dbh );
 248
 249 #get data on manual associations
 250 my $manual_associations_html = do {
 251     my $mas = $dbh->selectall_arrayref( <<EOSQL, undef, $clone->clone_id );
 252 select marker_id,pubmed_id,sp_person_id,comment, first_name, last_name, organization
 253 from physical.manual_associations
 254 join sgn_people.sp_person using(sp_person_id)
 255 where clone_id = ?
 256 EOSQL
 257
 258     if ( $mas and @$mas ) {
 259         join '', map "$_\n", map {
 260             my ( $marker_id, $pubmed_id, $sp_person_id, $comment_text, $fname,
 261                 $lname, $org )
 262               = @$_;
 263             my $marker = CXGN::Marker->new( $dbh, $marker_id );
 264             '<div style="border: 1px solid #bbb">' . info_table_html(
 265                 Marker => qq|<a href="$link_pages{marker_page}$marker_id">|
 266                   . $marker->name_that_marker . '</a>',
 267                 Publication => (
 268                     $pubmed_id
 269                     ? qq|<a href="http://www.ncbi.nlm.nih.gov/pubmed/$pubmed_id">PubMed $pubmed_id</a>|
 270                     : '<span class="ghosted">unpublished</span>'
 271                 ),
 272
 273                 'Submitted by' => "$fname $lname " . ( $org ? "($org)" : '' ),
 274                 __multicol     => 3,
 275                 __border       => 0,
 276               )
 277               . info_table_html(
 278                 Comment => $comment_text || '<span class="ghosted">none</span>',
 279                 __border => 0,
 280               )
 281               . '</div>'
 282         } @$mas;
 283     }
 284     else {
 285         '';
 286     }
 287 };
 288
 289 my $physical_map_link = do {
 290     if (   $overgo_html
 291         || $computational_associations_html
 292         || $manual_associations_html )
 293     {
 294         my $chr = $clone->chromosome_num;
 295         my $url =
 296             "/cview/view_chromosome.pl?map_id=p9&hilite="
 297           . $clone->clone_name
 298           . "&chr_nr=$chr";
 299         qq|<a href="$url">View on physical map chromosome $chr</a>|;
 300     }
 301     else {
 302         '';
 303     }
 304 };
 305
 306 my $fish_link = do {
 307     my $on_fish_map =
 308       $dbh->selectall_arrayref( <<EOQ, undef, $clone->clone_id );
 309 select map_id, chromo_num
 310 from sgn.fish_result
 311 where clone_id = ?
 312 EOQ
 313     if ( $on_fish_map && @$on_fish_map ) {
 314         my $url =
 315             "/cview/view_chromosome.pl?map_id=$on_fish_map->[0][0]&hilite="
 316           . $clone->clone_name
 317           . "&chr_nr=$on_fish_map->[0][1]";
 318         qq|<a href="$url">View on FISH map chromosome $on_fish_map->[0][1]</a>|;
 319     }
 320 };
 321
 322 my $reg_info = $clone->reg_info_hashref;
 323
 324 #output physical mapping stuff
 325 if ( $self->_is_tomato($clone) ) {
 326     print info_section_html(
 327         title       => 'Physical mapping',
 328         collapsible => 1,
 329         contents    => info_section_html(
 330             title         => 'Fingerprint Contig Builds (FPC)',
 331             is_subsection => 1,
 332             contents      => join "\n",
 333             '<dl class="fpc_results">',
 334             (
 335                 sort {
 336                     my ( $ad, $bd ) = map m|(20\d\d).+</dt>|, $a, $b;
 337                     $bd <=> $ad
 338                   }    #< sort by date in the FPC desc
 339                   (
 340                     map
 341                     { #< do a search and render links for each gbrowse FPC data source
 342                         my $ds = $_;
 343                         my @x  = $ds->xrefs(
 344                             { -attributes => { Name => $clone->clone_name } } );
 345                         my $ext_desc = ( $ds->extended_description
 346                               || 'no extended description' );
 347
 348                         if (@x) {
 349                             map {
 350                                 join '',
 351                                   (
 352                                     '<dt><a href="', $_->url,
 353                                     '">',            $ds->description,
 354                                     '</a></dt> ',    '<dd>',
 355                                     $ext_desc,       '</dd>',
 356                                   )
 357                             } @x;
 358                         }
 359                         else {
 360                             '<dt class="ghosted">not present in '
 361                               . $ds->description
 362                               . '</dt><dd class="ghosted">'
 363                               . $ext_desc . '</dd>';
 364                         }
 365                       }
 366                       grep $_->description =~
 367                       /FPC/i,    #< select list of GBrowse FPC data sources
 368                     map $_->data_sources,
 369                     $c->enabled_feature('gbrowse2')
 370                   ),
 371                 render_old_arizona_fpc( $dbh, $clone ),
 372             ),
 373             '</dl>',
 374           )
 375           . info_section_html(
 376             title =>
 377 qq|Marker matches - overgo <a class="context_help" href="/maps/physical/overgo_process_explained.pl">what's this?</a>|,
 378             contents      => $overgo_html,
 379             is_subsection => 1,
 380           )
 381           . info_section_html(
 382             title         => qq|Marker matches - BLAST|,
 383             contents      => $computational_associations_html,
 384             is_subsection => 1,
 385           )
 386           . info_section_html(
 387             title         => qq|Marker matches - manual|,
 388             contents      => $manual_associations_html,
 389             is_subsection => 1,
 390           )
 391           . info_section_html(
 392             title         => qq|Physical map (from marker matches)|,
 393             contents      => $physical_map_link,
 394             empty_message => 'Not on Physical Map',
 395             is_subsection => 1,
 396           )
 397           . info_section_html(
 398             title         => "FISH map",
 399             contents      => $fish_link,
 400             is_subsection => 1,
 401             empty_message => 'Not on FISH map',
 402           )
 403           . info_section_html(
 404             title    => "FISH images",
 405             contents => CXGN::Fish::fish_image_html_table(
 406                 CXGN::DB::Connection->new,
 407                 $clone->clone_id
 408             ),
 409             is_subsection => 1,
 410           )
 411           . info_section_html(
 412             title    => "IL Mapping",
 413             subtitle => do {
 414                 if ( str_in( $user_type, qw/sequencer curator/ ) ) {
 415                     my $qstr = do {
 416                         my $q = CXGN::Genomic::Search::Clone->new->new_query;
 417                         $q->clone_id( '=?', $clone_id );
 418                         $q->to_query_string;
 419                     };
 420 qq|<a style="font-weight: bold" href="clone_reg.pl?$qstr">Edit IL mapping info</a>|;
 421                 }
 422                 else {
 423                     undef;
 424                 }
 425             },
 426             is_empty =>
 427               !any( map $_->{val}, @{$reg_info}{qw/il_proj il_chr il_bin/} ),
 428             contents => info_table_html(
 429                 __multicol => 3,
 430                 __border   => 0,
 431                 'Assigned to project' =>
 432 qq|<span id="clone_il_mapping_project">$reg_info->{il_proj}{disp}</span>|,
 433                 'IL-mapped to chromosome' =>
 434 qq|<span id="clone_il_mapping_chr">$reg_info->{il_chr}{disp}</span>|,
 435                 'IL-mapped to IL segment' =>
 436 qq|<span id="clone_il_mapping_line">$reg_info->{il_bin}{disp}</span>|,
 437               )
 438               . info_table_html(
 439                 __border => 0,
 440                 'IL mapping notes' =>
 441 qq|<span id="clone_il_mapping_notes">$reg_info->{il_notes}{disp}</span>|,
 442               ),
 443             is_subsection => 1,
 444           )
 445
 446     );
 447 }
 448 else {
 449     print info_section_html(
 450         title         => 'Physical mapping',
 451         collapsible   => 1,
 452         contents      => '',
 453         empty_message => 'not available',
 454     );
 455 }
 456
 457 #output sequencing status
 458 print info_section_html(
 459     title       => 'Sequencing',
 460     collapsible => 1,
 461     contents => sequencing_content( $self, $c, $clone, $person, $dbh, $chado ),
 462 );
 463
 464 # compute content for prelim. annot section
 465 my $latest_seq = $clone->latest_sequence_name;
 466
 467 print info_section_html(
 468     title       => 'Sequence Annotations',
 469     collapsible => 1,
 470     contents    => info_table_html(
 471         __border => 0,
 472         Browse   => join(
 473             "<br />\n",
 474             map '<a href="' . $_->url . '">' . $_->text . '</a>',
 475             map {
 476                 my $gb = $_;
 477                 $gb->xrefs($latest_seq), $gb->xrefs( $clone->clone_name )
 478               } $c->enabled_feature('gbrowse2')
 479           )
 480           || '<span class="ghosted">'
 481           . $clone->clone_name
 482           . ' has no browsable sequence annotations</span>',
 483         Download => (
 484             $self->_is_tomato($clone)
 485             ? render_tomato_bac_annot_download( $c, $clone )
 486             : '<span class="ghosted">not available</span>'
 487         ),
 488     ),
 489 );
 490
 491 #print field for page comments
 492 print CXGN::People::PageComment->new( $dbh, "BAC", $clone->clone_id )
 493   ->get_html();
 494
 495 # Search again.
 496 print info_section_html(
 497     title       => 'Search again',
 498     collapsible => 1,
 499     contents =>
 500       CXGN::Search::CannedForms::clone_search_form( $page, $clonequery ),
 501 );
 502
 503 $page->footer;
 504
 505 ######################################################################
 506 #
 507 #  Subroutines
 508 #
 509 ######################################################################
 510
 511 #compare an in-vitro and in-silico restriction fragment set
 512 #against eachother, rate how well they match up on a scale of 0 to 1
 513 sub frag_match_score {
 514     my @a = @{ shift() };
 515     my @b = @{ shift() };
 516
 517     my @max_hs = map {
 518         my $b = $_ || 1;
 519         max map {
 520             my $a = $_ || 1;
 521             min( $a / $b, $b / $a );
 522         } @a;
 523     } @b;
 524
 525     #print join(',',@max_hs),"\n";
 526     return sum(@max_hs) / max( scalar(@a), scalar(@b) );
 527 }
 528
 529 sub clone_not_found_page {
 530
 531     my ( $page, $message, $query ) = @_;
 532     $page->header('Clone not found.');
 533
 534     # No BAC found.
 535     print page_title_html('CLONE NOT FOUND');
 536
 537     print qq|<h2>$message</h2>\n|;
 538
 539     print info_section_html(
 540         title => 'Search again',
 541         contents =>
 542           CXGN::Search::CannedForms::clone_search_form( $page, $query ),
 543     );
 544
 545     # Finish.
 546     $page->footer;
 547     exit;
 548 }
 549
 550 sub sequencing_content {
 551     my ( $self, $c, $clone, $person, $dbh, $chado ) = @_;
 552     my $clone_id = $clone->clone_id;
 553
 554     my $bac_status_log = CXGN::People::BACStatusLog->new($dbh);
 555
 556     #get bac status
 557     my $sequencing_content = '';
 558
 559     #print STDERR "user type '$user_type'\n";
 560     my $welcome_message_html = do {
 561         if ( $person
 562             && str_in( $person->get_user_type, qw/sequencer curator/ ) )
 563         {
 564             "Welcome, <b>"
 565               . $person->get_first_name . ' '
 566               . $person->get_last_name
 567               . "</b>. You are logged in as a $user_type.\n";
 568         }
 569       }
 570       || '';
 571
 572     my $sequencing_status_html = do {
 573         my ( $status, ) = $bac_status_log->get_status( $clone->clone_id );
 574         $status;
 575     };
 576
 577     my $chr = $clone->chromosome_num;
 578
 579     my $sequencing_project_html =
 580       sequencing_project_html( $user_type, $chr, $clone );
 581
 582     my $latest_seq = $clone->latest_sequence_name;
 583     my $seqlen     = $clone->seqlen;
 584     my $is_finished =
 585       $latest_seq && !( $latest_seq =~ /-\d+$/ ) && $clone->seq !~ /N/;
 586     my %sequencing_files =
 587       $self->_is_tomato($clone)
 588       ? CXGN::TomatoGenome::BACPublish::sequencing_files( $clone,
 589         $c->config->{'ftpsite_root'} )
 590       : $self->_potato_seq_files( $c, $clone );
 591
 592     #make info on the full sequence of this clone
 593     my $sequence_info = do {
 594         if ($latest_seq) {
 595             my $tot_len  = commify_number($seqlen);
 596             my $dl_links = '';
 597
 598             if ( $sequencing_files{seq} ) {
 599                 $dl_links .= <<EOHTML
 600     <a href="clone_annot_download.pl?id=$clone_id&amp;annot_set=all&amp;annot_format=seq">[Download fasta]</a><br />
 601 EOHTML
 602
 603             }
 604             if ( $sequencing_files{tar} ) {
 605                 my $tarsize =
 606                   sprintf( "%0.2f", ( -s $sequencing_files{tar} ) / 1_000_000 );
 607                 $dl_links .= <<EOHTML
 608     <a href="clone_annot_download.pl?id=$clone_id&amp;annot_set=all&amp;annot_format=tar">[Download full submission]</a> ($tarsize MB)
 609 EOHTML
 610
 611             }
 612
 613             my $gb = $clone->genbank_accession($chado);
 614             $gb =
 615               $gb
 616               ? ( link_identifier( $gb, 'genbank_accession' ) || $gb )
 617               . ' (GenBank)'
 618               : '';
 619             <<EOHTML
 620 <table width="100%"><tr>
 621 <td>
 622   $tot_len bp <br />
 623   $latest_seq <br/>
 624   $gb
 625 </td>
 626 <td><a href="/maps/physical/clone_sequence.pl?clone_id=$clone_id">[View]</a><br />
 627 $dl_links
 628 </td>
 629 </tr></table>
 630 EOHTML
 631         }
 632         else {
 633             qq|<span class="ghosted">Sequence not available.</span>|;
 634         }
 635     };
 636
 637     #make an ftp site link
 638     my $ftp_link = $self->_ftp_seq_repos_link( $c, $clone );
 639
 640     #make displays of the in-vitro restriction fragments we have in our
 641     #records, versus the predicted in-silico fragments.  also, set a flag
 642     #if any of them have low match scores
 643     my $low_restriction_match_score = 0;      #< flag
 644     my $restriction_match_threshold = 0.70;
 645     my $restriction_frags_html      = do {
 646         my @iv_frags = $clone->in_vitro_restriction_fragment_sizes();
 647
 648         join '', map {
 649             my $fingerprint_id = shift @$_;
 650             my $enzyme         = shift @$_;
 651             my $iv_frags       = $_;
 652             my $gel_img =
 653 qq|<img border="1" style="margin-right: 1em" src="clone_restriction_gel_image.pl?id=$clone_id&amp;enzyme=$enzyme&amp;fp_id=$fingerprint_id" />|;
 654             if ( my $is_frags =
 655                 $clone->in_silico_restriction_fragment_sizes($enzyme) )
 656             {
 657                 $is_frags = [ grep { $_ > 1000 } @$is_frags ];
 658                 my $match_score =
 659                   ( frag_match_score( $is_frags, $iv_frags ) +
 660                       frag_match_score( $iv_frags, $is_frags ) ) / 2;
 661                 $low_restriction_match_score = 1
 662                   if $match_score < $restriction_match_threshold;
 663                 my $frag_listing = info_table_html(
 664                     __sub    => 1,
 665                     __border => 0,
 666                     "$enzyme <i>in vitro</i> ("
 667                       . scalar(@$iv_frags)
 668                       . ')' => join( ', ', @$iv_frags ),
 669                     "$enzyme <i>in silico</i> ("
 670                       . scalar(@$is_frags)
 671                       . ')' => join( ', ', @$is_frags ),
 672
 673                     #__tableattrs => 'style="margin-top: 30px"',
 674                     "Fragment Lengths Match Score" =>
 675                       sprintf( "%.2f", $match_score ),
 676                 );
 677                 info_table_html(
 678                     __border                => 0,
 679                     'Restriction Fragments' => <<EOHTML,
 680 <table><tr><td>$gel_img</td><td valign="middle">$frag_listing</td></tr></table>
 681 EOHTML
 682                 );
 683             }
 684             else {
 685                 my $frag_listing = info_table_html(
 686                     __sub    => 1,
 687                     __border => 0,
 688                     "$enzyme <i>in vitro</i> ("
 689                       . scalar(@$iv_frags)
 690                       . ')' => join( ', ', @$iv_frags ),
 691                 );
 692                 info_table_html(
 693                     __border                => 0,
 694                     'Restriction Fragments' => <<EOHTML,
 695 <table><tr><td>$gel_img</td><td valign="middle">$frag_listing</td></tr></table>
 696
 697 EOHTML
 698                 );
 699             }
 700         } @iv_frags;
 701     };
 702
 703     ### if this clone has a sequence, check it for various kinds of
 704     ### badness
 705     my $warnings_html = do {
 706         if ($latest_seq) {
 707             my @warnings;
 708             unless ($is_finished) {
 709                 push @warnings, 'sequence is not finished to HTGS3';
 710             }
 711
 712             my $feature_query = $dbh->prepare(<<EOQ);
 713 select fl.fmin, fl.fmax, f1.name
 714 from clone_feature
 715 join feature f2 using(feature_id)
 716 join featureloc fl on f2.feature_id=srcfeature_id
 717 join feature f1 on fl.feature_id=f1.feature_id
 718 join feature_dbxref fd on fl.feature_id=fd.feature_id
 719 where fd.dbxref_id=(select dbxref_id from dbxref where accession=?)
 720   and clone_id = ?
 721 EOQ
 722
 723             #given a list of 2-element arrayrefs which are ranges,
 724             #find the sum number of bases they cover, *not counting overlaps*
 725             sub sum_ranges {
 726                 sum
 727                   map {    #warn "got range ".$_->start.", ".$_->end."\n";
 728                     $_->length()
 729                   } Bio::Range->disconnected_ranges(
 730                     map {
 731                         Bio::Range->new( -start => $_->[0], -end => $_->[1] )
 732                       } @_
 733                   );
 734             }
 735
 736             #check for too much vector in the sequence
 737             $feature_query->execute( 'Cross_match_vector', $clone->clone_id );
 738             my $matches = $feature_query->fetchall_arrayref;
 739             if ( $matches && @$matches ) {
 740                 if ( sum_ranges(@$matches) / $seqlen > 0.1 ) {
 741                     push @warnings,
 742                       "more than 10% of sequence matches cloning vector";
 743                 }
 744                 if ($is_finished) {
 745                     my $seq_middle = Bio::Range->new(
 746                         -start => int( 0.1 * $seqlen ),
 747                         -end   => int( 0.9 * $seqlen )
 748                     );
 749
 750       #convert the vector matches to ranges so we can work with them more easily
 751                     my @vector_ranges = map {
 752                         Bio::Range->new(
 753                             -start => $_->[0] + 1,
 754                             -end   => $_->[1]
 755                           )
 756                     } @$matches;
 757                     if ( any( map { $_->overlaps($seq_middle) } @vector_ranges )
 758                       )
 759                     {
 760                         push @warnings,
 761                           "vector found in middle 80% of sequence";
 762                     }
 763                 }
 764             }
 765
 766             #check for E.coli blast hits in the sequence
 767             $feature_query->execute( 'BLAST_E_coli_K12', $clone->clone_id );
 768             $matches = $feature_query->fetchall_arrayref;
 769             if ( $matches && @$matches ) {
 770                 push @warnings,
 771                   "full sequence contains matches to E. coli K12 genome";
 772             }
 773
 774             #check for tomato chloroplast hits
 775             $feature_query->execute( 'BLAST_tomato_chloroplast',
 776                 $clone->clone_id );
 777             $matches = $feature_query->fetchall_arrayref;
 778             if ( $matches && @$matches ) {
 779                 push @warnings,
 780                   "full sequence contains matches to Tomato chloroplast genome";
 781             }
 782
 783             #check for hits to other bacs
 784             $feature_query->execute( 'BLAST_tomato_bacs', $clone->clone_id );
 785             $matches = $feature_query->fetchall_arrayref;
 786             $matches = [
 787                 grep {
 788                     index( $_->[2], $clone->clone_name_with_chromosome ) != 0
 789                   } @$matches
 790             ];
 791             if (   $matches
 792                 && @$matches
 793                 && sum_ranges(@$matches) / $seqlen > 0.2 )
 794             {
 795                 push @warnings,
 796 "more than 20% of full sequence matches other tomato genomic clones";
 797             }
 798
 799             #check for the low restriction match score flag
 800             if ($low_restriction_match_score) {
 801                 push @warnings,
 802 "poor correspondence with <i>in vitro</i> restriction fragments<br/>(match score below $restriction_match_threshold)";
 803             }
 804
 805             #check this sequence's length vs. estimated length
 806             if (
 807                 $clone->estimated_length
 808                 and ( my $pdiff =
 809                     abs( $seqlen - $clone->estimated_length ) /
 810                     $clone->estimated_length ) > 0.4
 811               )
 812             {
 813                 push @warnings,
 814                   sprintf(
 815 "sequence length %s is %0.1f%% different from estimated length %s",
 816                     commify_number($seqlen),
 817                     $pdiff * 100,
 818                     commify_number( $clone->estimated_length )
 819                   );
 820             }
 821
 822             if (@warnings) {
 823                 "<ul>\n"
 824                   . join( '', map { "<li>$_</li>\n" } @warnings )
 825                   . "</ul>\n";
 826             }
 827
 828         }
 829     };
 830
 831     my $htgs_phase_html = (
 832         'none',
 833         '1 - fragmented, unordered',
 834         '2 - fragmented, ordered',
 835         '3 - finished'
 836       )[ $clone->seqprops->{htgs_phase} ]
 837       || 'not sequenced';
 838     my $sequenced_by_html = do {
 839         if ( my $seq_shortname = $clone->seqprops->{sequenced_by} ) {
 840
 841             #look up the organization for that shortname
 842             my $matching_orgs = $dbh->selectcol_arrayref(
 843 'select name from sgn_people.sp_organization where shortname = ?',
 844                 undef, $seq_shortname
 845             );
 846             if ( @$matching_orgs == 1 ) {
 847                 $matching_orgs->[0];
 848             }
 849             else {
 850                 qq|<span class="ghosted">$seq_shortname</span>|;
 851             }
 852         }
 853         elsif ( my $ul = $clone->seqprops->{upload_account_name} ) {
 854             "Uploaded by account '$ul'";
 855         }
 856         else {
 857             '<span class="ghosted">not recorded</span>';
 858         }
 859     };
 860
 861     my $agp_map_link = do {
 862         if ( my @agp_pos = agp_positions($clone) ) {
 863             my $url =
 864                 "/cview/view_chromosome.pl?map_id=agp&hilite="
 865               . $clone->clone_name
 866               . "&chr_nr="
 867               . $agp_pos[0][0];
 868             qq|<a href="$url">View on AGP map chromosome $agp_pos[0][0]</a>|;
 869         }
 870         else {
 871             '';
 872         }
 873     };
 874
 875     return $sequencing_project_html . info_table_html(
 876         'Sequencing Project' => $self->_clone_seq_project_name($clone),
 877         'Sequencing Status'  => $sequencing_status_html,
 878         'Full Sequence'      => $sequence_info,
 879         Warnings => $warnings_html || qq|<span class="ghosted">none</span>|,
 880         (
 881             $self->_is_tomato($clone)
 882             ? ( 'Chromosome Assembly' => $agp_map_link
 883                   || 'this clone is not part of a chromosome assembly' )
 884             : ()
 885         ),
 886         'HTGS phase'              => $htgs_phase_html,
 887         'Sequencing Organization' => $sequenced_by_html,
 888         'End Sequences'           => do {
 889
 890             #get BAC end data
 891             if ( my @chromats = $clone->chromat_objects ) {
 892                 join '', map { "$_\n" } (
 893                     '<ul style="margin: 0; padding-left: 2em">',
 894                     (
 895                         map {
 896                             '<li>'
 897                               . $_->read_link_html(
 898                                 $link_pages{read_info_page} )
 899                               . '</li>'
 900                           } @chromats
 901                     ),
 902                     '</ul>',
 903                 );
 904             }
 905             else {
 906                 '<span class="ghosted">None</span>';
 907             }
 908         },
 909         FTP          => $ftp_link,
 910         __border     => 0,
 911         __multicol   => 2,
 912         __tableattrs => 'width="100%"',
 913     ) . $restriction_frags_html;
 914
 915 }
 916
 917 sub sequencing_project_html {
 918     my ( $user_type, $chr, $clone ) = @_;
 919
 920     my ( undef, $organism, $accession ) =
 921       $clone->library_object->accession_name;
 922     return '' unless $organism =~ /lycopersicum/i;
 923
 924     return do {
 925         if ( $chr eq 'unmapped' ) {
 926 qq|<div class="specialnote">This clone is registered to be sequenced, but has not been successfully mapped to any chromosome.</div>|;
 927         }
 928         elsif ($chr) {
 929 qq|This clone is being sequenced by the Chromosome $chr Sequencing Project. (<a href="/about/tomato_sequencing.pl">View projects</a>)|;
 930         }
 931         else {
 932             "This clone is not assigned to any sequencing project.\n";
 933         }
 934       }
 935       . '<br />'
 936       . do {
 937         if ( $user_type eq 'curator' or $user_type eq 'sequencer' ) {
 938             my $q = CXGN::Genomic::Search::Clone->new->new_query;
 939             $q->clone_id( '=?', $clone->clone_id );
 940             my $clone_reg_link = 'clone_reg.pl?' . $q->to_query_string;
 941 qq| To change this clone's sequencing project assignment or other registry information, use the <a href="$clone_reg_link">Clone Registry Editor</a>.|;
 942         }
 943         else {
 944 qq|<span class="ghosted">Log in as a curator or sequencer to edit this clone's registry information.</span>|;
 945         }
 946       }
 947 }
 948
 949 sub render_tomato_bac_annot_download {
 950     my ( $c, $clone ) = @_;
 951
 952     #look at the keys in the sequencing_files hash to figure out the
 953     #analysis formats we have available.
 954     my %sequencing_files =
 955       CXGN::TomatoGenome::BACPublish::sequencing_files( $clone,
 956         $c->config->{'ftpsite_root'} );
 957
 958     my @formats =
 959       distinct( grep { $_ }
 960           map { my ($k) = /_([^_]+)$/; $k } keys %sequencing_files );
 961
 962     my @available_analyses =
 963       grep {    #find analyses that have all their files available
 964         my $a = $_ eq 'all' ? '' : $_ . '_';
 965         all( map { $sequencing_files{ $a . $_ } } @formats )
 966       } 'all', CXGN::TomatoGenome::BACSubmission->list_analyses;
 967
 968     if ( @formats && @available_analyses ) {
 969         my $set_select = simple_selectbox_html(
 970             choices => \@available_analyses,
 971             name    => 'set',
 972             id      => 'annot_set_selector',
 973         );
 974         my $type_select = simple_selectbox_html(
 975             choices => \@formats,
 976             name    => 'format',
 977             id      => 'annot_format_selector',
 978         );
 979         my $id = $clone->clone_id;
 980
 981         return <<EOHTML
 982 <form name="clone_annot_download" method="GET" action="/genomic/clone/$id/annotation/download">
 983 <table><tr><td><label for="annot_set_selector">Analysis:</label></td><td>$set_select</td></tr>
 984        <tr><td><label for="annot_format_selector">Format:</label></td><td>$type_select <input type="hidden" name="id" value="$id" /><input type="submit" value="Download" /></td></tr>
 985        <tr><td>&nbsp;</td></tr>
 986 </table>
 987 </form>
 988 EOHTML
 989     }
 990     else {
 991         return qq|<span class="ghosted">temporarily unavailable</span>|;
 992     }
 993
 994 }    # end prelim annot section
 995
 996 # NOTE: this function used to be in CXGN::Genomic::Clone
 997 # =head2 agp_positions
 998
 999 #   Usage: my $pos = $clone->agp_position
1000 #   Desc : get this clone's position in its chromosome's AGP file,
1001 #          or undef if it's not in there
1002 #   Args : none
1003 #   Ret  : nothing if not in AGP file, otherwise a list of
1004 #          [ chromonum, global start, global end, local start, local end, length ]
1005
1006 # =cut
1007 sub agp_positions {
1008     my ($clone) = @_;
1009
1010     my $chr = $clone->chromosome_num;
1011     $chr += 0;
1012     $chr >= 1 && $chr <= 12
1013       or return;
1014
1015     my ( undef, $agp_file ) =
1016       CXGN::TomatoGenome::BACPublish::tpf_agp_files($chr);
1017
1018     return unless $agp_file;
1019     unless ( -r $agp_file ) {
1020         warn "agp file $agp_file not readable";
1021         return;
1022     }
1023
1024     my $name = $clone->clone_name_with_chromosome
1025       or return;
1026
1027     open my $agp, '<', $agp_file
1028       or die "$! reading $agp_file";
1029
1030     return map {
1031         my @fields = split;
1032         my @record = map $_ + 0, ( $chr, @fields[ 1, 2, 6, 7 ] );
1033         $record[5] = $record[2] - $record[1] + 1;
1034         \@record
1035       }
1036       grep /$name/,
1037       <$agp>;
1038 }
1039
1040 sub render_old_arizona_fpc {
1041     my ( $dbh, $clone ) = @_;
1042
1043     my $clone_id = $clone->clone_id;
1044
1045     my $map_id = CXGN::DB::Physical::get_current_map_id();
1046
1047     # Get FPC Contigging data.
1048     my ( $fpc_version, $fpc_date ) =
1049       CXGN::DB::Physical::get_current_fpc_version_and_date($dbh);
1050     my $fpc_sth = $dbh->prepare_cached(<<EOQ);
1051       SELECT  bc.bac_contig_id,
1052               bc.contig_name,
1053         bap.plausible
1054       FROM physical.bac_associations AS ba
1055       INNER JOIN physical.ba_plausibility AS bap
1056         ON bap.bac_assoc_id=ba.bac_assoc_id
1057       INNER JOIN physical.bac_contigs AS bc
1058         ON ba.bac_contig_id=bc.bac_contig_id
1059       WHERE ba.bac_id=? AND bc.fpc_version=?
1060 EOQ
1061
1062     $fpc_sth->execute( $clone_id, $fpc_version );
1063     my $contig_sth = $dbh->prepare_cached(<<EOQ);
1064       SELECT ba.bac_id
1065       FROM physical.bac_associations AS ba
1066       INNER JOIN physical.ba_plausibility AS bap
1067          USING (bac_assoc_id)
1068       INNER JOIN physical.bacs AS b
1069          ON ba.bac_id=b.bac_id
1070       WHERE ba.bac_contig_id=?
1071          AND bap.map_id=?
1072 EOQ
1073
1074     my @coherent_ctgs;
1075     my @incoherent_ctgs;
1076     while ( my ( $ctg_id, $contig, $coherent ) = $fpc_sth->fetchrow_array ) {
1077         if ($coherent) {
1078             my @ctg_members;
1079             $contig_sth->execute( $ctg_id, $map_id );
1080             while ( my ($thisbacid) = $contig_sth->fetchrow_array ) {
1081                 my $thisbac     = CXGN::Genomic::Clone->retrieve($thisbacid);
1082                 my $thisbacname = $thisbac->clone_name_with_chromosome
1083                   || $thisbac->clone_name;
1084                 if ( $thisbacid == $clone_id ) {
1085                     push @ctg_members,
1086                       qq{<b><span style="color:red">$thisbacname</span></b>};
1087                 }
1088                 else {
1089                     push @ctg_members,
1090 qq{<a href="$link_pages{bac_page}$thisbacid">$thisbacname</a>};
1091                 }
1092             }
1093             push @coherent_ctgs,
1094               qq{<b>$contig :</b> [<span style="color: red">coherent</span>], }
1095               . ( scalar @ctg_members )
1096               . qq{ members: <br />\n};
1097             push @coherent_ctgs, "" . join( ",\n", @ctg_members ) . "<br />\n";
1098         }
1099         else {
1100             my @ctg_members;
1101             $contig_sth->execute( $ctg_id, $map_id );
1102             while ( my ($thisbacid) = $contig_sth->fetchrow_array ) {
1103                 ( $thisbacid == $clone_id ) && next;
1104                 my $thisbac     = CXGN::Genomic::Clone->retrieve($thisbacid);
1105                 my $thisbacname = $thisbac->clone_name_with_chromosome
1106                   || $thisbac->clone_name;
1107                 push @ctg_members,
1108 qq{<a href="$link_pages{bac_page}$thisbacid">$thisbacname</a>};
1109             }
1110             push @incoherent_ctgs,
1111 qq{<b>$contig :</b> [<span style="color: red">incoherent</span>], }
1112               . ( scalar @ctg_members )
1113               . qq{ members:<br />\n};
1114             push @incoherent_ctgs,
1115               "" . join( ",\n", @ctg_members ) . "<br />\n";
1116         }
1117     }
1118     $fpc_sth->finish;
1119     $contig_sth->finish;
1120
1121     if ( @coherent_ctgs || @incoherent_ctgs ) {
1122         return join "\n",
1123           (
1124             '<dt>Tomato FPC (AGI 2005)</dt>',
1125             '<dd>', @coherent_ctgs, @incoherent_ctgs, '</dd>',
1126           );
1127     }
1128     else {
1129         return
1130 '<dt class="ghosted">not present in Tomato FPC (AGI 2005)</dt><dd class="ghosted"></dd>';
1131     }
1132 }
1133
1134 sub render_overgo {
1135     my ( $clone, $dbh ) = @_;
1136
1137     # Get Overgo Plating data.
1138     my $map_id = CXGN::DB::Physical::get_current_map_id();
1139
1140     my $overgo_version = CXGN::DB::Physical::get_current_overgo_version($dbh);
1141     my $op_sth         = $dbh->prepare(
1142         "SELECT oap.plausible,
1143                                    pm.overgo_plate_row,
1144                                    pm.overgo_plate_col,
1145                                    marker_id,
1146                                    map_id,
1147                                    op.plate_number
1148                             FROM  physical.overgo_associations AS oa
1149                             INNER JOIN physical.oa_plausibility AS oap
1150                                   ON oap.overgo_assoc_id=oa.overgo_assoc_id
1151                             INNER JOIN physical.probe_markers AS pm
1152                                   ON oa.overgo_probe_id=pm.overgo_probe_id
1153                             INNER JOIN physical.overgo_plates AS op
1154                                   ON pm.overgo_plate_id=op.plate_id
1155                             WHERE oa.bac_id=?
1156                                   AND oa.overgo_version=?
1157                                   AND oap.map_id=?
1158     "
1159     );
1160     $op_sth->execute( $clone->clone_id, $overgo_version, $map_id );
1161
1162     #format the overgo plating data into html
1163     sub fmt_overgo {
1164         my ( $dbh, $plausible, $row, $col, $marker_id, $map_id, $plateno ) = @_;
1165         my ( $map_name, $marker_name ) = ( '', '' );
1166         if ( my $marker = CXGN::Marker->new( $dbh, $marker_id ) ) {
1167             $marker_name = $marker->name_that_marker();
1168         }
1169         if ( my $map = CXGN::Map->new( $dbh, { map_id => $map_id } ) ) {
1170             $map_name = $map->short_name();
1171         }
1172         [
1173             qq|<a href="$link_pages{marker_page}$marker_id">$marker_name</a>|,
1174             qq|<a href="$link_pages{map_page}$map_id">$map_name</a>|,
1175 qq|<a href="$link_pages{plate_design_page}$plateno&highlightwell=$row$col">plate $plateno</a>|,
1176 qq|<a href="$link_pages{plate_design_page}$plateno&highlightwell=$row$col">$row$col</a>|
1177         ];
1178     }
1179     my @matches = @{ $op_sth->fetchall_arrayref };
1180     my @plausible_matches =
1181       map { fmt_overgo( $dbh, @$_ ) } grep { $_->[0] } @matches;
1182     my @conflicted_matches =
1183       map { fmt_overgo( $dbh, @$_ ) } grep { !$_->[0] } @matches;
1184
1185     #output overgo information
1186     my @matches_headings = qw/Probe Map Plate Well/;
1187     my $plausible_matches_html =
1188       @plausible_matches
1189       ? columnar_table_html(
1190         headings => \@matches_headings,
1191         data     => \@plausible_matches,
1192         __border => 1,
1193       )
1194       : undef;
1195     my $conflicted_matches_html =
1196       @conflicted_matches
1197       ? columnar_table_html(
1198         headings => \@matches_headings,
1199         data     => \@conflicted_matches,
1200         __border => 1,
1201       )
1202       : undef;
1203     if ( $plausible_matches_html || $conflicted_matches_html ) {
1204         info_table_html(
1205             'Plausible matches' => $plausible_matches_html
1206               || '<span class="ghosted">None</span>',
1207             'Conflicted matches' => $conflicted_matches_html
1208               || '<span class="ghosted">None</span>',
1209             'Additional Info' =>
1210 qq|<a href="$link_pages{overgo_report_page}">Overgo Plating Progress Report</a>|,
1211             __border   => 0,
1212             __multicol => 2,
1213         );
1214     }
1215     else {
1216         '';
1217     }
1218 }
1219
1220 sub render_computational_associations {
1221     my ( $clone, $dbh ) = @_;
1222     my $cas = $dbh->selectall_arrayref( <<EOSQL, undef, $clone->clone_id );
1223 select marker_id,e_value,identity,score,parameters
1224 from physical.computational_associations
1225 where clone_id = ?
1226 EOSQL
1227
1228     if ( $cas and @$cas ) {
1229
1230         #alter the data to make it more suitable for display
1231         foreach my $r (@$cas) {
1232
1233             #change the marker ID to an html link
1234             $r->[0] = qq|<a href="$link_pages{marker_page}$r->[0]">|
1235               . CXGN::Marker->new( $dbh, $r->[0] )->name_that_marker . '</a>';
1236             $r->[3] = sprintf( '%0.2f', $r->[3] );
1237         }
1238
1239         columnar_table_html(
1240             headings => [ 'Marker', 'Evalue', 'Identity %', 'Score', 'Params' ],
1241             data     => $cas,
1242         );
1243     }
1244     else {
1245         '';
1246     }
1247 }