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
  71 use strict;
  72
  73 use Bio::SeqFeature::FeaturePair;
  74 use Bio::SeqFeature::Generic;
  75
  76 use base qw(Bio::Root::Root Bio::Root::IO);
  77
  78
  79
  80 =head2 new
  81
  82  Title   : new
  83  Usage   : my $obj = Bio::Tools::Profile->new();
  84  Function: Builds a new Bio::Tools::Profile object
  85  Returns : Bio::Tools::Profile
  86  Args    : -filename
  87            -fh ($filehandle)
  88
  89 =cut
  90
  91 sub new {
  92     my($class,@args) = @_;
  93
  94     my $self = $class->SUPER::new(@args);
  95     $self->_initialize_io(@args);
  96
  97     return $self;
  98 }
  99
 100 =head2 next_result
 101
 102  Title   : next_result
 103  Usage   : my $feat = $profile_parser->next_result
 104  Function: Get the next result set from parser data
 105  Returns : L<Bio::SeqFeature::FeaturePair>
 106  Args    : none
 107
 108
 109 =cut
 110
 111 sub next_result {
 112         my ($self) = @_;
 113
 114         my %printsac;
 115         my $line;
 116         my @features;
 117         while ($_=$self->_readline()) {
 118                 $line = $_;
 119                 chomp $line;
 120                 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+)/;
 121                 #for example in this output line
 122                 #38.435   2559 pos.  19958 - 20212 [    1,    -1] PS50011|PROTEIN_KINASE_DOM Protein kinase domain profile.
 123                 #$nscore = 38.435
 124                 #$rawscore = 2559
 125                 #$from = 19958
 126                 #$end = 20212
 127                 #$hfrom = 1
 128                 #$hto =-1
 129                 #$ac = PS50011
 130                 my $feat = "$ac,$from,$to,$hfrom,$hto,$nscore";
 131                 my $new_feat= $self->create_feature($feat);
 132                 return $new_feat
 133
 134         }
 135 }
 136
 137
 138 =head2 create_feature
 139
 140  Title   : create_feature
 141  Usage   : my $feat= $profile_parser->create_feature($feature)
 142  Function: creates a Bio::SeqFeature::FeaturePair object
 143  Returns : L<Bio::SeqFeature::FeaturePair>
 144  Args    :
 145
 146
 147 =cut
 148
 149 sub create_feature {
 150         my ($self, $feat) = @_;
 151
 152         my @f = split (/,/,$feat);
 153
 154
 155         my $hto = $f[4];
 156
 157         if ($f[4] =~ /-1/) {
 158
 159            $hto = $f[2] - $f[1] + 1;
 160
 161         }
 162
 163
 164         my $feat1 = Bio::SeqFeature::Generic->new( -start => $f[1],
 165                                                    -end => $f[2],
 166                                                    -score => $f[5],
 167                                                    -source=>'pfscan',
 168                                                    -primary=>$f[0]);
 169
 170         my $feat2 = Bio::SeqFeature::Generic->new(-start => $f[3],
 171                                                   -end => $hto,
 172                                                   );
 173
 174         my $feature = Bio::SeqFeature::FeaturePair->new(-feature1 => $feat1,
 175                                                     -feature2 => $feat2);
 176
 177         return $feature;
 178
 179 }
 180 1;