Bio/Tools/EMBOSS/Palindrome.pm

   1 #
   2 # BioPerl module for Bio::Tools::EMBOSS::Palindrome
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # Cared for by Jason Stajich <jason-at-bioperl-dot-org>
   7 #
   8 # Copyright Jason Stajich
   9 #
  10 # You may distribute this module under the same terms as perl itself
  11
  12 # POD documentation - main docs before the code
  13
  14 =head1 NAME
  15
  16 Bio::Tools::EMBOSS::Palindrome - parse EMBOSS palindrome output
  17
  18 =head1 SYNOPSIS
  19
  20   # a simple script to turn palindrome output into GFF3
  21   use Bio::Tools::EMBOSS::Palindrome;
  22   use Bio::Tools::GFF;
  23
  24   my $parser = Bio::Tools::EMBOSS::Palindrome->new(-file => $filename);
  25   my $out    = Bio::Tools::GFF->new(-gff_version => 3,
  26                                    -file => ">$filename.gff");
  27   while( my $seq = $parser->next_seq ) {
  28      for my $feat ( $seq->get_SeqFeatures ) {
  29         $out->write_feature($feat);
  30      }
  31   }
  32
  33 =head1 DESCRIPTION
  34
  35 This is a parser for the EMBOSS tool 'palindrome'.  It will produce a
  36 L<Bio::Seq> object for each sequence analyzed.  The sequence will be
  37 empty (but will be of the correct length) and will have attached to it
  38 L<Bio::SeqFeature::FeaturePair> objects which wil
  39
  40
  41 =head2 FUTURE WORK
  42
  43 It may be consolidated into another framework at a later time, but for
  44 the time being it will stay a separate modules.
  45
  46 =head1 FEEDBACK
  47
  48 =head2 Mailing Lists
  49
  50 User feedback is an integral part of the evolution of this and other
  51 Bioperl modules. Send your comments and suggestions preferably to
  52 the Bioperl mailing list.  Your participation is much appreciated.
  53
  54   bioperl-l@bioperl.org                  - General discussion
  55   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  56
  57 =head2 Support
  58
  59 Please direct usage questions or support issues to the mailing list:
  60
  61 I<bioperl-l@bioperl.org>
  62
  63 rather than to the module maintainer directly. Many experienced and
  64 reponsive experts will be able look at the problem and quickly
  65 address it. Please include a thorough description of the problem
  66 with code and data examples if at all possible.
  67
  68 =head2 Reporting Bugs
  69
  70 Report bugs to the Bioperl bug tracking system to help us keep track
  71 of the bugs and their resolution. Bug reports can be submitted via
  72 email or the web:
  73
  74   https://github.com/bioperl/bioperl-live/issues
  75
  76 =head1 AUTHOR - Jason Stajich
  77
  78 Email jason-at-bioperl-dot-org
  79
  80 =head1 APPENDIX
  81
  82 The rest of the documentation details each of the object methods.
  83 Internal methods are usually preceded with a _
  84
  85 =cut
  86
  87
  88 # Let the code begin...
  89
  90
  91 package Bio::Tools::EMBOSS::Palindrome;
  92 use vars qw($DEFAULT_SOURCETAG);
  93 use strict;
  94
  95 use Bio::SeqFeature::FeaturePair;
  96 use Bio::SeqFeature::Generic;
  97
  98 use base qw(Bio::Root::IO);
  99 $DEFAULT_SOURCETAG = 'palindrome';
 100
 101 =head2 new
 102
 103  Title   : new
 104  Usage   : my $obj = Bio::Tools::EMBOSS::Palindrome->new();
 105  Function: Builds a new Bio::Tools::EMBOSS::Palindrome object
 106  Returns : an instance of Bio::Tools::EMBOSS::Palindrome
 107  Args    : -file/-fh  => a filename or filehandle for
 108                          initializing the parser
 109
 110 =cut
 111
 112 =head2 next_seq
 113
 114  Title   : next_seq
 115  Usage   : my $seq = $parser->next_seq;
 116  Function: Get the next feature set from the
 117  Returns : L<Bio::SeqI> object
 118  Args    : none
 119
 120
 121 =cut
 122
 123 sub next_seq {
 124     my ($self) = @_;
 125     my (%searching, $seq,$state);
 126     my $source = $self->source_tag;
 127     $state = 0;
 128     while(defined($_ = $self->_readline)) {
 129         if( /^\s+$/ ) {
 130             next;
 131         } elsif( /^Palindromes\s+of\s*:\s+(\S+)/o ) {
 132             $state = 0;
 133             if( $seq )  {
 134                 $self->_pushback($_);
 135                 return $seq;
 136             }
 137             $seq = Bio::Seq->new(-display_id => $1);
 138             # now get ready to store for the next record
 139             $searching{'-seq_id'} = $1;
 140         } elsif( /^Sequence\s+length\s+is\s*:\s+(\d+)/o ) {
 141             $seq->length($1);
 142             $searching{'-tag'}->{'seqlength'} = $1;
 143         } elsif( /^(Start|End)\s+at\s+position\s*:\s+(\d+)/ ) {
 144             $searching{'-tag'}->{lc($1)} = $2;
 145         } elsif( m/^(Maximum|Minimum)\s+length\s+of\s+Palindromes\s+
 146                  is\s*:\s+(\d+)/ox) {
 147             $searching{'-tag'}->{lc($1).'_length'} = $2;
 148         } elsif( /^(Maximum\s+gap)\s+between\s+elements\s+is\s*:\s+(\d+)/o ) {
 149             $searching{'-tag'}->{lc($1)} = $2;
 150         } elsif( m/^Number\s+of\s+mismatches\s+allowed\s+
 151                  in\s+Palindrome\s*:\s+(\d+)/ox ) {
 152             $searching{'-tag'}->{'allowed_mismatches'} = $1;
 153         } elsif( /^Palindromes:/o ) {
 154             $state = 1;
 155         } elsif( $state == 1 ) {
 156             my $feature = Bio::SeqFeature::FeaturePair->new
 157                 (-primary_tag  => 'similarity',
 158                  -source_tag   => $source);
 159             for(my $i = 0; $i < 3; $i++ ) {
 160                 if ($i != 1) {
 161                     if( /^(\d+)\s+(\S+)\s+(\d+)/o ) {
 162                         my ($start,$match,$end) = ($1,$2,$3);
 163                         my $type = $i == 0 ? 'feature1' : 'feature2';
 164                         ($start,$end) = sort { $a <=> $b } ($start,$end);
 165                         $feature->$type(
 166                                         Bio::SeqFeature::Generic->new
 167                                         (%searching,
 168                                          -start       => $start,
 169                                          -end         => $end,
 170                                          -strand      => $i == 0 ? 1 : -1,
 171                                          -primary_tag => 'similarity',
 172                                          -source_tag  => $source)
 173                                         );
 174                     } else {
 175                         chomp;
 176                         warn("Out of sync, line did not match:'$_'\n");
 177                     }
 178
 179                 }
 180                 $_ = $self->_readline;
 181             }
 182             $seq->add_SeqFeature($feature);
 183         }
 184     }
 185     return $seq;
 186 }
 187
 188 =head2 source_tag
 189
 190  Title   : source_tag
 191  Usage   : $obj->source_tag($newval)
 192  Function: Get/Set Source Tag ('palindrome') by default
 193  Returns : value of source_tag (a scalar)
 194  Args    : on set, new value (a scalar or undef, optional)
 195
 196
 197 =cut
 198
 199 sub source_tag{
 200     my $self = shift;
 201
 202     return $self->{'source_tag'} = shift if @_;
 203     return $self->{'source_tag'} || $DEFAULT_SOURCETAG;
 204 }
 205
 206 1;