Mercurial > repos > mahtabm > ensembl
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; |