← Back to branch summary

~ubuntu-branches/ubuntu/lucid/bioperl/lucid

« back to all changes in this revision

Viewing changes to Bio/Tools/EMBOSS/Palindrome.pm

  • Committer: Bazaar Package Importer
  • Author(s): Matt Hope
  • Date: 2004-04-18 14:24:11 UTC
  • mfrom: (1.2.1 upstream) (2.1.1 warty)
  • Revision ID: james.westby@ubuntu.com-20040418142411-gr92uexquw4w8liq
Tags: 1.4-1
* New upstream release
* Examples and working code are installed by default to usr/bin,
  this has been moved to usr/share/doc/bioperl/bin

Show diffs side-by-side

added added

removed removed

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