Bio/Search/HSP/PSLHSP.pm

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