Bio/Tools/PrositeScan.pm

   1
   2 =head1 NAME
   3
   4 Bio::Tools::PrositeScan - Parser for ps_scan result
   5
   6 =head1 SYNOPSIS
   7
   8   use Bio::Tools::PrositeScan;
   9
  10   my $factory = Bio::Tools::PrositeScan->new(
  11       -file => 'out.PrositeScan'
  12   );
  13
  14   while(my $match = $factory->next_prediction){
  15       #  $match is of Bio::SeqFeature::FeaturePair
  16       my $q_id = $fatch->feature1->seq_id;
  17       my $h_id = $fatch->feature2->seq_id;
  18   }
  19
  20 =head1 DESCRIPTION
  21
  22 This is the parser of the output of ps_scan program. It takes either a file
  23 handler or a file name, and returns a Bio::SeqFeature::FeaturePair object.
  24
  25 =head1 AUTHOR
  26
  27 Juguang Xiao, juguang@tll.org.sg
  28
  29 =cut
  30
  31 # Let the code begin...
  32
  33 package Bio::Tools::PrositeScan;
  34 use vars qw(@FORMATS);
  35 use strict;
  36 use Bio::Seq;
  37 use Bio::SeqFeature::Generic;
  38 use Bio::SeqFeature::FeaturePair;
  39
  40 use base qw(Bio::Root::Root Bio::Root::IO);
  41 @FORMATS = qw(SCAN FASTA PSA MSA PFF MATCHLIST);
  42
  43 =head2 new
  44
  45   Title   : new
  46   Usage   : Bio::Tools::PrositeScan->new(-file => 'out.PrositeScan');
  47             Bio::Tools::PrositeScan->new(-fh => \*FH);
  48   Returns : L<Bio::Tools::PrositeScan>
  49
  50 =cut
  51
  52 sub new {
  53     my ($class, @args) = @_;
  54     my $self = $class->SUPER::new(@args);
  55     $self->_initialize_io(@args);
  56     my ($format) = $self->_rearrange([qw(FORMAT)], @args);
  57     $format || $self->throw("format needed");
  58     if(grep /^$format$/i, @FORMATS){
  59         $self->format($format);
  60     }else{
  61         $self->throw("Invalid format, [$format]");
  62     }
  63     return $self;
  64 }
  65
  66 sub format {
  67     my $self = shift;
  68     return $self->{_format} = shift if(@_);
  69     return $self->{_format};
  70 }
  71
  72 =head2 next_prediction
  73
  74   Title   : new
  75   Usage   :
  76       while($result = $factory->next_prediction){
  77           ;
  78       }
  79
  80   Returns : a Bio::SeqFeature::FeaturePair object
  81
  82 =cut
  83
  84 sub next_prediction {
  85     my ($self) = @_;
  86     unless($self->_parsed){
  87         $self->_parse;
  88         $self->_parsed(1);
  89     }
  90     return shift @{$self->{_matches}};
  91 }
  92
  93 sub next_result {
  94     return shift->next_prediction;
  95 }
  96
  97 sub _parsed {
  98     my $self = shift;
  99     return $self->{_parsed} = 1 if @_ && $_[0];
 100     return $self->{_parsed};
 101 }
 102
 103 sub _parse {
 104     my $self = shift;
 105     my $format = $self->format;
 106     if($self->format =~ /^fasta$/){
 107         $self->_parse_fasta;
 108     }else{
 109         $self->throw("the [$format] parser has not been written");
 110     }
 111 }
 112
 113 sub _parse_fasta {
 114     my ($self) = @_;
 115     my @matches;
 116     my $fp;
 117     my $seq;
 118     while(defined($_ = $self->_readline)){
 119         chop;
 120         if(/^\>([^>]+)/){
 121             my $fasta_head = $1;
 122             if($fasta_head =~ /([^\/]+)\/(\d+)\-(\d+)(\s+)\:(\s+)(\S+)/){
 123                 my $q_id = $1;
 124                 my $q_start = $2;
 125                 my $q_end = $3;
 126                 my $h_id = $6;
 127                 if(defined $fp){
 128                     $self->_attach_seq($seq, $fp);
 129                     push @matches, $fp;
 130                 }
 131                 $fp = Bio::SeqFeature::FeaturePair->new(
 132                     -feature1 => Bio::SeqFeature::Generic->new(
 133                         -seq_id => $q_id,
 134                         -start => $q_start,
 135                         -end => $q_end
 136                     ),
 137                     -feature2 => Bio::SeqFeature::Generic->new(
 138                         -seq_id => $h_id,
 139                         -start => 0,
 140                         -end => 0
 141                     )
 142                 );
 143                 $seq = '';
 144             }else{
 145                 $self->throw("ERR:\t\[$_\]");
 146             }
 147         }else{ # sequence lines, ignored
 148             $seq .= $_;
 149         }
 150     }
 151     if(defined $fp){
 152         $self->_attach_seq($seq, $fp);
 153         push @matches, $fp;
 154     }
 155     push @{$self->{_matches}}, @matches;
 156
 157 }
 158
 159 sub _attach_seq {
 160     my ($self, $seq, $fp) = @_;
 161     if(defined $fp){
 162         my $whole_seq = 'X' x ($fp->start-1);
 163         $whole_seq .= $seq;
 164         $fp->feature1->attach_seq(
 165             Bio::Seq->new(-seq => $whole_seq)
 166         );
 167     }
 168 }
 169
 170 1;