← Back to branch summary

~ubuntu-branches/ubuntu/raring/bioperl/raring

« back to all changes in this revision

Viewing changes to Bio/AlignIO/selex.pm

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2008-03-18 14:44:57 UTC
  • mfrom: (4 hardy)
  • mto: This revision was merged to the branch mainline in revision 6.
  • Revision ID: james.westby@ubuntu.com-20080318144457-1jjoztrvqwf0gruk
http://bugs.debian.org/448890
* debian/control:
  - Removed MIA Matt Hope (dopey) from the Uploaders field.
    Thank you for your work, Matt. I hope you are doing well.
  - Downgraded some recommended package to the 'Suggests' priority,
    according to the following discussion on Upstream's mail list.
    http://bioperl.org/pipermail/bioperl-l/2008-March/027379.html
    (Closes: #448890)
* debian/copyright converted to machine-readable format.

Show diffs side-by-side

added added

removed removed

Lines of Context:
Bio/AlignIO/selex.pm
1
 
# $Id: selex.pm,v 1.10 2002/10/22 07:38:26 lapp Exp $
 
1
# $Id: selex.pm,v 1.14.4.3 2006/10/02 23:10:12 sendu Exp $
2
2
#
3
3
# BioPerl module for Bio::AlignIO::selex
4
4
 
5
 
#       based on the Bio::SeqIO::selex module
6
 
#       by Ewan Birney <birney@sanger.ac.uk>
 
5
#   based on the Bio::SeqIO::selex module
 
6
#       by Ewan Birney <birney@ebi.ac.uk>
7
7
#       and Lincoln Stein  <lstein@cshl.org>
8
8
#
9
9
#       and the SimpleAlign.pm module of Ewan Birney
21
21
 
22
22
=head1 SYNOPSIS
23
23
 
24
 
Do not use this module directly.  Use it via the L<Bio::AlignIO> class.
 
24
  # Do not use this module directly.  Use it via the L<Bio::AlignIO> class.
 
25
 
 
26
  use Bio::AlignIO;
 
27
  use strict;
 
28
 
 
29
  my $in = Bio::AlignIO->new(-format => 'selex',
 
30
                             -file   => 't/data/testaln.selex');
 
31
  while( my $aln = $in->next_aln ) {
 
32
 
 
33
  }
25
34
 
26
35
=head1 DESCRIPTION
27
36
 
33
42
=head2 Reporting Bugs
34
43
 
35
44
Report bugs to the Bioperl bug tracking system to help us keep track
36
 
 the bugs and their resolution.
37
 
 Bug reports can be submitted via email or the web:
 
45
the bugs and their resolution. Bug reports can be submitted via the
 
46
web:
38
47
 
39
 
  bioperl-bugs@bio.perl.org
40
 
  http://bugzilla.bioperl.org/
 
48
  http://bugzilla.open-bio.org/
41
49
 
42
50
=head1 AUTHORS - Peter Schattner
43
51
 
44
52
Email: schattner@alum.mit.edu
45
53
 
 
54
=head1 CONTRIBUTORS
 
55
 
 
56
Jason Stajich, jason-at-bioperl.org
46
57
 
47
58
=head1 APPENDIX
48
59
 
54
65
# Let the code begin...
55
66
 
56
67
package Bio::AlignIO::selex;
57
 
use vars qw(@ISA);
58
68
use strict;
59
 
use Bio::AlignIO;
60
69
 
61
 
@ISA = qw(Bio::AlignIO);
 
70
use base qw(Bio::AlignIO);
62
71
 
63
72
=head2 next_aln
64
73
 
76
85
sub next_aln {
77
86
    my $self = shift;
78
87
    my $entry;
79
 
    my ($start,$end,%align,$name,$seqname,$seq,$count,%hash,%c2name, %accession, $no);
 
88
    my ($start,$end,%align,$name,$seqname,%hash,@c2name, %accession,%desc);
80
89
    my $aln =  Bio::SimpleAlign->new(-source => 'selex');
81
90
 
82
91
    # in selex format, every non-blank line that does not start
83
92
    # with '#=' is an alignment segment; the '#=' lines are mark up lines.
84
93
    # Of particular interest are the '#=GF <name/st-ed> AC <accession>'
85
94
    # lines, which give accession numbers for each segment
86
 
 
87
95
    while( $entry = $self->_readline) {
88
 
        $entry =~ /^\#=GS\s+(\S+)\s+AC\s+(\S+)/ && do {
89
 
                                        $accession{ $1 } = $2;
90
 
                                        next;
91
 
                                        };
92
 
        $entry !~ /^([^\#]\S+)\s+([A-Za-z\.\-]+)\s*/ && next;
93
 
        
94
 
        $name = $1;
95
 
        $seq = $2;
 
96
        if( $entry =~ /^\#=GS\s+(\S+)\s+AC\s+(\S+)/ ) {
 
97
            $accession{ $1 } = $2;
 
98
            next;
 
99
        } elsif( $entry =~ /^\#=GS\s+(\S+)\s+DE\s+(.+)\s*$/ ) {
 
100
            $desc{$1} .= $2;
 
101
        } elsif ( $entry =~ /^([^\#]\S+)\s+([A-Za-z\.\-\*]+)\s*/ ) {
 
102
            my ($name,$seq) = ($1,$2);
96
103
 
97
 
        if( ! defined $align{$name}  ) {
98
 
            $count++;
99
 
            $c2name{$count} = $name;
 
104
            if( ! defined $align{$name}  ) {
 
105
                push @c2name, $name;
 
106
            }
 
107
            $align{$name} .= $seq;
100
108
        }
101
 
        $align{$name} .= $seq;
102
109
    }
103
 
 
104
110
    # ok... now we can make the sequences
105
111
 
106
 
    $count = 0;
107
 
    foreach $no ( sort { $a <=> $b } keys %c2name ) {
108
 
        $name = $c2name{$no};
 
112
    foreach my $name ( @c2name ) {
109
113
 
110
114
        if( $name =~ /(\S+)\/(\d+)-(\d+)/ ) {
111
115
            $seqname = $1;
116
120
            $start = 1;
117
121
            $end = length($align{$name});
118
122
        }
119
 
        $seq = new Bio::LocatableSeq('-seq'=>$align{$name},
120
 
                            '-id'=>$seqname,
121
 
                            '-start'=>$start,
122
 
                            '-end'=>$end,
123
 
                            '-type'=>'aligned',
124
 
                                     '-accession_number' => $accession{$name},
125
 
 
126
 
                            );
 
123
        my $seq = new Bio::LocatableSeq
 
124
            ('-seq'              => $align{$name},
 
125
             '-display_id'       => $seqname,
 
126
             '-start'            => $start,
 
127
             '-end'              => $end,
 
128
             '-description'      => $desc{$name},
 
129
             '-accession_number' => $accession{$name},
 
130
             );
127
131
 
128
132
        $aln->add_seq($seq);
129
 
        $count++;
130
133
    }
131
134
 
132
135
#  If $end <= 0, we have either reached the end of
133
136
#  file in <> or we have encountered some other error
134
137
#
135
 
   if ($end <= 0) { undef $aln;}
136
 
 
 
138
    return if ($end <= 0);
137
139
    return $aln;
138
140
}
139
141