comparison variant_effect_predictor/Bio/SeqIO/ztr.pm @ 0:1f6dce3d34e0

Uploaded
author mahtabm
date Thu, 11 Apr 2013 02:01:53 -0400
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:1f6dce3d34e0
1 # $Id: ztr.pm,v 1.8 2002/10/22 07:38:42 lapp Exp $
2 # BioPerl module for Bio::SeqIO::ztr
3 #
4 # Cared for by Aaron Mackey <amackey@virginia.edu>
5 #
6 # Copyright Aaron Mackey
7 #
8 # You may distribute this module under the same terms as perl itself
9
10 # POD documentation - main docs before the code
11
12 =head1 NAME
13
14 Bio::SeqIO::ztr - ztr trace sequence input/output stream
15
16 =head1 SYNOPSIS
17
18 Do not use this module directly. Use it via the Bio::SeqIO class.
19
20 =head1 DESCRIPTION
21
22 This object can transform Bio::Seq objects to and from ztr trace
23 files.
24
25 =head1 FEEDBACK
26
27 =head2 Mailing Lists
28
29 User feedback is an integral part of the evolution of this and other
30 Bioperl modules. Send your comments and suggestions preferably to one
31 of the Bioperl mailing lists. Your participation is much appreciated.
32
33 bioperl-l@bioperl.org - General discussion
34 http://bioperl.org/MailList.shtml - About the mailing lists
35
36 =head2 Reporting Bugs
37
38 Report bugs to the Bioperl bug tracking system to help us keep track
39 the bugs and their resolution.
40 Bug reports can be submitted via email or the web:
41
42 bioperl-bugs@bio.perl.org
43 http://bugzilla.bioperl.org/
44
45 =head1 AUTHORS - Aaron Mackey
46
47 Email: amackey@virginia.edu
48
49 =head1 APPENDIX
50
51 The rest of the documentation details each of the object
52 methods. Internal methods are usually preceded with a _
53
54 =cut
55
56 # Let the code begin...
57
58 package Bio::SeqIO::ztr;
59 use vars qw(@ISA $READ_AVAIL);
60 use strict;
61 # Object preamble - inherits from Bio::Root::Object
62
63 use Bio::SeqIO;
64 use Bio::Seq::SeqFactory;
65
66 push @ISA, qw( Bio::SeqIO );
67
68 sub BEGIN {
69 eval { require Bio::SeqIO::staden::read; };
70 if ($@) {
71 $READ_AVAIL = 0;
72 } else {
73 push @ISA, "Bio::SeqIO::staden::read";
74 $READ_AVAIL = 1;
75 }
76 }
77
78 sub _initialize {
79 my($self,@args) = @_;
80 $self->SUPER::_initialize(@args);
81 if( ! defined $self->sequence_factory ) {
82 $self->sequence_factory(new Bio::Seq::SeqFactory(-verbose => $self->verbose(), -type => 'Bio::Seq::SeqWithQuality'));
83 }
84
85 my ($compression) = $self->_rearrange([qw[COMPRESSION]], @args);
86 $compression = 2 unless defined $compression;
87 $self->compression($compression);
88
89 unless ($READ_AVAIL) {
90 Bio::Root::Root->throw( -class => 'Bio::Root::SystemException',
91 -text => "Bio::SeqIO::staden::read is not available; make sure the bioperl-ext package has been installed successfully!"
92 );
93 }
94 }
95
96 =head2 next_seq
97
98 Title : next_seq
99 Usage : $seq = $stream->next_seq()
100 Function: returns the next sequence in the stream
101 Returns : Bio::SeqWithQuality object
102 Args : NONE
103
104 =cut
105
106 sub next_seq {
107
108 my ($self) = @_;
109
110 my ($seq, $id, $desc, $qual) = $self->read_trace($self->_fh, 'ztr');
111
112 # create the seq object
113 $seq = $self->sequence_factory->create(-seq => $seq,
114 -id => $id,
115 -primary_id => $id,
116 -desc => $desc,
117 -alphabet => 'DNA',
118 -qual => $qual
119 );
120 return $seq;
121 }
122
123 =head2 write_seq
124
125 Title : write_seq
126 Usage : $stream->write_seq(@seq)
127 Function: writes the $seq object into the stream
128 Returns : 1 for success and 0 for error
129 Args : Bio::Seq object
130
131
132 =cut
133
134 sub write_seq {
135 my ($self,@seq) = @_;
136
137 my $fh = $self->_fh;
138 foreach my $seq (@seq) {
139 $self->write_trace($fh, $seq, 'ztr' . $self->compression);
140 }
141
142 $self->flush if $self->_flush_on_write && defined $self->_fh;
143 return 1;
144 }
145
146 =head2 compression
147
148 Title : compression
149 Usage : $stream->compression(3);
150 Function: determines the level of ZTR compression
151 Returns : the current (or newly set) value.
152 Args : 1, 2 or 3 - any other (defined) value will cause the compression
153 to be reset to the default of 2.
154
155
156 =cut
157
158 sub compression {
159
160 my ($self, $val) = @_;
161
162 if (defined $val) {
163 if ($val =~ m/^1|2|3$/o) {
164 $self->{_compression} = $val;
165 } else {
166 $self->{_compression} = 2;
167 }
168 }
169
170 return $self->{_compression};
171 }
172
173 1;