Bio/Tools/HMMER/Domain.pm

   1 # $Id$
   2 #
   3 # BioPerl module for Bio::Tools::HMMER::Domain
   4 #
   5 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   6 #
   7 # Cared for by Ewan Birney <birney@sanger.ac.uk>
   8 #
   9 # Copyright Ewan Birney
  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::Tools::HMMER::Domain - One particular domain hit from HMMER
  18
  19 =head1 SYNOPSIS
  20
  21 Read the Bio::Tools::HMMER::Results docs
  22
  23 =head1 DESCRIPTION
  24
  25 A particular domain score. We reuse the Homol SeqFeature system
  26 here, so this inherits off Homol SeqFeature. As this code
  27 originally came from a separate project, there are some backward
  28 compatibility stuff provided to keep this working with old code.
  29
  30 Don't forget this inherits off Bio::SeqFeature, so all your usual
  31 nice start/end/score stuff is ready for use.
  32
  33 =head1 CONTACT
  34
  35 Ewan Birney, birney@ebi.ac.uk
  36
  37 =head1 CONTRIBUTORS
  38
  39 Jason Stajich, jason@bioperl.org
  40
  41 =head1 APPENDIX
  42
  43 The rest of the documentation details each of the object
  44 methods. Internal methods are usually preceded with a _
  45
  46 =cut
  47
  48 #'
  49 package Bio::Tools::HMMER::Domain;
  50
  51 use Bio::SeqFeature::Generic;
  52 use strict;
  53
  54
  55 use base qw(Bio::SeqFeature::FeaturePair);
  56
  57 sub new {
  58   my($class,@args) = @_;
  59   my $self = $class->SUPER::new(@args);
  60
  61   $self->{'alignlines'} = [];
  62
  63   my $hmmf1 = Bio::SeqFeature::Generic->new(@args);
  64   my $hmmf2 = Bio::SeqFeature::Generic->new(@args);
  65
  66   $self->feature1($hmmf1);
  67   $self->feature2($hmmf2);
  68
  69   return $self;
  70 }
  71
  72 =head2 add_alignment_line
  73
  74  Title   : add_alignment_line
  75  Usage   : $domain->add_alignment_line($line_from_hmmer_output);
  76  Function: add an alignment line to this Domain object
  77  Returns : Nothing
  78  Args    : scalar
  79
  80  Adds an alignment line, mainly for storing the HMMER alignments
  81 as flat text which can be reguritated. You're right. This is *not
  82 nice* and not the right way to do it.  C'est la vie.
  83
  84 =cut
  85
  86 sub add_alignment_line {
  87     my $self = shift;
  88     my $line = shift;
  89     push(@{$self->{'alignlines'}},$line);
  90 }
  91
  92 =head2 each_alignment_line
  93
  94  Title   : each_alignment_line
  95  Usage   : foreach $line ( $domain->each_alignment_line )
  96  Function: reguritates the alignment lines as they were fed in.
  97            only useful realistically for printing.
  98  Example :
  99  Returns :
 100  Args    : None
 101
 102
 103 =cut
 104
 105 sub each_alignment_line {
 106     my $self = shift;
 107     return @{$self->{'alignlines'}};
 108 }
 109
 110 =head2 get_nse
 111
 112  Title   : get_nse
 113  Usage   : $domain->get_nse()
 114  Function: Provides a seqname/start-end format, useful
 115            for unique keys. nse stands for name-start-end
 116            It is used alot in Pfam
 117  Example :
 118  Returns : A string
 119  Args    : Optional seperator 1 and seperator 2 (default / and -)
 120
 121
 122 =cut
 123
 124
 125
 126 sub get_nse {
 127     my $self = shift;
 128     my $sep1 = shift;
 129     my $sep2 = shift;
 130
 131     if( !defined $sep2 ) {
 132         $sep2 = "-";
 133     }
 134     if( !defined $sep1 ) {
 135         $sep1 = "/";
 136     }
 137
 138     return sprintf("%s%s%d%s%d",$self->seq_id,$sep1,$self->start,$sep2,$self->end);
 139 }
 140
 141
 142 #  =head2 start_seq
 143
 144 #   Title   : start_seq
 145 #   Usage   : Backward compatibility with old HMMER modules.
 146 #             should use $domain->start
 147 #   Function:
 148 #   Example :
 149 #   Returns :
 150 #   Args    :
 151
 152 #  =cut
 153
 154 sub start_seq {
 155     my $self = shift;
 156     my $start = shift;
 157
 158     $self->warn("Using old domain->start_seq. Should use domain->start");
 159     return $self->start($start);
 160 }
 161
 162 #  =head2 end_seq
 163
 164 #   Title   : end_seq
 165 #   Usage   : Backward compatibility with old HMMER modules.
 166 #             should use $domain->end
 167 #   Function:
 168 #   Example :
 169 #   Returns :
 170 #   Args    :
 171
 172 #  =cut
 173
 174 sub end_seq {
 175     my $self = shift;
 176     my $end = shift;
 177
 178     $self->warn("Using old domain->end_seq. Should use domain->end");
 179     return $self->end($end);
 180 }
 181
 182 #  =head2 start_hmm
 183
 184 #   Title   : start_hmm
 185 #   Usage   : Backward compatibility with old HMMER modules, and
 186 #             for convience. Equivalent to $self->homol_SeqFeature->start
 187 #   Function:
 188 #   Example :
 189 #   Returns :
 190 #   Args    :
 191
 192 #  =cut
 193
 194 sub start_hmm {
 195     my $self = shift;
 196     my $start = shift;
 197     $self->warn("Using old domain->start_hmm. Should use domain->hstart");
 198     return $self->hstart($start);
 199 }
 200
 201 #  =head2 end_hmm
 202
 203 #   Title   : end_hmm
 204 #   Usage   : Backward compatibility with old HMMER modules, and
 205 #             for convience. Equivalent to $self->homol_SeqFeature->start
 206 #   Function:
 207 #   Example :
 208 #   Returns :
 209 #   Args    :
 210
 211 #  =cut
 212
 213 sub end_hmm {
 214     my $self = shift;
 215     my $end = shift;
 216
 217     $self->warn("Using old domain->end_hmm. Should use domain->hend");
 218     return $self->hend($end);
 219 }
 220
 221 =head2 hmmacc
 222
 223  Title   : hmmacc
 224  Usage   : $domain->hmmacc($newacc)
 225  Function: set get for HMM accession number. This is placed in the homol
 226            feature of the HMM
 227  Example :
 228  Returns :
 229  Args    :
 230
 231
 232 =cut
 233
 234 sub hmmacc{
 235    my ($self,$acc) = @_;
 236    if( defined $acc ) {
 237        $self->feature2->add_tag_value('accession',$acc);
 238    }
 239    my @vals = $self->feature2->each_tag_value('accession');
 240    return shift @vals;
 241 }
 242
 243 =head2 hmmname
 244
 245  Title   : hmmname
 246  Usage   : $domain->hmmname($newname)
 247  Function: set get for HMM accession number. This is placed in the homol
 248            feature of the HMM
 249  Example :
 250  Returns :
 251  Args    :
 252
 253 =cut
 254
 255 sub hmmname {
 256     return shift->hseq_id(@_);
 257 }
 258
 259 =head2 bits
 260
 261  Title   : bits
 262  Usage   :
 263  Function: backward compatibility. Same as score
 264  Example :
 265  Returns :
 266  Args    :
 267
 268 =cut
 269
 270 sub bits{
 271    return shift->score(@_);
 272 }
 273
 274 =head2 evalue
 275
 276  Title   : evalue
 277  Usage   :
 278  Function: $domain->evalue($value);
 279  Example :
 280  Returns :
 281  Args    :
 282
 283 =cut
 284
 285 sub evalue{
 286     return shift->_tag_value('evalue',@_);
 287 }
 288
 289 =head2 seqbits
 290
 291  Title   : seqbits
 292  Usage   :
 293  Function: $domain->seqbits($value);
 294  Example :
 295  Returns :
 296  Args    :
 297
 298 =cut
 299
 300 sub seqbits {
 301     return shift->_tag_value('seqbits',@_);
 302 }
 303
 304 =head2 seq_range
 305
 306  Title   : seq_range
 307  Usage   :
 308  Function: Throws an exception to catch scripts which need to upgrade
 309  Example :
 310  Returns :
 311  Args    :
 312
 313 =cut
 314
 315 sub seq_range{
 316    my ($self,@args) = @_;
 317
 318    $self->throw("You have accessed an old method. Please recode your script to the new bioperl HMMER module");
 319 }
 320
 321 =head2 hmm_range
 322
 323  Title   : hmm_range
 324  Usage   :
 325  Function: Throws an exception to catch scripts which need to upgrade
 326  Example :
 327  Returns :
 328  Args    :
 329
 330
 331 =cut
 332
 333 sub hmm_range{
 334    my ($self,@args) = @_;
 335
 336    $self->throw("You have accessed an old method. Please recode your script to the new bioperl HMMER module");
 337 }
 338
 339 1;  # says use was ok
 340 __END__
 341
 342
 343