File Coverage

Bio/SearchIO/Writer/HTMLResultWriter.pm
Criterion Covered Total %
statement 191 249 76.7
branch 61 140 43.5
condition 27 85 31.7
subroutine 24 27 88.8
pod 19 22 86.3
total 322 523 61.5


line stmt bran cond sub pod time code
1             #
2             # BioPerl module for Bio::SearchIO::Writer::HTMLResultWriter
3             #
4             # Please direct questions and support issues to
5             #
6             # Cared for by Jason Stajich
7             #
8             # Copyright Jason Stajich
9             #
10             # You may distribute this module under the same terms as perl itself
11              
12             # Changes 2003-07-31 (jason)
13             # Gary has cleaned up the code a lot to produce better looking HTML
14              
15             # POD documentation - main docs before the code
16              
17             =head1 NAME
18              
19             Bio::SearchIO::Writer::HTMLResultWriter - write a Bio::Search::ResultI in HTML
20              
21             =head1 SYNOPSIS
22              
23             use Bio::SearchIO;
24             use Bio::SearchIO::Writer::HTMLResultWriter;
25              
26             my $in = Bio::SearchIO->new(-format => 'blast',
27             -file => shift @ARGV);
28              
29             my $writer = Bio::SearchIO::Writer::HTMLResultWriter->new();
30             my $out = Bio::SearchIO->new(-writer => $writer);
31             $out->write_result($in->next_result);
32              
33              
34             # to filter your output
35             my $MinLength = 100; # need a variable with scope outside the method
36             sub hsp_filter {
37             my $hsp = shift;
38             return 1 if $hsp->length('total') > $MinLength;
39             }
40             sub result_filter {
41             my $result = shift;
42             return $hsp->num_hits > 0;
43             }
44              
45             my $writer = Bio::SearchIO::Writer::HTMLResultWriter->new
46             (-filters => { 'HSP' => \&hsp_filter} );
47             my $out = Bio::SearchIO->new(-writer => $writer);
48             $out->write_result($in->next_result);
49              
50             # can also set the filter via the writer object
51             $writer->filter('RESULT', \&result_filter);
52              
53             =head1 DESCRIPTION
54              
55             This object implements the SearchWriterI interface which will produce
56             a set of HTML for a specific L interface.
57              
58             See L for more info on the filter method.
59              
60             =head1 FEEDBACK
61              
62             =head2 Mailing Lists
63              
64             User feedback is an integral part of the evolution of this and other
65             Bioperl modules. Send your comments and suggestions preferably to
66             the Bioperl mailing list. Your participation is much appreciated.
67              
68             bioperl-l@bioperl.org - General discussion
69             http://bioperl.org/wiki/Mailing_lists - About the mailing lists
70              
71             =head2 Support
72              
73             Please direct usage questions or support issues to the mailing list:
74              
75             I
76              
77             rather than to the module maintainer directly. Many experienced and
78             reponsive experts will be able look at the problem and quickly
79             address it. Please include a thorough description of the problem
80             with code and data examples if at all possible.
81              
82             =head2 Reporting Bugs
83              
84             Report bugs to the Bioperl bug tracking system to help us keep track
85             of the bugs and their resolution. Bug reports can be submitted via the
86             web:
87              
88             https://github.com/bioperl/bioperl-live/issues
89              
90             =head1 AUTHOR - Jason Stajich
91              
92             Email jason-at-bioperl-dot-org
93              
94             =head1 CONTRIBUTORS
95              
96             Gary Williams G.Williams@hgmp.mrc.ac.uk
97              
98             =head1 APPENDIX
99              
100             The rest of the documentation details each of the object methods.
101             Internal methods are usually preceded with a _
102              
103             =cut
104              
105              
106             package Bio::SearchIO::Writer::HTMLResultWriter;
107 1     1   992 use strict;
  1         1  
  1         27  
108 1         76 use vars qw(%RemoteURLDefault
109 1     1   4 $MaxDescLen $DATE $AlignmentLineWidth $Revision);
  1         1  
110              
111             # Object preamble - inherits from Bio::Root::RootI
112              
113             BEGIN {
114 1     1   2 $Revision = '$Id$';
115 1         96 $DATE = localtime(time);
116 1         4 %RemoteURLDefault = (
117             'PROTEIN' => 'https://www.ncbi.nlm.nih.gov/protein?term=%s',
118             'NUCLEOTIDE' => 'https://www.ncbi.nlm.nih.gov/nucleotide?term=%s'
119             );
120 1         2 $MaxDescLen = 60;
121 1         23 $AlignmentLineWidth = 60;
122             }
123              
124              
125 1     1   4 use base qw(Bio::Root::Root Bio::SearchIO::SearchWriterI);
  1         1  
  1         270  
