← Back to branch summary

~ubuntu-branches/ubuntu/trusty/bioperl/trusty-proposed

« back to all changes in this revision

Viewing changes to Bio/SearchIO/Writer/HTMLResultWriter.pm

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2009-03-10 07:19:11 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20090310071911-fukqzw54pyb1f0bd
Tags: 1.6.0-2
https://launchpad.net/bugs/324001
* Removed patch system (not used):
  - removed instuctions in debian/rules;
  - removed quilt from Build-Depends in debian/control.
* Re-enabled tests:
  - uncommented test command in debian/rules;
  - uncommented previously missing build-dependencies in debian/control.
  - Re-enabled tests and uncommented build-dependencies accordingly.
* Removed libmodule-build-perl and libtest-harness-perl from
  Build-Depends-Indep (provided by perl-modules).
* Better cleaning of empty directories using find -type d -empty -delete
  instead of rmdir in debian/rules (LP: #324001).

Show diffs side-by-side

added added

removed removed

Lines of Context:
Bio/SearchIO/Writer/HTMLResultWriter.pm
1
 
# $Id: HTMLResultWriter.pm,v 1.38.4.1 2006/10/02 23:10:27 sendu Exp $
 
1
# $Id: HTMLResultWriter.pm 14697 2008-06-04 14:22:22Z heikki $
2
2
#
3
3
# BioPerl module for Bio::SearchIO::Writer::HTMLResultWriter
4
4
#
22
22
  use Bio::SearchIO;
23
23
  use Bio::SearchIO::Writer::HTMLResultWriter;
24
24
 
25
 
  my $in = new Bio::SearchIO(-format => 'blast',
 
25
  my $in = Bio::SearchIO->new(-format => 'blast',
26
26
                             -file   => shift @ARGV);
27
27
 
28
 
  my $writer = new Bio::SearchIO::Writer::HTMLResultWriter();
29
 
  my $out = new Bio::SearchIO(-writer => $writer);
 
28
  my $writer = Bio::SearchIO::Writer::HTMLResultWriter->new();
 
29
  my $out = Bio::SearchIO->new(-writer => $writer);
30
30
  $out->write_result($in->next_result);
31
31
 
32
32
 
41
41
      return $hsp->num_hits > 0;
42
42
  }
43
43
 
44
 
  my $writer = new Bio::SearchIO::Writer::HTMLResultWriter
 
44
  my $writer = Bio::SearchIO::Writer::HTMLResultWriter->new
45
45
                     (-filters => { 'HSP' => \&hsp_filter} );
46
 
  my $out = new Bio::SearchIO(-writer => $writer);
 
46
  my $out = Bio::SearchIO->new(-writer => $writer);
47
47
  $out->write_result($in->next_result);
48
48
 
49
49
  # can also set the filter via the writer object
52
52
=head1 DESCRIPTION
53
53
 
54
54
This object implements the SearchWriterI interface which will produce
55
 
a set of HTML for a specific L<Bio::Search::Report::ReportI interface>.
 
55
a set of HTML for a specific L<Bio::Search::Report::ReportI> interface.
56
56
 
57
57
See L<Bio::SearchIO::SearchWriterI> for more info on the filter method.
58
58
 
99
99
# Object preamble - inherits from Bio::Root::RootI
100
100
 
101
101
BEGIN {
102
 
    $Revision = '$Id: HTMLResultWriter.pm,v 1.38.4.1 2006/10/02 23:10:27 sendu Exp $';
 
102
    $Revision = '$Id: HTMLResultWriter.pm 14697 2008-06-04 14:22:22Z heikki $';
103
103
    $DATE = localtime(time);
104
104
    %RemoteURLDefault = ( 
105
105
      'PROTEIN' => 'http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?db=protein&cmd=search&term=%s',                         
115
115
=head2 new
116
116
 
117
117
 Title   : new
118
 
 Usage   : my $obj = new Bio::SearchIO::Writer::HTMLResultWriter();
 
118
 Usage   : my $obj = Bio::SearchIO::Writer::HTMLResultWriter->new();
119
119
 Function: Builds a new Bio::SearchIO::Writer::HTMLResultWriter object 
120
120
 Returns : Bio::SearchIO::Writer::HTMLResultWriter
121
121
 Args    : -filters => hashref with any or all of the keys (HSP HIT RESULT)
208
208
 
209
209
    my ($qtype,$dbtype,$dbseqtype,$type);
210
210
    my $alg = $result->algorithm;
211
 
 
212
211
    # This is actually wrong for the FASTAs I think
213
212
    if(  $alg =~ /T(FAST|BLAST)([XY])/i ) {
214
213
        $qtype      = $dbtype = 'translated';
239
238
                     'Query:'   => ( $qtype  eq 'translated' )  ? 3 : 1);
240
239
 
241
240
    my $str;
242
 
    if( ! defined $num || $num <= 1 ) { 
 
241
    if( $num <= 1 ) { 
243
242
        $str = &{$self->start_report}($result);
244
243
    }
245
244
 
282
281
            # no HSPs so no link 
283
282
            $str .= sprintf('<tr><td>%s %s</td><td>%s</td><td>%.2g</td></tr>'."\n",
284
283
                            $url_desc, $descsub, 
285
 
                            ($hit->raw_score ? $hit->raw_score : 
286
 
                             (defined $hsps[0] ? $hsps[0]->score : ' ')),
 
284
                            ($hit->bits ? $hit->bits : 
 
285
                             (defined $hsps[0] ? $hsps[0]->bits : ' ')),
287
286
                            ( $hit->significance ? $hit->significance :
288
287
                              (defined $hsps[0] ? $hsps[0]->evalue : ' ')) 
289
288
                            );
293
292
 
294
293
            $str .= sprintf('<tr><td>%s %s</td><td>%s</td><td><a href="#%s">%.2g</a></td></tr>'."\n",
295
294
                            $url_desc, $descsub, 
296
 
                            ($hit->raw_score ? $hit->raw_score : 
297
 
                             (defined $hsps[0] ? $hsps[0]->score : ' ')),
 
295
                            ($hit->bits ? $hit->bits : 
 
296
                             (defined $hsps[0] ? $hsps[0]->bits : ' ')),
298
297
                            $acc,
299
298
                            ( $hit->significance ? $hit->significance :
300
299
                              (defined $hsps[0] ? $hsps[0]->evalue : ' ')) 
301
300
                            );
 
301
        my $dline = &{$self->hit_desc_line}($self, $hit, $result);
302
302
            $hspstr .= "<a name=\"$acc\">\n".
303
 
                sprintf("><b>%s</b> %s\n<dd>Length = %s</dd><p>\n\n", $url_align, 
304
 
                        defined $hit->description ? $hit->description : '', 
305
 
                        &_numwithcommas($hit->length));
 
303
                sprintf("><b>%s</b> %s</br><dd>Length = %s</dd><p>\n\n", $url_align, 
 
304
                        $dline , &_numwithcommas($hit->length));
306
305
            my $ct = 0;
307
306
            foreach my $hsp (@hsps ) {
308
307
                next if( $hspfilter && ! &{$hspfilter}($hsp) );
417
416
                                                    length($hspvals[2]->{'start'}),
418
417
                                                    length($hspvals[2]->{'end'}));
419
418
                my $count = 0;
420
 
                while ( $count <= $hsp->length('total') ) {
 
419
                while ( $count < $hsp->length('total') ) {
421
420
                    foreach my $v ( @hspvals ) {
422
421
                        my $piece = substr($v->{'seq'}, $v->{'index'} + $count,
423
422
                                           $AlignmentLineWidth);
453
452
#       $hspstr .= "</pre>\n";
454
453
    }
455
454
 
456
 
 
457
 
    # make table of search statistics and end the web page
458
 
    $str .= "</table><p>\n".$hspstr."<p><p><hr><h2>Search Parameters</h2><table border=1><tr><th>Parameter</th><th>Value</th>\n";
 
455
    $str .= "</table><p>\n".$hspstr;
 
456
    my ($pav, $sav) = ($result->available_parameters, $result->available_statistics);
 
457
    if ($pav || $sav) {
 
458
        # make table of search statistics and end the web page
 
459
        $str .= "<p><p><hr><h2>Search Parameters</h2>";
 
460
        if ($pav) {
 
461
        $str .= "<table border=1><tr><th>Parameter</th><th>Value</th>\n";
 
462
        foreach my $param ( sort $result->available_parameters ) {
 
463
            $str .= "<tr><td>$param</td><td>". $result->get_parameter($param) ."</td></tr>\n";
 
464
        }
 
465
        $str .= "</table>";
 
466
        }
459
467
        
460
 
    foreach my $param ( sort $result->available_parameters ) {
461
 
        $str .= "<tr><td>$param</td><td>". $result->get_parameter($param) ."</td></tr>\n";
462
 
        
463
 
    }
464
 
    $str .= "</table><p><h2>Search Statistics</h2><table border=1><tr><th>Statistic</th><th>Value</th></tr>\n";
465
 
    foreach my $stat ( sort $result->available_statistics ) {
466
 
        $str .= "<tr><td>$stat</td><td>". $result->get_statistic($stat). "</td></tr>\n";
467
 
    }
468
 
    $str .=  "</table><P>".$self->footer() . "<P>\n";
 
468
        if ($sav) {
 
469
        $str .= "<p><h2>Search Statistics</h2><table border=1><tr><th>Statistic</th><th>Value</th></tr>\n";
 
470
        foreach my $stat ( sort $result->available_statistics ) {
 
471
            $str .= "<tr><td>$stat</td><td>". $result->get_statistic($stat). "</td>\n";
 
472
        }
 
473
        $str .=  "</tr></table>";
 
474
        }
 
475
    }
 
476
    $str .= $self->footer() . "<P>\n";
469
477
    return $str;
470
478
}
471
479
 
495
503
 
496
504
=head2 default_hit_link_desc
497
505
 
498
 
 Title   : defaulthit_link_desc
 
506
 Title   : default_hit_link_desc
499
507
 Usage   : $self->default_hit_link_desc($hit, $result)
500
508
 Function: Provides an HTML link(s) for the given hit to be used
501
509
           within the description section at the top of the BLAST report.
559
567
    return $self->{'_hit_link_align'} || \&default_hit_link_desc;
560
568
}
561
569
 
 
570
=head2 hit_desc_line
 
571
 
 
572
 Title   : hit_desc_line
 
573
 Usage   : $self->hit_desc_line(\&link_function);
 
574
 Function: Get/Set the function which provides HTML for the description
 
575
           information from a hit. This allows one to parse
 
576
           the rest of the description and split up lines, add links, etc.
 
577
 Returns : Function reference
 
578
 Args    : Function reference
 
579
 See Also: L<default_hit_link_desc()>
 
580
 
 
581
=cut
 
582
 
 
583
sub hit_desc_line{
 
584
    my( $self, $code ) = @_; 
 
585
    if ($code) {
 
586
        $self->{'_hit_desc_line'} = $code;
 
587
    }
 
588
    return $self->{'_hit_desc_line'} || \&default_hit_desc_line;
 
589
}
 
590
 
 
591
=head2 default_hit_desc_line
 
592
 
 
593
 Title   : default_hit_desc_line
 
594
 Usage   : $self->default_hit_desc_line($hit, $result)
 
595
 Function: Parses the description line information, splits based on the
 
596
           hidden \x01 between independent descriptions, checks the lines for
 
597
           possible web links, and adds HTML link(s) for the given hit to be
 
598
           used.
 
599
 
 
600
 Returns : string containing HTML markup "<a href...")
 
601
           The default implementation returns an HTML link to the
 
602
           URL supplied by the remote_database_url() method
 
603
           and using the identifier supplied by the id_parser() method.
 
604
           It will use the NCBI GI if present, and the accession if not.
 
605
 
 
606
 Args    : First argument is a Bio::Search::Hit::HitI
 
607
           Second argument is a Bio::Search::Result::ResultI
 
608
 
 
609
See Also: L<hit_link_align>, L<remote_database>, L<id_parser>
 
610
 
 
611
=cut
 
612
 
 
613
sub default_hit_desc_line {
 
614
    my($self, $hit, $result) = @_;
 
615
    my $type = ( $result->algorithm =~ /(P|X|Y)$/i ) ? 'PROTEIN' : 'NUCLEOTIDE';
 
616
    my @descs = split /\x01/, $hit->description;
 
617
    #my $descline = join("</br>",@descs)."</br>";
 
618
    my $descline = '';
 
619
    #return $descline;
 
620
    for my $sec (@descs) {
 
621
        my $url = '';
 
622
        if ($sec =~ s/((?:gi\|(\d+)\|)?        # optional GI
 
623
                     (\w+)\|([A-Z\d\.\_]+) # main 
 
624
                     (\|[A-Z\d\_]+)?) # optional secondary ID//xms) {
 
625
            my ($name, $gi, $db, $acc) = ($1, $2, $3, $4);
 
626
            #$acc ||= ($rest) ? $rest : $gi;
 
627
            $acc =~ s/^\s+(\S+)/$1/;
 
628
            $acc =~ s/(\S+)\s+$/$1/;
 
629
            $url =
 
630
            length($self->remote_database_url($type)) > 0 ? 
 
631
              sprintf('<a href="%s">%s</a> %s',
 
632
                      sprintf($self->remote_database_url($type),
 
633
                      $gi || $acc || $db), 
 
634
                      $name, $sec) :  $sec;
 
635
        } else {
 
636
            $url = $sec;
 
637
        }
 
638
        $descline .= "$url</br>\n";
 
639
    }
 
640
    return $descline;
 
641
}
 
642
 
562
643
=head2 start_report
563
644
 
564
645
  Title   : start_report