Bio/Search/HSP/PSLHSP.pm

   1 #
   2 # BioPerl module for Bio::Search::HSP::PSLHSP
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # Cared for by Jason Stajich <jason-at-bioperl-dot-org>
   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<bioperl-l@bioperl.org>
  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 use strict;
  73
  74 # Object preamble - inherits from Bio::Root::Root
  75
  76
  77 use base qw(Bio::Search::HSP::GenericHSP);
  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     my ($class,@args) = @_;
  93     my $self = $class->SUPER::new(@args);
  94     my ($qgaplocs,
  95         $hgaplocs,
  96         $mismatches) = $self->_rearrange([qw(QUERY_GAPBLOCKS
  97                                              HIT_GAPBLOCKS
  98                                              MISMATCHES)],
  99                                        @args);
 100     $self->gap_blocks('query',$qgaplocs) if defined $qgaplocs;
 101     $self->gap_blocks('hit',  $hgaplocs) if defined $hgaplocs;
 102     $self->mismatches($mismatches) if defined $mismatches;
 103     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     my ($self,$seqtype,$blocks) = @_;
 120     if( ! defined $seqtype ) { $seqtype = 'query' }
 121     $seqtype = lc($seqtype);
 122     $seqtype = 'hit' if $seqtype eq 'sbjct';
 123     if( $seqtype !~ /query|hit/i ) {
 124         $self->warn("Expect either 'query' or 'hit' as argument 1 for gap_blocks");
 125     }
 126
 127     unless( defined $blocks ) {
 128         return $self->{'_gap_blocks'}->{$seqtype};
 129     } else {
 130         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     my $self = shift;
 147     return $self->{'mismatches'} = shift if @_;
 148     return $self->{'mismatches'};
 149 }
 150
 151 1;