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

« back to all changes in this revision

Viewing changes to Bio/AlignIO/maf.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
* 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:
1
 
# $Id: maf.pm,v 1.4 2003/11/15 13:05:58 heikki Exp $
 
1
# $Id: maf.pm,v 1.10.4.1 2006/10/02 23:10:12 sendu Exp $
2
2
#
3
3
# BioPerl module for Bio::AlignIO::maf
4
4
#
51
51
=head2 Reporting Bugs
52
52
 
53
53
Report bugs to the Bioperl bug tracking system to help us keep track
54
 
 the bugs and their resolution.
55
 
 Bug reports can be submitted via email or the web:
 
54
the bugs and their resolution.  Bug reports can be submitted via the
 
55
web:
56
56
 
57
 
  bioperl-bugs@bio.perl.org
58
 
  http://bugzilla.bioperl.org/
 
57
  http://bugzilla.open-bio.org/
59
58
 
60
59
=head1 AUTHORS - Allen Day
61
60
 
71
70
# Let the code begin...
72
71
 
73
72
package Bio::AlignIO::maf;
74
 
use vars qw(@ISA $seen_header);
 
73
use vars qw($seen_header);
75
74
use strict;
76
75
 
77
76
use Bio::SimpleAlign;
78
 
use Bio::AlignIO;
79
77
 
80
78
$seen_header = 0;
81
79
 
82
 
@ISA = qw(Bio::AlignIO);
 
80
use base qw(Bio::AlignIO);
83
81
 
84
82
=head2 new
85
83
 
114
112
=cut
115
113
 
116
114
sub next_aln {
117
 
  my $self = shift;
 
115
    my $self = shift;
118
116
 
119
 
  if(!$seen_header){
 
117
    if(!$seen_header){
120
118
        my $line = $self->_readline;
121
119
        $self->throw("This doesn't look like a MAF file.  First line should start with ##maf, but it was: ".$line)
122
 
          unless $line =~ /^##maf/;
 
120
            unless $line =~ /^##maf/;
123
121
        $seen_header = 1;
124
 
  }
125
 
 
126
 
  my $aln =  Bio::SimpleAlign->new(-source => 'maf');
127
 
 
128
 
  my($aline, @slines);
129
 
  while(my $line = $self->_readline()){
 
122
    }
 
123
 
 
124
    my $aln =  Bio::SimpleAlign->new(-source => 'maf');
 
125
 
 
126
    my($aline, @slines);
 
127
    while(my $line = $self->_readline()){
130
128
        $aline = $line if $line =~ /^a/;
131
129
        push @slines, $line if $line =~ /^s /;
132
130
        last if $line !~ /\S/;
133
131
 
134
 
  }
135
 
 
136
 
  return undef unless $aline;
137
 
 
138
 
  my($kvs) = $aline =~ /^a\s+(.+)$/;
139
 
  my @kvs  = split /\s+/, $kvs if $kvs;
140
 
  my %kv;
141
 
  foreach my $kv (@kvs){
142
 
    my($k,$v) = $kv =~ /(.+)=(.+)/;
143
 
    $kv{$k} = $v;
144
 
  }
145
 
 
146
 
  $aln->score($kv{score});
147
 
 
148
 
  foreach my $sline (@slines){
 
132
    }
 
133
 
 
134
    return unless $aline;
 
135
 
 
136
    my($kvs) = $aline =~ /^a\s+(.+)$/;
 
137
    my @kvs  = split /\s+/, $kvs if $kvs;
 
138
    my %kv;
 
139
    foreach my $kv (@kvs){
 
140
        my($k,$v) = $kv =~ /(.+)=(.+)/;
 
141
        $kv{$k} = $v;
 
142
    }
 
143
 
 
144
    $aln->score($kv{score});
 
145
 
 
146
    foreach my $sline (@slines){
149
147
        my($s,$src,$start,$size,$strand,$srcsize,$text) =
150
 
          split /\s+/, $sline;
151
 
 
152
 
        my $seq = new Bio::LocatableSeq('-seq'   => $text,
153
 
                                                                        '-id'    => $src,
154
 
                                                                        '-start' => $start,
155
 
                                                                        '-end'   => $start + $size,
156
 
                                                                   );
 
148
            split /\s+/, $sline;
 
149
        # adjust coordinates to be one-based inclusive
 
150
        $start = $start + 1;
 
151
        my $seq = new Bio::LocatableSeq('-seq'    => $text,
 
152
                                        '-id'     => $src,
 
153
                                        '-start'  => $start,
 
154
                                        '-end'    => $start + $size - 1,
 
155
                                        '-strand' => $strand,
 
156
                                        );
157
157
        $aln->add_seq($seq);
158
 
  }
 
158
    }
159
159
 
160
 
  return $aln;
 
160
    return $aln;
161
161
}
162
162
 
163
163
sub write_aln {