Bio/Tools/Hmmpfam.pm

   1 # BioPerl module for Bio::Tools::Hmmpfam
   2 #
   3 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   4 #
   5 # Cared for by  Balamurugan Kumarasamy
   6 #
   7 # You may distribute this module under the same terms as perl itself
   8 # POD documentation - main docs before the code
   9 #
  10
  11 =head1 NAME
  12
  13 Bio::Tools::Hmmpfam - Parser for Hmmpfam program
  14
  15 =head1 SYNOPSIS
  16
  17   use Bio::Tools::Hmmpfam;
  18   my @hmmpfam_feat;
  19   my $hmmpfam_parser = Bio::Tools::Hmmpfam->new(-fh =>$filehandle );
  20   while( my $hmmpfam_feat = $hmmpfam_parser->next_result ) {
  21         push @hmmpfam_feat, $hmmpfam_feat;
  22   }
  23
  24 =head1 DESCRIPTION
  25
  26 Parser for Hmmpfam  program.  See also L<Bio::SearchIO::hmmer>.
  27
  28 =head1 FEEDBACK
  29
  30 =head2 Mailing Lists
  31
  32  User feedback is an integral part of the evolution of this and other
  33  Bioperl modules. Send your comments and suggestions preferably to
  34  the Bioperl mailing list.  Your participation is much appreciated.
  35
  36   bioperl-l@bioperl.org                  - General discussion
  37   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  38
  39 =head2 Support
  40
  41 Please direct usage questions or support issues to the mailing list:
  42
  43 I<bioperl-l@bioperl.org>
  44
  45 rather than to the module maintainer directly. Many experienced and
  46 reponsive experts will be able look at the problem and quickly
  47 address it. Please include a thorough description of the problem
  48 with code and data examples if at all possible.
  49
  50 =head2 Reporting Bugs
  51
  52 Report bugs to the Bioperl bug tracking system to help us keep track
  53 of the bugs and their resolution. Bug reports can be submitted via the
  54 web:
  55
  56   https://github.com/bioperl/bioperl-live/issues
  57
  58 =head1 AUTHOR - Balamurugan Kumarasamy
  59
  60  Email: fugui@worf.fugu-sg.org
  61
  62 =head1 APPENDIX
  63
  64  The rest of the documentation details each of the object methods.
  65  Internal methods are usually preceded with a _
  66
  67
  68 =cut
  69
  70 package Bio::Tools::Hmmpfam;
  71 use strict;
  72
  73 use Bio::SeqFeature::FeaturePair;
  74 use Bio::SeqFeature::Generic;
  75 use base qw(Bio::Root::Root Bio::Root::IO);
  76
  77
  78
  79 =head2 new
  80
  81  Title   : new
  82  Usage   : my $obj = Bio::Tools::Hmmpfam->new(-fh=>$filehandle);
  83  Function: Builds a new Bio::Tools::Hmmpfam object
  84  Returns : Bio::Tools::Hmmpfam
  85  Args    : -filename
  86            -fh (filehandle)
  87
  88 =cut
  89
  90 sub new {
  91       my($class,@args) = @_;
  92
  93       my $self = $class->SUPER::new(@args);
  94       $self->_initialize_io(@args);
  95
  96       return $self;
  97 }
  98
  99
 100 =head2 next_result
 101
 102  Title   : next_result
 103  Usage   : my $feat = $hmmpfam_parser->next_result
 104  Function: Get the next result set from parser data
 105  Returns : L<Bio::SeqFeature::Generic>
 106  Args    : none
 107
 108 =cut
 109
 110 sub next_result {
 111     my ($self) = @_;
 112     my $filehandle;
 113
 114  my $line;
 115
 116     my $id;
 117     while ($_=$self->_readline()) {
 118          $line = $_;
 119          chomp $line;
 120
 121         if ( $line=~m/^Alignments of top-scoring domains/ ) {
 122           while( my $rest = $self->_readline() ) { last if $rest =~ m!^//! }
 123         }
 124
 125         next if ($line=~m/^Model/ || /^\-/ || /^$/);
 126
 127         if ($line=~m/^Query sequence:\s+(\S+)/) {
 128            $id = $1;
 129            $self->seqname($id);
 130         }
 131
 132        if (my ($hid, $start, $end, $hstart, $hend, $score, $evalue) = $line=~m/^(\S+)\s+\S+\s+(\d+)\s+(\d+)\s+\S+\s+(\d+)\s+(\d+)\s+\S+\s+(\S+)\s+(\S+)/) {
 133             my %feature;
 134
 135             ($feature{name}) = $self->seqname;
 136             $feature{raw_score} = $score;
 137             $feature{p_value} = sprintf ("%.3e", $evalue);
 138             $feature{score} = $feature{p_value};
 139             $feature{start} = $start;
 140             $feature{end} = $end;
 141             $feature{hname} = $hid;
 142             $feature{hstart} = $hstart;
 143             $feature{hend} = $hend;
 144             ($feature{source}) = 'pfam';
 145             $feature{primary} = $hid;
 146             ($feature{program}) = 'pfam';
 147             ($feature{db}) = 'db1';
 148             ($feature{logic_name}) = 'hmmpfam';
 149             my $new_feat = $self->create_feature (\%feature);
 150             return $new_feat
 151
 152         }
 153         next;
 154
 155     }
 156     return;
 157 }
 158
 159 =head2 create_feature
 160
 161  Title   : create_feature
 162  Usage   : my $feat=$hmmpfam_parser->create_feature($feature,$seqname)
 163  Function: creates a SeqFeature Generic object
 164  Returns : L<Bio::SeqFeature::Generic>
 165  Args    :
 166
 167
 168 =cut
 169
 170 sub create_feature {
 171     my ($self, $feat) = @_;
 172
 173
 174
 175     my $feature1= Bio::SeqFeature::Generic->new( -seq_id  =>$feat->{name},
 176                                                 -start      =>$feat->{start},
 177                                                 -end        =>$feat->{end},
 178                                                 -score      =>$feat->{score},
 179                                                 -source     =>$feat->{source},
 180                                                 -primary    =>$feat->{primary},
 181                                                    );
 182
 183
 184
 185     my $feature2= Bio::SeqFeature::Generic->new(
 186                                                  -start      =>$feat->{hstart},
 187                                                  -end        =>$feat->{hend},
 188                                                   );
 189
 190
 191
 192
 193     my $featurepair = Bio::SeqFeature::FeaturePair->new;
 194     $featurepair->feature1 ($feature1);
 195     $featurepair->feature2 ($feature2);
 196
 197    $featurepair->add_tag_value('evalue',$feat->{p_value});
 198    $featurepair->add_tag_value('percent_id','NULL');
 199    $featurepair->add_tag_value("hid",$feat->{primary});
 200     return  $featurepair;
 201
 202 }
 203
 204 =head2 seqname
 205
 206  Title   :   seqname
 207  Usage   :   obj->seqname($seqname)
 208  Function:   Internal(not to be used directly)
 209  Returns :
 210  Args    :   seqname
 211
 212 =cut
 213
 214 sub seqname{
 215     my($self,$seqname)=@_;
 216
 217     if(defined($seqname))
 218     {
 219         $self->{'seqname'}=$seqname;
 220     }
 221
 222     return $self->{'seqname'};
 223
 224 }
 225
 226 1;
 227
 228