← Back to branch summary

~ubuntu-branches/ubuntu/trusty/bioperl/trusty-proposed

« back to all changes in this revision

Viewing changes to Bio/AlignIO/nexus.pm

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2009-03-10 07:19:11 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20090310071911-fukqzw54pyb1f0bd
Tags: 1.6.0-2
https://launchpad.net/bugs/324001
* Removed patch system (not used):
  - removed instuctions in debian/rules;
  - removed quilt from Build-Depends in debian/control.
* Re-enabled tests:
  - uncommented test command in debian/rules;
  - uncommented previously missing build-dependencies in debian/control.
  - Re-enabled tests and uncommented build-dependencies accordingly.
* Removed libmodule-build-perl and libtest-harness-perl from
  Build-Depends-Indep (provided by perl-modules).
* Better cleaning of empty directories using find -type d -empty -delete
  instead of rmdir in debian/rules (LP: #324001).

Show diffs side-by-side

added added

removed removed

Lines of Context:
Bio/AlignIO/nexus.pm
1
 
# $Id: nexus.pm,v 1.27.4.1 2006/10/02 23:10:12 sendu Exp $
 
1
# $Id: nexus.pm 14891 2008-09-16 20:22:53Z cjfields $
2
2
#
3
3
# BioPerl module for Bio::AlignIO::nexus
4
4
#
15
15
 
16
16
    use Bio::AlignIO;
17
17
 
18
 
    my $in = new Bio::AlignIO(-format => 'nexus',
 
18
    my $in = Bio::AlignIO->new(-format => 'nexus',
19
19
                              -file   => 'aln.nexus');
20
20
    while( my $aln = $in->next_aln ) {
21
21
        # do something with the alignment
70
70
=head2 new
71
71
 
72
72
 Title   : new
73
 
 Usage   : $alignio = new Bio::AlignIO(-format => 'nexus',
74
 
                                                                                                        -file   => 'filename');
 
73
 Usage   : $alignio = Bio::AlignIO->new(-format => 'nexus', -file => 'filename');
75
74
 Function: returns a new Bio::AlignIO object to handle clustalw files
76
75
 Returns : Bio::AlignIO::clustalw object
77
76
 Args    : -verbose => verbosity setting (-1,0,1,2)
136
135
    my ($aln_name, $seqcount, $residuecount, %hash, $alphabet,
137
136
        $match, $gap, $missing, $equate, $interleave,
138
137
        $name,$str,@names,$seqname,$start,$end,$count,$seq);
139
 
 
 
138
    local $Bio::LocatableSeq::OTHER_SYMBOLS = '\*\?\.';
 
139
    local $Bio::LocatableSeq::GAP_SYMBOLS = '\-';
140
140
    my $aln =  Bio::SimpleAlign->new(-source => 'nexus');
141
141
 
142
142
    # file starts with '#NEXUS' but we allow white space only lines before it
145
145
 
146
146
    return unless $entry;
147
147
    $self->throw("Not a valid interleaved NEXUS file! [#NEXUS] not starting the file\n$entry")
148
 
        unless $entry =~ /^#NEXUS/i;
 
148
        unless ($entry && $entry =~ /^#NEXUS/i);
149
149
 
150
150
    # skip anything before either the taxa or data block
151
151
    # but read in the optional title in a comment
158
158
 
159
159
    # data and taxa blocks
160
160
    my $incomment;
161
 
    while ($entry = $self->_readline) {
 
161
    while (defined ($entry = $self->_readline)) {
162
162
        local ($_) =  $entry;
163
163
        next if s/\[[^\]]+\]//g; # remove comments
164
164
        if( s/\[[^\]]+$// ) {
296
296
            $seqname=$name;
297
297
            $start = 1;
298
298
            $str = $hash{$count};
299
 
            $str =~ s/[^A-Za-z]//g;
 
299
            $str =~ s/[$Bio::LocatableSeq::GAP_SYMBOLS]//g;
300
300
            $end = length($str);
301
301
        }
302
302
 
303
303
        # consistency test
304
 
        $self->throw("Length of sequence [$seqname] is not [$residuecount]! ")
 
304
        $self->throw("Length of sequence [$seqname] is not [$residuecount]; got".CORE::length($hash{$count}))
305
305
            unless CORE::length($hash{$count}) == $residuecount;
306
306
 
307
 
        $seq = new Bio::LocatableSeq('-seq'=>$hash{$count},
 
307
        $seq = Bio::LocatableSeq->new('-seq'=>$hash{$count},
308
308
                                     '-id'=>$seqname,
309
309
                                     '-start'=>$start,
310
310
                                     '-end'=>$end,
326
326
        $entry = $self->_readline;
327
327
    }
328
328
 
329
 
    return $aln;
 
329
    return $aln if $aln->no_sequences;
 
330
        return;
330
331
}
331
332
 
332
333
sub _read_taxlabels {
394
395
        $aln->set_displayname_flat();
395
396
        foreach $seq ( $aln->each_seq() ) {
396
397
            my $nmid = $aln->displayname($seq->get_nse());
397
 
            if( $nmid =~ /[^\w\d]/ ) {
 
398
            if( $nmid =~ /[^\w\d\.]/ ) {
398
399
              # put name in single quotes incase it contains any of
399
400
              # the following chars: ()[]{}/\,;:=*'"`+-<> that are not
400
401
              # allowed in PAUP* and possible other software