Mercurial > repos > mahtabm > ensembl
diff variant_effect_predictor/Bio/SeqIO/ztr.pm @ 0:1f6dce3d34e0
Uploaded
author | mahtabm |
---|---|
date | Thu, 11 Apr 2013 02:01:53 -0400 |
parents | |
children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/variant_effect_predictor/Bio/SeqIO/ztr.pm Thu Apr 11 02:01:53 2013 -0400 @@ -0,0 +1,173 @@ +# $Id: ztr.pm,v 1.8 2002/10/22 07:38:42 lapp Exp $ +# BioPerl module for Bio::SeqIO::ztr +# +# Cared for by Aaron Mackey <amackey@virginia.edu> +# +# Copyright Aaron Mackey +# +# You may distribute this module under the same terms as perl itself + +# POD documentation - main docs before the code + +=head1 NAME + +Bio::SeqIO::ztr - ztr trace sequence input/output stream + +=head1 SYNOPSIS + +Do not use this module directly. Use it via the Bio::SeqIO class. + +=head1 DESCRIPTION + +This object can transform Bio::Seq objects to and from ztr trace +files. + +=head1 FEEDBACK + +=head2 Mailing Lists + +User feedback is an integral part of the evolution of this and other +Bioperl modules. Send your comments and suggestions preferably to one +of the Bioperl mailing lists. Your participation is much appreciated. + + bioperl-l@bioperl.org - General discussion + http://bioperl.org/MailList.shtml - About the mailing lists + +=head2 Reporting Bugs + +Report bugs to the Bioperl bug tracking system to help us keep track + the bugs and their resolution. + Bug reports can be submitted via email or the web: + + bioperl-bugs@bio.perl.org + http://bugzilla.bioperl.org/ + +=head1 AUTHORS - Aaron Mackey + +Email: amackey@virginia.edu + +=head1 APPENDIX + +The rest of the documentation details each of the object +methods. Internal methods are usually preceded with a _ + +=cut + +# Let the code begin... + +package Bio::SeqIO::ztr; +use vars qw(@ISA $READ_AVAIL); +use strict; +# Object preamble - inherits from Bio::Root::Object + +use Bio::SeqIO; +use Bio::Seq::SeqFactory; + +push @ISA, qw( Bio::SeqIO ); + +sub BEGIN { + eval { require Bio::SeqIO::staden::read; }; + if ($@) { + $READ_AVAIL = 0; + } else { + push @ISA, "Bio::SeqIO::staden::read"; + $READ_AVAIL = 1; + } +} + +sub _initialize { + my($self,@args) = @_; + $self->SUPER::_initialize(@args); + if( ! defined $self->sequence_factory ) { + $self->sequence_factory(new Bio::Seq::SeqFactory(-verbose => $self->verbose(), -type => 'Bio::Seq::SeqWithQuality')); + } + + my ($compression) = $self->_rearrange([qw[COMPRESSION]], @args); + $compression = 2 unless defined $compression; + $self->compression($compression); + + unless ($READ_AVAIL) { + Bio::Root::Root->throw( -class => 'Bio::Root::SystemException', + -text => "Bio::SeqIO::staden::read is not available; make sure the bioperl-ext package has been installed successfully!" + ); + } +} + +=head2 next_seq + + Title : next_seq + Usage : $seq = $stream->next_seq() + Function: returns the next sequence in the stream + Returns : Bio::SeqWithQuality object + Args : NONE + +=cut + +sub next_seq { + + my ($self) = @_; + + my ($seq, $id, $desc, $qual) = $self->read_trace($self->_fh, 'ztr'); + + # create the seq object + $seq = $self->sequence_factory->create(-seq => $seq, + -id => $id, + -primary_id => $id, + -desc => $desc, + -alphabet => 'DNA', + -qual => $qual + ); + return $seq; +} + +=head2 write_seq + + Title : write_seq + Usage : $stream->write_seq(@seq) + Function: writes the $seq object into the stream + Returns : 1 for success and 0 for error + Args : Bio::Seq object + + +=cut + +sub write_seq { + my ($self,@seq) = @_; + + my $fh = $self->_fh; + foreach my $seq (@seq) { + $self->write_trace($fh, $seq, 'ztr' . $self->compression); + } + + $self->flush if $self->_flush_on_write && defined $self->_fh; + return 1; +} + +=head2 compression + + Title : compression + Usage : $stream->compression(3); + Function: determines the level of ZTR compression + Returns : the current (or newly set) value. + Args : 1, 2 or 3 - any other (defined) value will cause the compression + to be reset to the default of 2. + + +=cut + +sub compression { + + my ($self, $val) = @_; + + if (defined $val) { + if ($val =~ m/^1|2|3$/o) { + $self->{_compression} = $val; + } else { + $self->{_compression} = 2; + } + } + + return $self->{_compression}; +} + +1;