126              
127             =head2 new
128              
129             Title : new
130             Usage : my $obj = Bio::SearchIO::Writer::HTMLResultWriter->new();
131             Function: Builds a new Bio::SearchIO::Writer::HTMLResultWriter object
132             Returns : Bio::SearchIO::Writer::HTMLResultWriter
133             Args : -filters => hashref with any or all of the keys (HSP HIT RESULT)
134             which have values pointing to a subroutine reference
135             which will expect to get a
136             -nucleotide_url => URL sprintf string base for the nt sequences
137             -protein_url => URL sprintf string base for the aa sequences
138             -no_wublastlinks => boolean. Do not display WU-BLAST lines
139             even if they are parsed out.
140             Links = (1)
141              
142             =cut
143              
144             sub new {
145 1     1 1 14 my($class,@args) = @_;
146              
147 1         7 my $self = $class->SUPER::new(@args);
148 1         8 my ($p,$n,$filters,
149             $nowublastlinks) = $self->_rearrange([qw(PROTEIN_URL
150             NUCLEOTIDE_URL
151             FILTERS
152             NO_WUBLASTLINKS)],@args);
153 1   33     7 $self->remote_database_url('p',$p || $RemoteURLDefault{'PROTEIN'});
154 1   33     8 $self->remote_database_url('n',$n || $RemoteURLDefault{'NUCLEOTIDE'});
155 1         4 $self->no_wublastlinks(! $nowublastlinks);
156 1 50       2 if( defined $filters ) {
157 0 0       0 if( !ref($filters) =~ /HASH/i ) {
158 0         0 $self->warn("Did not provide a hashref for the FILTERS option, ignoring.");
159             } else {
160 0         0 while( my ($type,$code) = each %{$filters} ) {
  0         0  
161 0         0 $self->filter($type,$code);
162             }
163             }
164             }
165              
166 1         2 return $self;
167             }
168              
169             =head2 remote_database_url
170              
171             Title : remote_database_url
172             Usage : $obj->remote_database_url($type,$newval)
173             Function: This should return or set a string that contains a %s which can be
174             filled in with sprintf.
175             Returns : value of remote_database_url
176             Args : $type - 'PROTEIN' or 'P' for protein URLS
177             'NUCLEOTIDE' or 'N' for nucleotide URLS
178             $value - new value to set [optional]
179              
180              
181             =cut
182              
183             sub remote_database_url{
184 82     82 1 82 my ($self,$type,$value) = @_;
185 82 50 33     234 if( ! defined $type || $type !~ /^(P|N)/i ) {
186 0         0 $self->warn("Must provide a type (PROTEIN or NUCLEOTIDE)");
187 0         0 return '';
188             }
189 82         99 $type = uc $1;
190 82 100       103 if( defined $value) {
191 2         8 $self->{'remote_database_url'}->{$type} = $value;
192             }
193 82         276 return $self->{'remote_database_url'}->{$type};
194             }
195              
196             =head2 to_string
197              
198             Purpose : Produces data for each Search::Result::ResultI in a string.
199             : This is an abstract method. For some useful implementations,
200             : see ResultTableWriter.pm, HitTableWriter.pm,
201             : and HSPTableWriter.pm.
202             Usage : print $writer->to_string( $result_obj, @args );
203             Argument : $result_obj = A Bio::Search::Result::ResultI object
204             : @args = any additional arguments used by your implementation.
205             Returns : String containing data for each search Result or any of its
206             : sub-objects (Hits and HSPs).
207             Throws : n/a
208              
209             =cut
210              
211             sub to_string {
212 1     1 1 1 my ($self,$result,$num) = @_;
213 1   50     3 $num ||= 0;
214 1 50       3 return unless defined $result;
215 1         2 my $links = $self->no_wublastlinks;
216 1         7 my ($resultfilter,$hitfilter, $hspfilter) = ( $self->filter('RESULT'),
217             $self->filter('HIT'),
218             $self->filter('HSP') );
219 1 50 33     3 return '' if( defined $resultfilter && ! &{$resultfilter}($result) );
  0         0  
220              
221 1         2 my ($qtype,$dbtype,$dbseqtype,$type);
222 1         9 my $alg = $result->algorithm;
223             # This is actually wrong for the FASTAs I think
224 1 50 0     6 if( $alg =~ /T(FAST|BLAST)([XY])/i ) {
    0 0        
    0          
    0          
    0          
225 1         2 $qtype = $dbtype = 'translated';
226 1         1 $dbseqtype = $type = 'PROTEIN';
227             } elsif( $alg =~ /T(FAST|BLAST)N/i ) {
228 0         0 $qtype = '';
229 0         0 $dbtype = 'translated';
230 0         0 $type = 'PROTEIN';
231 0         0 $dbseqtype = 'NUCLEOTIDE';
232             } elsif( $alg =~ /(FAST|BLAST)N/i ||
233             $alg =~ /(WABA|EXONERATE)/i ) {
234 0         0 $qtype = $dbtype = '';
235 0         0 $type = $dbseqtype = 'NUCLEOTIDE';
236             } elsif( $alg =~ /(FAST|BLAST)P/ ||
237             $alg =~ /SSEARCH|HMM(PFAM|SEARCH)/i ) {
238 0         0 $qtype = $dbtype = '';
239 0         0 $type = $dbseqtype = 'PROTEIN';
240             } elsif( $alg =~ /(FAST|BLAST)[XY]/i ) {
241 0         0 $qtype = 'translated';
242 0         0 $dbtype = 'PROTEIN';
243 0         0 $dbseqtype = $type = 'PROTEIN';
244             } else {
245 0         0 $self->warn("algorithm was ", $result->algorithm, " couldn't match\n");
246             }
247            
248            
249 1 50       6 my %baselens = ( 'Sbjct:' => ( $dbtype eq 'translated' ) ? 3 : 1,
    50          
250             'Query:' => ( $qtype eq 'translated' ) ? 3 : 1);
251              
252 1         2 my $str;
253 1 50       2 if( $num <= 1 ) {
254 1         5 $str = &{$self->start_report}($result);
  1         4  
255             }
256              
257 1         2 $str .= &{$self->title}($result);
  1         3  
258              
259 1   33     4 $str .= $result->algorithm_reference || $self->algorithm_reference($result);
260 1         2 $str .= &{$self->introduction}($result);
  1         3  
261              
262 1         2 $str .= ""; '."\n", '."\n",
263            
Sequences producing significant alignments:
264             Score
(bits)
E
value
265              
266 1         2 my $hspstr = '

';

267 1 50       12 if( $result->can('rewind')) {
268 1         4 $result->rewind(); # support stream based parsing routines
269             }
270              
271 1         3 while( my $hit = $result->next_hit ) {
272 20 50 33     36 next if( $hitfilter && ! &{$hitfilter}($hit) );
  0         0  
273 20         42 my $nm = $hit->name();
274            
275 20 50       30 $self->debug( "no $nm for name (".$hit->description(). "\n")
276             unless $nm;
277 20         18 my ($gi,$acc) = &{$self->id_parser}($nm);
  20         32  
278 20         31 my $p = "%-$MaxDescLen". "s";
279 20         13 my $descsub;
280 20 50       41 if( length($hit->description) > ($MaxDescLen - 3) ) {
281 20         29 $descsub = sprintf($p,
282             substr($hit->description,0,$MaxDescLen-3) . "...");
283             } else {
284 0         0 $descsub = sprintf($p,$hit->description);
285             }
286              
287 20         22 my $url_desc = &{$self->hit_link_desc()}($self,$hit, $result);
  20         30  
288 20         16 my $url_align = &{$self->hit_link_align()}($self,$hit, $result);
  20         26  
289              
290 20         33 my @hsps = $hit->hsps;
291            
292 20 50       30 if( ! @hsps ) {
293             # no HSPs so no link
294 0 0       0 $str .= sprintf('
%s %s%s%.2g
    0          
    0          
    0          
295             $url_desc, $descsub,
296             ($hit->bits ? $hit->bits :
297             (defined $hsps[0] ? $hsps[0]->bits : ' ')),
298             ( $hit->significance ? $hit->significance :
299             (defined $hsps[0] ? $hsps[0]->evalue : ' '))
300             );
301             } else {
302             # failover to first HSP if the data does not contain a
303             # bitscore/significance value for the Hit (NCBI XML data for one)
304              
305 20 0       38 $str .= sprintf('
%s %s%s%.2g
    50          
    0          
    50          
306             $url_desc, $descsub,
307             ($hit->bits ? $hit->bits :
308             (defined $hsps[0] ? $hsps[0]->bits : ' ')),
309             $acc,
310             ( $hit->significance ? $hit->significance :
311             (defined $hsps[0] ? $hsps[0]->evalue : ' '))
312             );
313 20         27 my $dline = &{$self->hit_desc_line}($self, $hit, $result);
  20         38  
314 20         44 $hspstr .= "\n".
315             sprintf(">%s %s
Length = %s

\n\n", $url_align,

316             $dline , &_numwithcommas($hit->length));
317 20         24 my $ct = 0;
318 20         20 foreach my $hsp (@hsps ) {
319 21 50 33     37 next if( $hspfilter && ! &{$hspfilter}($hsp) );
  0         0  
320 21   33     42 $hspstr .= sprintf(" Score = %s bits (%s), Expect = %s",
      33        
      50        
321             $hsp->bits || $hsp->score,
322             $hsp->score || $hsp->bits,
323             $hsp->evalue || '');
324 21 50       38 if( defined $hsp->pvalue ) {
325 0         0 $hspstr .= ", P = ".$hsp->pvalue;
326             }
327 21         21 $hspstr .= "
\n";
328 21         36 $hspstr .= sprintf(" Identities = %d/%d (%d%%)",
329             ( $hsp->frac_identical('total') *
330             $hsp->length('total')),
331             $hsp->length('total'),
332             $hsp->frac_identical('total') * 100);
333              
334 21 50       49 if( $type eq 'PROTEIN' ) {
335 21         37 $hspstr .= sprintf(", Positives = %d/%d (%d%%)",
336             ( $hsp->frac_conserved('total') *
337             $hsp->length('total')),
338             $hsp->length('total'),
339             $hsp->frac_conserved('total') * 100);
340             }
341 21 50       43 if( $hsp->gaps ) {
342 0         0 $hspstr .= sprintf(", Gaps = %d/%d (%d%%)",
343             $hsp->gaps('total'),
344             $hsp->length('total'),
345             (100 * $hsp->gaps('total') /
346             $hsp->length('total')));
347             }
348              
349 21         40 my ($hframe,$qframe) = ( $hsp->hit->frame, $hsp->query->frame);
350 21         34 my ($hstrand,$qstrand) = ($hsp->hit->strand,$hsp->query->strand);
351             # so TBLASTX will have Query/Hit frames
352             # BLASTX will have Query frame
353             # TBLASTN will have Hit frame
354 21 50 33     54 if( $hstrand || $qstrand ) {
355 21         23 $hspstr .= ", Frame = ";
356 21         17 my ($signq, $signh);
357 21 50       23 unless( $hstrand ) {
358 0         0 $hframe = undef;
359             # if strand is null or 0 then it is protein
360             # and this no frame
361             } else {
362 21 100       34 $signh = $hstrand < 0 ? '-' : '+';
363             }
364 21 50       22 unless( $qstrand ) {
365 0         0 $qframe = undef;
366             # if strand is null or 0 then it is protein
367             } else {
368 21 100       23 $signq =$qstrand < 0 ? '-' : '+';
369             }
370             # remember bioperl stores frames as 0,1,2 (GFF way)
371             # BLAST reports reports as 1,2,3 so
372             # we have to add 1 to the frame values
373 21 50 33     106 if( defined $hframe && ! defined $qframe) {
    50 33        
374 0         0 $hspstr .= "$signh".($hframe+1);
375             } elsif( defined $qframe && ! defined $hframe) {
376 0         0 $hspstr .= "$signq".($qframe+1);
377             } else {
378 21         73 $hspstr .= sprintf(" %s%d / %s%d",
379             $signq,$qframe+1,
380             $signh, $hframe+1);
381             }
382             }
383 21 50 33     117 if($links &&
      33        
384             $hsp->can('links') && defined(my $lnks = $hsp->links) ) {
385 0         0 $hspstr .= sprintf("
\nLinks = %s\n",$lnks);
386             }
387              
388 21         20 $hspstr .= "

\n

"; 
389              
390 21 100 50     35 my @hspvals = ( {'name' => 'Query:',
    100 50        
    100          
    100          
391             'seq' => $hsp->query_string,
392             'start' => ($qstrand >= 0 ?
393             $hsp->query->start :
394             $hsp->query->end),
395             'end' => ($qstrand >= 0 ?
396             $hsp->query->end :
397             $hsp->query->start),
398             'index' => 0,
399             'direction' => $qstrand || 1
400             },
401             { 'name' => ' 'x6,
402             'seq' => $hsp->homology_string,
403             'start' => undef,
404             'end' => undef,
405             'index' => 0,
406             'direction' => 1
407             },
408             { 'name' => 'Sbjct:',
409             'seq' => $hsp->hit_string,
410             'start' => ($hstrand >= 0 ?
411             $hsp->hit->start :
412             $hsp->hit->end),
413             'end' => ($hstrand >= 0 ?
414             $hsp->hit->end :
415             $hsp->hit->start),
416             'index' => 0,
417             'direction' => $hstrand || 1
418             }
419             );
420              
421              
422             # let's set the expected length (in chars) of the starting number
423             # in an alignment block so we can have things line up
424             # Just going to try and set to the largest
425              
426 85         73 my ($numwidth) = sort { $b <=> $a }(length($hspvals[0]->{'start'}),
427             length($hspvals[0]->{'end'}),
428             length($hspvals[2]->{'start'}),
429 21         84 length($hspvals[2]->{'end'}));
430 21         22 my $count = 0;
431 21         39 while ( $count < $hsp->length('total') ) {
432 21         27 foreach my $v ( @hspvals ) {
433 63         87 my $piece = substr($v->{'seq'}, $v->{'index'} + $count,
434             $AlignmentLineWidth);
435 63         47 my $cp = $piece;
436 63         53 my $plen = scalar ( $cp =~ tr/\-//);
437 63         57 my ($start,$end) = ('','');
438 63 100       85 if( defined $v->{'start'} ) {
439 42         32 $start = $v->{'start'};
440             # since strand can be + or - use the direction
441             # to signify which whether to add or substract from end
442             my $d = $v->{'direction'} * ( $AlignmentLineWidth - $plen )*
443 42         57 $baselens{$v->{'name'}};
444 42 50       52 if( length($piece) < $AlignmentLineWidth ) {
445             $d = (length($piece) - $plen) * $v->{'direction'} *
446 42         52 $baselens{$v->{'name'}};
447             }
448 42         31 $end = $v->{'start'} + $d - $v->{'direction'};
449 42         34 $v->{'start'} += $d;
450             }
451             $hspstr .= sprintf("%s %-".$numwidth."s %s %s\n",
452 63         195 $v->{'name'},
453             $start,
454             $piece,
455             $end
456             );
457             }
458 21         15 $count += $AlignmentLineWidth;
459 21         33 $hspstr .= "\n\n";
460             }
461 21         160 $hspstr .= "\n";
462             }
463             }
464             # $hspstr .= "\n";
465             }
466              
467 1         23 $str .= "

\n".$hspstr;

468 1         8 my ($pav, $sav) = ($result->available_parameters, $result->available_statistics);
469 1 50 33     4 if ($pav || $sav) {
470             # make table of search statistics and end the web page
471 1         5 $str .= "


Search Parameters

";
472 1 50       3 if ($pav) {
473 1         1 $str .= "\n"; \n";
ParameterValue
474 1         2 foreach my $param ( sort $result->available_parameters ) {
475 3         9 $str .= "
$param". $result->get_parameter($param) ."
476             }
477 1         1 $str .= "
";
478             }
479            
480 1 50       4 if ($sav) {
481 1         1 $str .= "

Search Statistics

\n"; \n";
StatisticValue
482 1         3 foreach my $stat ( sort $result->available_statistics ) {
483 27         41 $str .= "
$stat". $result->get_statistic($stat). "
484             }
485 1         2 $str .= "
";
486             }
487             }
488 1         4 $str .= $self->footer() . "

\n";

489 1         16 return $str;
490             }
491              
492             =head2 hit_link_desc
493              
494             Title : hit_link_desc
495             Usage : $self->hit_link_desc(\&link_function);
496             Function: Get/Set the function which provides an HTML
497             link(s) for the given hit to be used
498             within the description section at the top of the BLAST report.
499             This allows a person reading the report within
500             a web browser to go to one or more database entries for
501             the given hit from the description section.
502             Returns : Function reference
503             Args : Function reference
504             See Also: L
505              
506             =cut
507              
508             sub hit_link_desc{
509 20     20 1 20 my( $self, $code ) = @_;
510 20 50       27 if ($code) {
511 0         0 $self->{'_hit_link_desc'} = $code;
512             }
513 20   50     72 return $self->{'_hit_link_desc'} || \&default_hit_link_desc;
514             }
515              
516             =head2 default_hit_link_desc
517              
518             Title : default_hit_link_desc
519             Usage : $self->default_hit_link_desc($hit, $result)
520             Function: Provides an HTML link(s) for the given hit to be used
521             within the description section at the top of the BLAST report.
522             This allows a person reading the report within
523             a web browser to go to one or more database entries for
524             the given hit from the description section.
525             Returns : string containing HTML markup "
526              
527             The default implementation returns an HTML link to the
528             URL supplied by the remote_database_url() method
529             and using the identifier supplied by the id_parser() method.
530             It will use the NCBI GI if present, and the accession if not.
531              
532             Args : First argument is a Bio::Search::Hit::HitI
533             Second argument is a Bio::Search::Result::ResultI
534              
535             See Also: L, L, L
536              
537             =cut
538              
539             sub default_hit_link_desc {
540 40     40 1 38 my($self, $hit, $result) = @_;
541 40 50       73 my $type = ( $result->algorithm =~ /(P|X|Y)$/i ) ? 'PROTEIN' : 'NUCLEOTIDE';
542 40         62 my ($gi,$acc) = &{$self->id_parser}($hit->name);
  40         49  
543              
544 40 50 33     69 my $url = length($self->remote_database_url($type)) > 0 ?
545             sprintf('%s',
546             sprintf($self->remote_database_url($type),$gi || $acc),
547             $hit->name()) : $hit->name();
548              
549 40         58 return $url;
550             }
551              
552              
553             =head2 hit_link_align
554              
555             Title : hit_link_align
556             Usage : $self->hit_link_align(\&link_function);
557             Function: Get/Set the function which provides an HTML link(s)
558             for the given hit to be used
559             within the HSP alignment section of the BLAST report.
560             This allows a person reading the report within
561             a web browser to go to one or more database entries for
562             the given hit from the alignment section.
563             Returns : string containing HTML markup "
564              
565             The default implementation delegates to hit_link_desc().
566              
567             Args : First argument is a Bio::Search::Hit::HitI
568             Second argument is a Bio::Search::Result::ResultI
569              
570             See Also: L, L, L
571              
572             =cut
573              
574             sub hit_link_align {
575 20     20 1 17 my ($self,$code) = @_;
576 20 50       31 if ($code) {
577 0         0 $self->{'_hit_link_align'} = $code;
578             }
579 20   50     67 return $self->{'_hit_link_align'} || \&default_hit_link_desc;
580             }
581              
582             =head2 hit_desc_line
583              
584             Title : hit_desc_line
585             Usage : $self->hit_desc_line(\&link_function);
586             Function: Get/Set the function which provides HTML for the description
587             information from a hit. This allows one to parse
588             the rest of the description and split up lines, add links, etc.
589             Returns : Function reference
590             Args : Function reference
591             See Also: L
592              
593             =cut
594              
595             sub hit_desc_line{
596 20     20 1 18 my( $self, $code ) = @_;
597 20 50       27 if ($code) {
598 0         0 $self->{'_hit_desc_line'} = $code;
599             }
600 20   50     81 return $self->{'_hit_desc_line'} || \&default_hit_desc_line;
601             }
602              
603             =head2 default_hit_desc_line
604              
605             Title : default_hit_desc_line
606             Usage : $self->default_hit_desc_line($hit, $result)
607             Function: Parses the description line information, splits based on the
608             hidden \x01 between independent descriptions, checks the lines for
609             possible web links, and adds HTML link(s) for the given hit to be
610             used.
611              
612             Returns : string containing HTML markup "
613             The default implementation returns an HTML link to the
614             URL supplied by the remote_database_url() method
615             and using the identifier supplied by the id_parser() method.
616             It will use the NCBI GI if present, and the accession if not.
617              
618             Args : First argument is a Bio::Search::Hit::HitI
619             Second argument is a Bio::Search::Result::ResultI
620              
621             See Also: L, L, L
622              
623             =cut
624              
625             sub default_hit_desc_line {
626 20     20 1 23 my($self, $hit, $result) = @_;
627 20 50       46 my $type = ( $result->algorithm =~ /(P|X|Y)$/i ) ? 'PROTEIN' : 'NUCLEOTIDE';
628 20         40 my @descs = split /\x01/, $hit->description;
629             #my $descline = join("
",@descs)."
";
630 20         21 my $descline = '';
631             #return $descline;
632 20         25 for my $sec (@descs) {
633 20         18 my $url = '';
634 20 50       32 if ($sec =~ s/((?:gi\|(\d+)\|)? # optional GI
635             (\w+)\|([A-Z\d\.\_]+) # main
636             (\|[A-Z\d\_]+)?) # optional secondary ID//xms) {
637 0         0 my ($name, $gi, $db, $acc) = ($1, $2, $3, $4);
638             #$acc ||= ($rest) ? $rest : $gi;
639 0         0 $acc =~ s/^\s+(\S+)/$1/;
640 0         0 $acc =~ s/(\S+)\s+$/$1/;
641 0 0 0     0 $url =
642             length($self->remote_database_url($type)) > 0 ?
643             sprintf('%s %s',
644             sprintf($self->remote_database_url($type),
645             $gi || $acc || $db),
646             $name, $sec) : $sec;
647             } else {
648 20         18 $url = $sec;
649             }
650 20         45 $descline .= "$url
\n";
651             }
652 20         30 return $descline;
653             }
654              
655             =head2 start_report
656              
657             Title : start_report
658             Usage : $index->start_report( CODE )
659             Function: Stores or returns the code to
660             write the start of the block, the block </td> </tr> <tr> <td class="h" > <a name="661">661</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> and the start of the <BODY> block of HTML. Useful </td> </tr> <tr> <td class="h" > <a name="662">662</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> for (for instance) specifying alternative </td> </tr> <tr> <td class="h" > <a name="663">663</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> HTML if you are embedding the output in </td> </tr> <tr> <td class="h" > <a name="664">664</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> an HTML page which you have already started. </td> </tr> <tr> <td class="h" > <a name="665">665</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> (For example a routine returning a null string). </td> </tr> <tr> <td class="h" > <a name="666">666</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Returns \&default_start_report (see below) if not </td> </tr> <tr> <td class="h" > <a name="667">667</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> set. </td> </tr> <tr> <td class="h" > <a name="668">668</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Example : $index->start_report( \&my_start_report ) </td> </tr> <tr> <td class="h" > <a name="669">669</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Returns : ref to CODE if called without arguments </td> </tr> <tr> <td class="h" > <a name="670">670</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Args : CODE </td> </tr> <tr> <td class="h" > <a name="671">671</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="672">672</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =cut </td> </tr> <tr> <td class="h" > <a name="673">673</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="674">674</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub start_report { </td> </tr> <tr> <td class="h" > <a name="675">675</a> </td> <td class="c3" > 1 </td> <td >   </td> <td >   </td> <td class="c3" > <a href="Bio-SearchIO-Writer-HTMLResultWriter-pm--subroutine.html#675-1"> 1 </a> </td> <td class="c3" > <a href="Bio-SearchIO-Writer-HTMLResultWriter-pm--subroutine.html#675-1"> 1 </a> </td> <td > 5 </td> <td class="s"> my( $self, $code ) = @_; </td> </tr> <tr> <td class="h" > <a name="676">676</a> </td> <td class="c3" > 1 </td> <td class="c0" > <a href="Bio-SearchIO-Writer-HTMLResultWriter-pm--branch.html#676-1"> 50 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td > 2 </td> <td class="s"> if ($code) { </td> </tr> <tr> <td class="h" > <a name="677">677</a> </td> <td class="c0" > <a href="#727"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 0 </td> <td class="s"> $self->{'_start_report'} = $code; </td> </tr> <tr> <td class="h" > <a name="678">678</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="679">679</a> </td> <td class="c3" > 1 </td> <td >   </td> <td class="c0" > <a href="Bio-SearchIO-Writer-HTMLResultWriter-pm--condition.html#679-1"> 50 </a> </td> <td >   </td> <td >   </td> <td > 7 </td> <td class="s"> return $self->{'_start_report'} || \&default_start_report; </td> </tr> <tr> <td class="h" > <a name="680">680</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="681">681</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="682">682</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =head2 default_start_report </td> </tr> <tr> <td class="h" > <a name="683">683</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="684">684</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Title : default_start_report </td> </tr> <tr> <td class="h" > <a name="685">685</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Usage : $self->default_start_report($result) </td> </tr> <tr> <td class="h" > <a name="686">686</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Function: The default method to call when starting a report. </td> </tr> <tr> <td class="h" > <a name="687">687</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Returns : sting </td> </tr> <tr> <td class="h" > <a name="688">688</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Args : First argument is a Bio::Search::Result::ResultI </td> </tr> <tr> <td class="h" > <a name="689">689</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="690">690</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =cut </td> </tr> <tr> <td class="h" > <a name="691">691</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="692">692</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub default_start_report { </td> </tr> <tr> <td class="h" > <a name="693">693</a> </td> <td class="c3" > 1 </td> <td >   </td> <td >   </td> <td class="c3" > <a href="Bio-SearchIO-Writer-HTMLResultWriter-pm--subroutine.html#693-1"> 1 </a> </td> <td class="c3" > <a href="Bio-SearchIO-Writer-HTMLResultWriter-pm--subroutine.html#693-1"> 1 </a> </td> <td > 1 </td> <td class="s"> my ($result) = @_; </td> </tr> <tr> <td class="h" > <a name="694">694</a> </td> <td class="c3" > 1 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td > 3 </td> <td class="s"> return sprintf( </td> </tr> <tr> <td class="h" > <a name="695">695</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> qq{<HTML> </td> </tr> <tr> <td class="h" > <a name="696">696</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> <HEAD> <CENTER><TITLE>Bioperl Reformatted HTML of %s output with Bioperl Bio::SearchIO system
697            
698            
699            
700            
701            
702            
703             },$result->algorithm,$Revision);
704            
705             }
706              
707             =head2 title
708              
709             Title : title
710             Usage : $self->title($CODE)
711              
712             Function: Stores or returns the code to provide HTML for the given
713             BLAST report that will appear at the top of the BLAST report
714             HTML output. Useful for (for instance) specifying
715             alternative routines to write your own titles.
716             Returns \&default_title (see below) if not
717             set.
718             Example : $index->title( \&my_title )
719             Returns : ref to CODE if called without arguments
720             Args : CODE
721              
722             =cut
723              
724             sub title {
725 1     1 1 2 my( $self, $code ) = @_;
726 1 50       3 if ($code) {
727 0         0 $self->{'_title'} = $code;
728             }
729 1   50     7 return $self->{'_title'} || \&default_title;
730             }
731              
732             =head2 default_title
733              
734             Title : default_title
735             Usage : $self->default_title($result)
736             Function: Provides HTML for the given BLAST report that will appear
737             at the top of the BLAST report HTML output.
738             Returns : string containing HTML markup
739             The default implementation returns

HTML

740             containing text such as:
741             "Bioperl Reformatted HTML of BLASTP Search Report
742             for gi|1786183|gb|AAC73113.1|"
743             Args : First argument is a Bio::Search::Result::ResultI
744              
745             =cut
746              
747             sub default_title {
748 1     1 1 1 my ($result) = @_;
749              
750 1         4 return sprintf(
751             qq{

Bioperl Reformatted HTML of %s Search Report
for %s

},
752             $result->algorithm,
753             $result->query_name());
754             }
755              
756              
757             =head2 introduction
758              
759             Title : introduction
760             Usage : $self->introduction($CODE)
761              
762             Function: Stores or returns the code to provide HTML for the given
763             BLAST report detailing the query and the
764             database information.
765             Useful for (for instance) specifying
766             routines returning alternative introductions.
767             Returns \&default_introduction (see below) if not
768             set.
769             Example : $index->introduction( \&my_introduction )
770             Returns : ref to CODE if called without arguments
771             Args : CODE
772              
773             =cut
774              
775             sub introduction {
776 1     1 1 2 my( $self, $code ) = @_;
777 1 50       2 if ($code) {
778 0         0 $self->{'_introduction'} = $code;
779             }
780 1   50     6 return $self->{'_introduction'} || \&default_introduction;
781             }
782              
783             =head2 default_introduction
784              
785             Title : default_introduction
786             Usage : $self->default_introduction($result)
787             Function: Outputs HTML to provide the query
788             and the database information
789             Returns : string containing HTML
790             Args : First argument is a Bio::Search::Result::ResultI
791             Second argument is string holding literature citation
792              
793             =cut
794              
795             sub default_introduction {
796 1     1 1 2 my ($result) = @_;
797              
798 1         2 return sprintf(
799             qq{
800             Query= %s %s
(%s letters)
801            

802             Database: %s
%s sequences; %s total letters

803            

804             },
805             $result->query_name,
806             $result->query_description,
807             &_numwithcommas($result->query_length),
808             $result->database_name(),
809             &_numwithcommas($result->database_entries()),
810             &_numwithcommas($result->database_letters()),
811             );
812             }
813              
814             =head2 end_report
815              
816             Title : end_report
817             Usage : $self->end_report()
818             Function: The method to call when ending a report, this is
819             mostly for cleanup for formats which require you to
820             have something at the end of the document ()
821             for HTML
822             Returns : string
823             Args : none
824              
825             =cut
826              
827             sub end_report {
828 1     1 1 3 return "\n\n";
829             }
830              
831             # copied from Bio::Index::Fasta
832             # useful here as well
833              
834             =head2 id_parser
835              
836             Title : id_parser
837             Usage : $index->id_parser( CODE )
838             Function: Stores or returns the code used by record_id to
839             parse the ID for record from a string. Useful
840             for (for instance) specifying a different
841             parser for different flavours of FASTA file.
842             Returns \&default_id_parser (see below) if not
843             set. If you supply your own id_parser
844             subroutine, then it should expect a fasta
845             description line. An entry will be added to
846             the index for each string in the list returned.
847             Example : $index->id_parser( \&my_id_parser )
848             Returns : ref to CODE if called without arguments
849             Args : CODE
850              
851             =cut
852              
853             sub id_parser {
854 60     60 1 54 my( $self, $code ) = @_;
855            
856 60 50       71 if ($code) {
857 0         0 $self->{'_id_parser'} = $code;
858             }
859 60   50     196 return $self->{'_id_parser'} || \&default_id_parser;
860             }
861              
862              
863              
864             =head2 default_id_parser
865              
866             Title : default_id_parser
867             Usage : $id = default_id_parser( $header )
868             Function: The default Fasta ID parser for Fasta.pm
869             Returns $1 from applying the regexp /^>\s*(\S+)/
870             to $header.
871             Returns : ID string
872             The default implementation checks for NCBI-style
873             identifiers in the given string ('gi|12345|AA54321').
874             For these IDs, it extracts the GI and accession and
875             returns a two-element list of strings (GI, acc).
876             Args : a fasta header line string
877              
878             =cut
879              
880             sub default_id_parser {
881 60     60 1 54 my ($string) = @_;
882 60         34 my ($gi,$acc);
883 60 50       101 if( $string =~ s/gi\|(\d+)\|?// )
884 0         0 { $gi = $1; $acc = $1;}
  0         0  
885            
886 60 50       198 if( $string =~ /(\w+)\|([A-Z\d\.\_]+)(\|[A-Z\d\_]+)?/ ) {
887 60 50       130 $acc = defined $2 ? $2 : $1;
888             } else {
889 0         0 $acc = $string;
890 0         0 $acc =~ s/^\s+(\S+)/$1/;
891 0         0 $acc =~ s/(\S+)\s+$/$1/;
892             }
893 60         81 return ($gi,$acc);
894             }
895            
896 0 0   0 0 0 sub MIN { $a <=> $b ? $a : $b; }
897 0 0   0 0 0 sub MAX { $a <=> $b ? $b : $a; }
898              
899             sub footer {
900 1     1 0 1 my ($self) = @_;
901 1         6 return "
Produced by Bioperl module ".ref($self)." on $DATE
Revision: $Revision
\n"
902            
903             }
904              
905             =head2 algorithm_reference
906              
907             Title : algorithm_reference
908             Usage : my $reference = $writer->algorithm_reference($result);
909             Function: Returns the appropriate Bibliographic reference for the
910             algorithm format being produced
911             Returns : String
912             Args : L to reference
913              
914              
915             =cut
916              
917             sub algorithm_reference {
918 0     0 1 0 my ($self,$result) = @_;
919 0 0 0     0 return '' if( ! defined $result || !ref($result) ||
      0        
920             ! $result->isa('Bio::Search::Result::ResultI')) ;
921 0 0       0 if( $result->algorithm =~ /BLAST/i ) {
    0          
922 0         0 my $res = $result->algorithm . ' ' . $result->algorithm_version . "

";

923 0 0       0 if( $result->algorithm_version =~ /WashU/i ) {
924 0         0 return $res .
925             "Copyright (C) 1996-2000 Washington University, Saint Louis, Missouri USA.
926             All Rights Reserved.

927             Reference: Gish, W. (1996-2000) http://blast.wustl.edu

";

928             } else {
929 0         0 return $res .
930             "Reference: Altschul, Stephen F., Thomas L. Madden, Alejandro A. Schaffer,
931             Jinghui Zhang, Zheng Zhang, Webb Miller, and David J. Lipman (1997),
932             \"Gapped BLAST and PSI-BLAST: a new generation of protein database search
933             programs\", Nucleic Acids Res. 25:3389-3402.

";

934              
935             }
936             } elsif( $result->algorithm =~ /FAST/i ) {
937 0         0 return $result->algorithm . " " . $result->algorithm_version . "
" .
938             "\nReference: Pearson et al, Genomics (1997) 46:24-36

";

939             } else {
940 0         0 return '';
941             }
942             }
943              
944             # from Perl Cookbook 2.17
945             sub _numwithcommas {
946 23     23   26 my $num = reverse( $_[0] );
947 23         129 $num =~ s/(\d{3})(?=\d)(?!\d*\.)/$1,/g;
948 23         116 return scalar reverse $num;
949             }
950              
951             =head2 Methods Bio::SearchIO::SearchWriterI
952              
953             L inherited methods.
954              
955             =head2 filter
956              
957             Title : filter
958             Usage : $writer->filter('hsp', \&hsp_filter);
959             Function: Filter out either at HSP,Hit,or Result level
960             Returns : none
961             Args : string => data type,
962             CODE reference
963              
964              
965             =cut
966              
967              
968             =head2 no_wublastlinks
969              
970             Title : no_wublastlinks
971             Usage : $obj->no_wublastlinks($newval)
972             Function: Get/Set boolean value regarding whether or not to display
973             Link = (1)
974             type output in the report output (WU-BLAST only)
975             Returns : boolean
976             Args : on set, new boolean value (a scalar or undef, optional)
977              
978              
979             =cut
980              
981             sub no_wublastlinks{
982 2     2 1 2 my $self = shift;
983              
984 2 100       7 return $self->{'no_wublastlinks'} = shift if @_;
985 1         2 return $self->{'no_wublastlinks'};
986             }
987              
988             1;