Bio/SeqIO/abi.pm

   1 # BioPerl module for Bio::SeqIO::abi
   2 #
   3 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   4 #
   5 # Cared for by Aaron Mackey <amackey@virginia.edu>
   6 #
   7 # Copyright Aaron Mackey
   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::SeqIO::abi - abi trace sequence input/output stream
  16
  17 =head1 SYNOPSIS
  18
  19 Do not use this module directly.  Use it via the Bio::SeqIO class.
  20
  21 =head1 DESCRIPTION
  22
  23 This object can transform Bio::Seq objects to and from abi trace
  24 files.  To optionally read the trace graph data (which can be used
  25 to draw chromatographs, for instance), set the optional
  26 '-get_trace_data' flag or the get_trace_data method to a value
  27 evaluating to TRUE.
  28
  29 =head1 FEEDBACK
  30
  31 =head2 Mailing Lists
  32
  33 User feedback is an integral part of the evolution of this and other
  34 Bioperl modules. Send your comments and suggestions preferably to one
  35 of the Bioperl mailing lists.  Your participation is much appreciated.
  36
  37   bioperl-l@bioperl.org                  - General discussion
  38   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  39
  40 =head2 Support
  41
  42 Please direct usage questions or support issues to the mailing list:
  43
  44 I<bioperl-l@bioperl.org>
  45
  46 rather than to the module maintainer directly. Many experienced and
  47 reponsive experts will be able look at the problem and quickly
  48 address it. Please include a thorough description of the problem
  49 with code and data examples if at all possible.
  50
  51 =head2 Reporting Bugs
  52
  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 the web:
  56
  57   https://github.com/bioperl/bioperl-live/issues
  58
  59 =head1 AUTHORS - Aaron Mackey
  60
  61 Email: amackey@virginia.edu
  62
  63 =head1 APPENDIX
  64
  65 The rest of the documentation details each of the object
  66 methods. Internal methods are usually preceded with a _
  67
  68 =cut
  69
  70 # Let the code begin...
  71
  72 package Bio::SeqIO::abi;
  73 use vars qw(@ISA $READ_AVAIL);
  74 use strict;
  75
  76 use Bio::SeqIO;
  77 use Bio::Seq::SeqFactory;
  78
  79 push @ISA, qw( Bio::SeqIO );
  80
  81 sub BEGIN {
  82     eval { require Bio::SeqIO::staden::read; };
  83     if ($@) {
  84         $READ_AVAIL = 0;
  85     } else {
  86         push @ISA, "Bio::SeqIO::staden::read";
  87         $READ_AVAIL = 1;
  88     }
  89 }
  90
  91 sub _initialize {
  92   my($self,@args) = @_;
  93   $self->SUPER::_initialize(@args);
  94   my ($get_trace) = $self->_rearrange([qw(get_trace_data)],@args);
  95   $get_trace && $self->get_trace_data(1);
  96   if( ! defined $self->sequence_factory ) {
  97       $self->sequence_factory(Bio::Seq::SeqFactory->new(-verbose => $self->verbose(), -type => 'Bio::Seq::Quality'));
  98   }
  99   unless ($READ_AVAIL) {
 100       Bio::Root::Root->throw( -class => 'Bio::Root::SystemException',
 101                               -text  => "Bio::SeqIO::staden::read is not available; make sure the bioperl-ext package has been installed successfully!"
 102                             );
 103   }
 104 }
 105
 106 =head2 next_seq
 107
 108  Title   : next_seq
 109  Usage   : $seq = $stream->next_seq()
 110  Function: returns the next sequence in the stream
 111  Returns : Bio::Seq::Quality object
 112  Args    : NONE
 113
 114 =cut
 115
 116 sub next_seq {
 117
 118     my ($self) = @_;
 119
 120     my ($seq, $id, $desc, $qual) = $self->read_trace($self->_fh, 'abi');
 121
 122     # create the seq object
 123         my ($base_locs, $a_trace, $c_trace, $g_trace, $t_trace, $points, $max_height);
 124         if ($self->get_trace_data) {
 125                 ($base_locs, $a_trace, $c_trace, $g_trace, $t_trace, $points, $max_height) = $self->read_trace_with_graph($self->_fh, 'abi');
 126         } else {
 127                 $base_locs = [];
 128         }
 129
 130     # create the seq object
 131     $seq = $self->sequence_factory->create(-seq        => $seq,
 132                                            -id         => $id,
 133                                            -primary_id => $id,
 134                                            -desc       => $desc,
 135                                            -alphabet   => 'DNA',
 136                                            -qual       => $qual,
 137                                            -trace      => join (" ", @{$base_locs}),
 138                                            -trace_data => { a_trace => $a_trace,
 139                                                                            c_trace => $c_trace,
 140                                                                            g_trace => $g_trace,
 141                                                                            t_trace => $t_trace,
 142                                                             max_height => $max_height,
 143                                                                 num_points => $points }
 144                                            );
 145     return $seq;
 146 }
 147
 148 =head2 write_seq
 149
 150  Title   : write_seq
 151  Usage   : $stream->write_seq(@seq)
 152  Function: writes the $seq object into the stream
 153  Returns : 1 for success and 0 for error
 154  Args    : Bio::Seq object
 155
 156
 157 =cut
 158
 159 sub write_seq {
 160     my ($self,@seq) = @_;
 161
 162     my $fh = $self->_fh;
 163     foreach my $seq (@seq) {
 164         $self->write_trace($fh, $seq, 'abi');
 165     }
 166
 167     $self->flush if $self->_flush_on_write && defined $self->_fh;
 168     return 1;
 169 }
 170
 171 =head2 get_trace_data
 172
 173  Title   : get_trace_data
 174  Usage   : $stream->get_trace_data(1)
 175  Function: set boolean flag to retrieve the trace data (possibly for
 176            output)
 177  Returns : bool value, TRUE = retrieve trace data (default FALSE)
 178  Args    : bool value
 179
 180 =cut
 181
 182 sub get_trace_data {
 183         my ($self, $val) = @_;
 184         $self->{_get_trace_data} = $val ? 1 : 0 if (defined $val);
 185         $self->{_get_trace_data};
 186 }
 187
 188 1;