File Coverage

Bio/Search/HSP/PSLHSP.pm
Criterion Covered Total %
statement 23 26 88.4
branch 9 16 56.2
condition n/a
subroutine 5 5 100.0
pod 3 3 100.0
total 40 50 80.0


line stmt bran cond sub pod time code
1             #
2             # BioPerl module for Bio::Search::HSP::PSLHSP
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             # POD documentation - main docs before the code
13              
14             =head1 NAME
15              
16             Bio::Search::HSP::PSLHSP - A HSP for PSL output
17              
18             =head1 SYNOPSIS
19              
20             # get a PSLHSP somehow (SearchIO::psl)
21              
22             =head1 DESCRIPTION
23              
24             This is a HSP for PSL output so we can handle seq_inds differently.
25              
26             =head1 FEEDBACK
27              
28             =head2 Mailing Lists
29              
30             User feedback is an integral part of the evolution of this and other
31             Bioperl modules. Send your comments and suggestions preferably to
32             the Bioperl mailing list. Your participation is much appreciated.
33              
34             bioperl-l@bioperl.org - General discussion
35             http://bioperl.org/wiki/Mailing_lists - About the mailing lists
36              
37             =head2 Support
38              
39             Please direct usage questions or support issues to the mailing list:
40              
41             I
42              
43             rather than to the module maintainer directly. Many experienced and
44             reponsive experts will be able look at the problem and quickly
45             address it. Please include a thorough description of the problem
46             with code and data examples if at all possible.
47              
48             =head2 Reporting Bugs
49              
50             Report bugs to the Bioperl bug tracking system to help us keep track
51             of the bugs and their resolution. Bug reports can be submitted via
52             the web:
53              
54             https://github.com/bioperl/bioperl-live/issues
55              
56             =head1 AUTHOR - Jason Stajich
57              
58             Email jason-at-bioperl-dot-org
59              
60             =head1 APPENDIX
61              
62             The rest of the documentation details each of the object methods.
63             Internal methods are usually preceded with a _
64              
65             =cut
66              
67              
68             # Let the code begin...
69              
70              
71             package Bio::Search::HSP::PSLHSP;
72 1     1   4 use strict;
  1         2  
  1         26  
73              
74             # Object preamble - inherits from Bio::Root::Root
75              
76              
77 1     1   4 use base qw(Bio::Search::HSP::GenericHSP);
  1         1  
  1         263  
78              
79             =head2 new
80              
81             Title : new
82             Usage : my $obj = Bio::Search::HSP::PSLHSP->new();
83             Function: Builds a new Bio::Search::HSP::PSLHSP object
84             Returns : an instance of Bio::Search::HSP::PSLHSP
85             Args : -gapblocks => arrayref of gap locations which are [start,length]
86             of gaps
87              
88              
89             =cut
90              
91             sub new {
92 5     5 1 30 my ($class,@args) = @_;
93 5         19 my $self = $class->SUPER::new(@args);
94 5         18 my ($qgaplocs,
95             $hgaplocs,
96             $mismatches) = $self->_rearrange([qw(QUERY_GAPBLOCKS
97             HIT_GAPBLOCKS
98             MISMATCHES)],
99             @args);
100 5 50       18 $self->gap_blocks('query',$qgaplocs) if defined $qgaplocs;
101 5 50       13 $self->gap_blocks('hit', $hgaplocs) if defined $hgaplocs;
102 5 50       16 $self->mismatches($mismatches) if defined $mismatches;
103 5         35 return $self;
104             }
105              
106             =head2 gap_blocks
107              
108             Title : gap_blocks
109             Usage : $obj->gap_blocks($seqtype,$blocks)
110             Function: Get/Set the gap blocks
111             Returns : value of gap_blocks (a scalar)
112             Args : sequence type - 'query' or 'hit'
113             blocks - arrayref of block start,length
114              
115              
116             =cut
117              
118             sub gap_blocks {
119 14     14 1 15 my ($self,$seqtype,$blocks) = @_;
120 14 50       22 if( ! defined $seqtype ) { $seqtype = 'query' }
  0         0  
121 14         13 $seqtype = lc($seqtype);
122 14 50       24 $seqtype = 'hit' if $seqtype eq 'sbjct';
123 14 50       59 if( $seqtype !~ /query|hit/i ) {
124 0         0 $self->warn("Expect either 'query' or 'hit' as argument 1 for gap_blocks");
125             }
126              
127 14 100       18 unless( defined $blocks ) {
128 4         232 return $self->{'_gap_blocks'}->{$seqtype};
129             } else {
130 10         33 return $self->{'_gap_blocks'}->{$seqtype} = $blocks;
131             }
132             }
133              
134             =head2 mismatches
135              
136             Title : mismatches
137             Usage : $obj->mismatches($newval)
138             Function: Get/Set the number of mismatches
139             Returns : value of mismatches (a scalar)
140             Args : on set, new value (a scalar or undef, optional)
141              
142              
143             =cut
144              
145             sub mismatches{
146 5     5 1 4 my $self = shift;
147 5 50       11 return $self->{'mismatches'} = shift if @_;
148 0           return $self->{'mismatches'};
149             }
150              
151             1;