diff variant_effect_predictor/Bio/Tools/HMMER/Domain.pm @ 0:1f6dce3d34e0

Uploaded

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/variant_effect_predictor/Bio/Tools/HMMER/Domain.pm	Thu Apr 11 02:01:53 2013 -0400
@@ -0,0 +1,363 @@
+# $Id: Domain.pm,v 1.11 2002/10/08 08:38:34 lapp Exp $
+#
+# BioPerl module for Bio::Tools::HMMER::Domain
+#
+# Cared for by Ewan Birney <[e-mail]>
+#
+# Copyright Ewan Birney
+#
+# You may distribute this module under the same terms as perl itself
+
+# POD documentation - main docs before the code
+
+=head1 NAME
+
+Bio::Tools::HMMER::Domain - One particular domain hit from HMMER 
+
+=head1 SYNOPSIS
+
+Read the Bio::Tools::HMMER::Results docs
+
+=head1 DESCRIPTION
+
+A particular domain score. We reuse the Homol SeqFeature system
+here, so this inherits off Homol SeqFeature. As this code
+originally came from a separate project, there are some backward
+compatibility stuff provided to keep this working with old code.
+
+Don't forget this inherits off Bio::SeqFeature, so all your usual
+nice start/end/score stuff is ready for use.
+
+=head1 CONTACT
+
+Ewan Birney, [e-mail]
+
+=head1 CONTRIBUTORS
+
+Jason Stajich, [e-mail]
+
+=head1 APPENDIX
+
+The rest of the documentation details each of the object
+methods. Internal methods are usually preceded with a _
+
+=cut
+
+#'
+package Bio::Tools::HMMER::Domain;
+
+use vars qw(@ISA);
+use Bio::SeqFeature::FeaturePair;
+use Bio::SeqFeature::Generic;
+use strict;
+
+
+@ISA = qw(Bio::SeqFeature::FeaturePair);
+
+sub new { 
+  my($class,@args) = @_;
+  my $self = $class->SUPER::new(@args);
+
+  $self->{'alignlines'} = [];
+
+  my $hmmf1 = Bio::SeqFeature::Generic->new(@args);
+  my $hmmf2 = Bio::SeqFeature::Generic->new(@args);
+
+  $self->feature1($hmmf1);
+  $self->feature2($hmmf2);
+
+  return $self;
+}
+
+=head2 add_alignment_line
+
+ Title   : add_alignment_line
+ Usage   : $domain->add_alignment_line($line_from_hmmer_output);
+ Function: add an alignment line to this Domain object
+ Returns : Nothing
+ Args    : scalar
+
+ Adds an alignment line, mainly for storing the HMMER alignments
+as flat text which can be reguritated. You're right. This is *not
+nice* and not the right way to do it.  C'est la vie.
+
+=cut
+
+sub add_alignment_line {
+    my $self = shift;
+    my $line = shift;
+    push(@{$self->{'alignlines'}},$line);
+}
+
+=head2 each_alignment_line
+
+ Title   : each_alignment_line
+ Usage   : foreach $line ( $domain->each_alignment_line )
+ Function: reguritates the alignment lines as they were fed in.
+           only useful realistically for printing.
+ Example :
+ Returns : 
+ Args    : None
+
+
+=cut
+
+sub each_alignment_line {
+    my $self = shift;
+    return @{$self->{'alignlines'}};
+}
+
+=head2 get_nse
+
+ Title   : get_nse
+ Usage   : $domain->get_nse()
+ Function: Provides a seqname/start-end format, useful
+           for unique keys. nse stands for name-start-end
+           It is used alot in Pfam
+ Example :
+ Returns : A string
+ Args    : Optional seperator 1 and seperator 2 (default / and -)
+
+
+=cut
+
+
+
+sub get_nse {
+    my $self = shift;
+    my $sep1 = shift;
+    my $sep2 = shift;
+
+    if( !defined $sep2 ) {
+	$sep2 = "-";
+    }
+    if( !defined $sep1 ) {
+	$sep1 = "/";
+    }
+
+    return sprintf("%s%s%d%s%d",$self->seq_id,$sep1,$self->start,$sep2,$self->end);
+}
+
+
+#  =head2 start_seq
+
+#   Title   : start_seq
+#   Usage   : Backward compatibility with old HMMER modules.
+#             should use $domain->start
+#   Function:
+#   Example :
+#   Returns : 
+#   Args    :
+
+#  =cut
+
+sub start_seq {
+    my $self = shift;
+    my $start = shift;
+    
+    $self->warn("Using old domain->start_seq. Should use domain->start");
+    return $self->start($start);
+}
+
+#  =head2 end_seq
+
+#   Title   : end_seq
+#   Usage   : Backward compatibility with old HMMER modules.
+#             should use $domain->end
+#   Function:
+#   Example :
+#   Returns : 
+#   Args    :
+
+#  =cut
+
+sub end_seq {
+    my $self = shift;
+    my $end = shift;
+
+    $self->warn("Using old domain->end_seq. Should use domain->end");
+    return $self->end($end);
+}
+
+#  =head2 start_hmm
+
+#   Title   : start_hmm
+#   Usage   : Backward compatibility with old HMMER modules, and
+#             for convience. Equivalent to $self->homol_SeqFeature->start
+#   Function:
+#   Example :
+#   Returns : 
+#   Args    :
+
+#  =cut
+
+sub start_hmm { 
+    my $self = shift; 
+    my $start = shift; 
+    $self->warn("Using old domain->start_hmm. Should use domain->hstart");
+    return $self->hstart($start); 
+}
+
+#  =head2 end_hmm
+
+#   Title   : end_hmm
+#   Usage   : Backward compatibility with old HMMER modules, and
+#             for convience. Equivalent to $self->homol_SeqFeature->start
+#   Function:
+#   Example :
+#   Returns : 
+#   Args    :
+
+#  =cut
+
+sub end_hmm {
+    my $self = shift;
+    my $end = shift;
+
+    $self->warn("Using old domain->end_hmm. Should use domain->hend");
+    return $self->hend($end); 
+}
+
+=head2 hmmacc
+
+ Title   : hmmacc
+ Usage   : $domain->hmmacc($newacc)
+ Function: set get for HMM accession number. This is placed in the homol
+           feature of the HMM
+ Example :
+ Returns : 
+ Args    :
+
+
+=cut
+
+sub hmmacc{
+   my ($self,$acc) = @_;
+   if( defined $acc ) {
+       $self->feature2->add_tag_value('accession',$acc);
+   }
+   my @vals = $self->feature2->each_tag_value('accession');
+   return shift @vals;
+}
+
+=head2 hmmname
+
+ Title   : hmmname
+ Usage   : $domain->hmmname($newname)
+ Function: set get for HMM accession number. This is placed in the homol
+           feature of the HMM
+ Example :
+ Returns : 
+ Args    :
+
+=cut
+
+sub hmmname {
+   my ($self,$hname) = @_;
+
+
+   if( defined $hname ) {
+       $self->hseqname($hname);
+   } 
+
+   return $self->hseqname();
+}
+
+=head2 bits
+
+ Title   : bits
+ Usage   :
+ Function: backward compatibility. Same as score
+ Example :
+ Returns : 
+ Args    :
+
+=cut
+
+sub bits{
+   my ($self,$sc) = @_;
+
+   return $self->score($sc);
+}
+
+=head2 evalue
+
+ Title   : evalue
+ Usage   :
+ Function: $domain->evalue($value);
+ Example :
+ Returns : 
+ Args    :
+
+=cut
+
+sub evalue{
+   my ($self,$value) = @_;
+
+   if( defined $value ) {
+       $self->add_tag_value('evalue',$value);
+   }
+   my @vals = $self->each_tag_value('evalue');
+   return shift @vals;
+}
+
+=head2 seqbits
+
+ Title   : seqbits
+ Usage   :
+ Function: $domain->seqbits($value);
+ Example :
+ Returns : 
+ Args    :
+
+=cut
+
+sub seqbits {
+   my ($self,$value) = @_;
+   if( defined $value ) {
+       $self->add_tag_value('seqbits',$value);
+   }
+   my @vals = $self->each_tag_value('seqbits');
+   return shift @vals;
+}
+
+=head2 seq_range
+
+ Title   : seq_range
+ Usage   : 
+ Function: Throws an exception to catch scripts which need to upgrade
+ Example :
+ Returns : 
+ Args    :
+
+=cut
+
+sub seq_range{
+   my ($self,@args) = @_;
+
+   $self->throw("You have accessed an old method. Please recode your script to the new bioperl HMMER module");
+}
+
+=head2 hmm_range
+
+ Title   : hmm_range
+ Usage   :
+ Function: Throws an exception to catch scripts which need to upgrade
+ Example :
+ Returns : 
+ Args    :
+
+
+=cut
+
+sub hmm_range{
+   my ($self,@args) = @_;
+
+   $self->throw("You have accessed an old method. Please recode your script to the new bioperl HMMER module");
+}
+
+1;  # says use was ok
+__END__
+
+
+