lib/Bio/Tools/Profile.pm

   1 # BioPerl module for Bio::Tools::Profile
   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 =head1 NAME
  11
  12 Bio::Tools::Profile - parse Profile output
  13
  14 =head1 SYNOPSIS
  15
  16  use Bio::Tools::Profile;
  17  my $profile_parser = Bio::Tools::Profile->new(-fh =>$filehandle );
  18  while( my $profile_feat = $profile_parser->next_result ) {
  19        push @profile_feat, $profile_feat;
  20 }
  21
  22 =head1 DESCRIPTION
  23
  24  Parser for Profile output
  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 the
  52 web:
  53
  54   https://github.com/bioperl/bioperl-live/issues
  55
  56 =head1 AUTHOR - Balamurugan Kumarasamy
  57
  58  Email: fugui@worf.fugu-sg.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
  66 =cut
  67
  68
  69 package Bio::Tools::Profile;
  70 use strict;
  71
  72 use Bio::SeqFeature::FeaturePair;
  73 use Bio::SeqFeature::Generic;
  74
  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::Profile->new();
  83  Function: Builds a new Bio::Tools::Profile object
  84  Returns : Bio::Tools::Profile
  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 =head2 next_result
 100
 101  Title   : next_result
 102  Usage   : my $feat = $profile_parser->next_result
 103  Function: Get the next result set from parser data
 104  Returns : L<Bio::SeqFeature::FeaturePair>
 105  Args    : none
 106
 107
 108 =cut
 109
 110 sub next_result {
 111         my ($self) = @_;
 112
 113         my %printsac;
 114         my $line;
 115         my @features;
 116         while ($_=$self->_readline()) {
 117                 $line = $_;
 118                 chomp $line;
 119                 my ($nscore,$rawscore,$from,$to,$hfrom,$hto,$ac) = $line =~ /(\S+)\s+(\d+)\s*pos.\s+(\d*)\s*-\s+(\d*)\s*\[\s+(\d*),\s+(\S*)\]\s*(\w+)/;
 120                 #for example in this output line
 121                 #38.435   2559 pos.  19958 - 20212 [    1,    -1] PS50011|PROTEIN_KINASE_DOM Protein kinase domain profile.
 122                 #$nscore = 38.435
 123                 #$rawscore = 2559
 124                 #$from = 19958
 125                 #$end = 20212
 126                 #$hfrom = 1
 127                 #$hto =-1
 128                 #$ac = PS50011
 129                 my $feat = "$ac,$from,$to,$hfrom,$hto,$nscore";
 130                 my $new_feat= $self->create_feature($feat);
 131                 return $new_feat
 132
 133         }
 134 }
 135
 136
 137 =head2 create_feature
 138
 139  Title   : create_feature
 140  Usage   : my $feat= $profile_parser->create_feature($feature)
 141  Function: creates a Bio::SeqFeature::FeaturePair object
 142  Returns : L<Bio::SeqFeature::FeaturePair>
 143  Args    :
 144
 145
 146 =cut
 147
 148 sub create_feature {
 149         my ($self, $feat) = @_;
 150
 151         my @f = split (/,/,$feat);
 152
 153
 154         my $hto = $f[4];
 155
 156         if ($f[4] =~ /-1/) {
 157
 158            $hto = $f[2] - $f[1] + 1;
 159
 160         }
 161
 162
 163         my $feat1 = Bio::SeqFeature::Generic->new( -start => $f[1],
 164                                                    -end => $f[2],
 165                                                    -score => $f[5],
 166                                                    -source=>'pfscan',
 167                                                    -primary=>$f[0]);
 168
 169         my $feat2 = Bio::SeqFeature::Generic->new(-start => $f[3],
 170                                                   -end => $hto,
 171                                                   );
 172
 173         my $feature = Bio::SeqFeature::FeaturePair->new(-feature1 => $feat1,
 174                                                     -feature2 => $feat2);
 175
 176         return $feature;
 177
 178 }
 179 1;