Bio/AlignIO/mase.pm

   1 #
   2 # BioPerl module for Bio::AlignIO::mase
   3
   4 #   based on the Bio::SeqIO::mase module
   5 #       by Ewan Birney <birney@ebi.ac.uk>
   6 #       and Lincoln Stein  <lstein@cshl.org>
   7 #
   8 #       and the SimpleAlign.pm module of Ewan Birney
   9 #
  10 # Copyright Peter Schattner
  11 #
  12 # You may distribute this module under the same terms as perl itself
  13 # _history
  14 # September 5, 2000
  15 # POD documentation - main docs before the code
  16
  17 =head1 NAME
  18
  19 Bio::AlignIO::mase - mase sequence input/output stream
  20
  21 =head1 SYNOPSIS
  22
  23 Do not use this module directly.  Use it via the L<Bio::AlignIO> class.
  24
  25 =head1 DESCRIPTION
  26
  27 This object can transform L<Bio::Align::AlignI> objects to and from mase flat
  28 file databases.
  29
  30 =head1 FEEDBACK
  31
  32 =head2 Support
  33
  34 Please direct usage questions or support issues to the mailing list:
  35
  36 I<bioperl-l@bioperl.org>
  37
  38 rather than to the module maintainer directly. Many experienced and
  39 reponsive experts will be able look at the problem and quickly
  40 address it. Please include a thorough description of the problem
  41 with code and data examples if at all possible.
  42
  43 =head2 Reporting Bugs
  44
  45 Report bugs to the Bioperl bug tracking system to help us keep track
  46 the bugs and their resolution.  Bug reports can be submitted via the
  47 web:
  48
  49   https://github.com/bioperl/bioperl-live/issues
  50
  51 =head1 AUTHORS - Peter Schattner
  52
  53 Email: schattner@alum.mit.edu
  54
  55
  56 =head1 APPENDIX
  57
  58 The rest of the documentation details each of the object
  59 methods. Internal methods are usually preceded with a _
  60
  61 =cut
  62
  63 # Let the code begin...
  64
  65 package Bio::AlignIO::mase;
  66 use strict;
  67
  68
  69 use base qw(Bio::AlignIO);
  70
  71
  72 =head2 next_aln
  73
  74  Title   : next_aln
  75  Usage   : $aln = $stream->next_aln()
  76  Function: returns the next alignment in the stream.
  77  Returns : L<Bio::Align::AlignI> object
  78  Args    : NONE
  79
  80 =cut
  81
  82 sub next_aln {
  83     my $self = shift;
  84     my $entry;
  85     my $name;
  86     my $start;
  87     my $end;
  88     my $seq;
  89     my $add;
  90     my $count = 0;
  91     my $seq_residues;
  92
  93     my $aln =  Bio::SimpleAlign->new(-source => 'mase');
  94
  95
  96     while( $entry = $self->_readline) {
  97         $entry =~ /^;/ && next;
  98         if(  $entry =~ /^(\S+)\/(\d+)-(\d+)/ ) {
  99             $name = $1;
 100             $start = $2;
 101             $end = $3;
 102         } else {
 103             $entry =~ s/\s//g;
 104             $name = $entry;
 105             $end = -1;
 106         }
 107
 108         $seq = "";
 109
 110         while( $entry = $self->_readline) {
 111             $entry =~ /^;/ && last;
 112             $entry =~ s/[^A-Za-z\.\-]//g;
 113             $seq .= $entry;
 114         }
 115         if( $end == -1) {
 116             $start = 1;
 117
 118             $seq_residues = $seq;
 119             $seq_residues =~ s/\W//g;
 120             $end = length($seq_residues);
 121         }
 122
 123         $add = Bio::LocatableSeq->new('-seq'        => $seq,
 124                                       '-display_id' => $name,
 125                                       '-start'      => $start,
 126                                       '-end'        => $end,
 127                                       '-alphabet'   => $self->alphabet,
 128                                       );
 129
 130
 131        $aln->add_seq($add);
 132
 133
 134 #  If $end <= 0, we have either reached the end of
 135 #  file in <> or we have encountered some other error
 136 #
 137    if ($end <= 0) { undef $aln;}
 138
 139    }
 140
 141    return $aln if $aln->num_sequences;
 142    return;
 143 }
 144
 145
 146
 147 =head2 write_aln
 148
 149  Title   : write_aln
 150  Usage   : $stream->write_aln(@aln)
 151  Function: writes the $aln object into the stream in mase format  ###Not yet implemented!###
 152  Returns : 1 for success and 0 for error
 153  Args    : L<Bio::Align::AlignI> object
 154
 155
 156 =cut
 157
 158 sub write_aln {
 159     my ($self,@aln) = @_;
 160     $self->throw_not_implemented();
 161 }
 162
 163 1;