0
|
1 # $Id: EMBOSS.pm,v 1.10 2002/10/22 07:38:32 lapp Exp $
|
|
2 #
|
|
3 # BioPerl module for Bio::Factory::EMBOSS
|
|
4 #
|
|
5 #
|
|
6 # Cared for by Heikki Lehvaslaiho <heikki@ebi.ac.uk>
|
|
7 #
|
|
8 # Copyright Heikki Lehvaslaiho
|
|
9 #
|
|
10 # You may distribute this module under the same terms as perl itself
|
|
11
|
|
12 # POD documentation - main docs before the code
|
|
13
|
|
14 =head1 NAME
|
|
15
|
|
16 Bio::Factory::EMBOSS - EMBOSS appliaction factory class
|
|
17
|
|
18 =head1 SYNOPSIS
|
|
19
|
|
20 # get an EMBOSS factory
|
|
21 use Bio::Factory::EMBOSS;
|
|
22 $f = Bio::Factory::EMBOSS -> new();
|
|
23 # get an EMBOSS application object from the factory
|
|
24 $water = $f->program('water');
|
|
25
|
|
26 # here is an example of running the application
|
|
27 # water can compare 1 seq against 1->many sequences
|
|
28 # in a database using Smith-Waterman
|
|
29 my $seq_to_test; # this would have a seq here
|
|
30 my @seqs_to_check; # this would be a list of seqs to compare
|
|
31 # (could be just 1)
|
|
32 my $wateroutfile = 'out.water';
|
|
33 $water->run({ '-sequencea' => $seq_to_test,
|
|
34 '-seqall' => \@seqs_to_check,
|
|
35 '-gapopen' => '10.0',
|
|
36 '-gapextend' => '0.5',
|
|
37 '-outfile' => $wateroutfile});
|
|
38 # now you might want to get the alignment
|
|
39 use Bio::AlignIO;
|
|
40 my $alnin = new Bio::AlignIO(-format => 'emboss',
|
|
41 -file => $wateroutfile);
|
|
42
|
|
43 while( my $aln = $alnin->next_aln ) {
|
|
44 # process the alignment -- these will be Bio::SimpleAlign objects
|
|
45 }
|
|
46
|
|
47 =head1 DESCRIPTION
|
|
48
|
|
49 The EMBOSS factory class encapsulates access to EMBOSS programs. A
|
|
50 factory object allows creation of only known applications.
|
|
51
|
|
52 If you want to check command line options before sending them to the
|
|
53 program set $factory-E<gt>verbose to positive integer. The value is
|
|
54 passed on to programs objects and the ADC description of the available
|
|
55 command line options is parsed and compared to input.
|
|
56
|
|
57 See also L<Bio::Tools::Run::EMBOSSApplication> and
|
|
58 L<Bio::Tools::Run::EMBOSSacd>.
|
|
59
|
|
60 =head1 FEEDBACK
|
|
61
|
|
62 =head2 Mailing Lists
|
|
63
|
|
64 User feedback is an integral part of the evolution of this and other
|
|
65 Bioperl modules. Send your comments and suggestions preferably to the
|
|
66 Bioperl mailing lists Your participation is much appreciated.
|
|
67
|
|
68 bioperl-l@bioperl.org - General discussion
|
|
69 http://bio.perl.org/MailList.html - About the mailing lists
|
|
70
|
|
71 =head2 Reporting Bugs
|
|
72
|
|
73 report bugs to the Bioperl bug tracking system to help us keep track
|
|
74 the bugs and their resolution. Bug reports can be submitted via
|
|
75 email or the web:
|
|
76
|
|
77 bioperl-bugs@bio.perl.org
|
|
78 http://bugzilla.bioperl.org/
|
|
79
|
|
80 =head1 AUTHOR - Heikki Lehvaslaiho
|
|
81
|
|
82 Email: heikki@ebi.ac.uk
|
|
83 Address:
|
|
84
|
|
85 EMBL Outstation, European Bioinformatics Institute
|
|
86 Wellcome Trust Genome Campus, Hinxton
|
|
87 Cambs. CB10 1SD, United Kingdom
|
|
88
|
|
89 =head1 APPENDIX
|
|
90
|
|
91 The rest of the documentation details each of the object
|
|
92 methods. Internal methods are usually preceded with a _
|
|
93
|
|
94 =cut
|
|
95
|
|
96 # Let the code begin...
|
|
97
|
|
98 package Bio::Factory::EMBOSS;
|
|
99 use vars qw(@ISA $EMBOSSVERSION);
|
|
100 use strict;
|
|
101
|
|
102 use Bio::Root::Root;
|
|
103 use Bio::Tools::Run::EMBOSSApplication;
|
|
104 use Bio::Factory::ApplicationFactoryI;
|
|
105 @ISA = qw(Bio::Root::Root Bio::Factory::ApplicationFactoryI );
|
|
106
|
|
107 $EMBOSSVERSION = "2.0.0";
|
|
108
|
|
109 sub new {
|
|
110 my($class,@args) = @_;
|
|
111 my $self = $class->SUPER::new(@args);
|
|
112 # set up defaults
|
|
113
|
|
114 my($location) =
|
|
115 $self->_rearrange([qw(LOCATION )],
|
|
116 @args);
|
|
117
|
|
118 $self->{ '_programs' } = {};
|
|
119 $self->{ '_programgroup' } = {};
|
|
120 $self->{ '_groups' } = {};
|
|
121
|
|
122 $self->location($location) if $location;
|
|
123
|
|
124 $self->_program_list; # retrieve info about available programs
|
|
125
|
|
126 return $self;
|
|
127
|
|
128 }
|
|
129
|
|
130 =head2 location
|
|
131
|
|
132 Title : location
|
|
133 Usage : $embossfactory->location
|
|
134 Function: get/set the location of EMBOSS programs.
|
|
135 Valid values are 'local' and 'novella'.
|
|
136 Returns : string, defaults to 'local'
|
|
137 Args : string
|
|
138
|
|
139 =cut
|
|
140
|
|
141 sub location {
|
|
142 my ($self, $value) = @_;
|
|
143 my %location = ('local' => '1',
|
|
144 'novella' => '1'
|
|
145 );
|
|
146 if (defined $value) {
|
|
147 $value = lc $value;
|
|
148 if ($location{$value}) {
|
|
149 $self->{'_location'} = $value;
|
|
150 } else {
|
|
151 $self->warn("Value [$value] not a valid value for ".
|
|
152 "location(). Defaulting to [local]");
|
|
153 $self->{'_location'} = 'local';
|
|
154 }
|
|
155 }
|
|
156 $self->{'_location'} ||= 'local';
|
|
157 return $self->{'_location'};
|
|
158 }
|
|
159
|
|
160
|
|
161 =head2 program
|
|
162
|
|
163 Title : program
|
|
164 Usage : $embossfactory->program('program_name')
|
|
165 Function: Creates a representation of a single EMBOSS program
|
|
166 Returns : Bio::Tools::Run::EMBOSSApplication object
|
|
167 Args : string, program name
|
|
168
|
|
169 =cut
|
|
170
|
|
171 sub program {
|
|
172 my ($self, $value) = @_;
|
|
173
|
|
174 unless( $self->{'_programs'}->{$value} ) {
|
|
175 $self->warn("Application [$value] is not available!");
|
|
176 return undef;
|
|
177 }
|
|
178 my $attr = {};
|
|
179 $attr->{name} = $value;
|
|
180 $attr->{verbose} = $self->verbose;
|
|
181
|
|
182 my $appl = Bio::Tools::Run::EMBOSSApplication ->new($attr);
|
|
183 return $appl;
|
|
184 }
|
|
185
|
|
186 =head2 version
|
|
187
|
|
188 Title : $self->version
|
|
189 Usage : $embossfactory->version()
|
|
190 Function: gets the version of EMBOSS programs
|
|
191 Throws : if EMBOSS suite is not accessible
|
|
192 Returns : version value
|
|
193 Args : None
|
|
194
|
|
195 =cut
|
|
196
|
|
197 sub version {
|
|
198 my ($self) = @_;
|
|
199 my ($version);
|
|
200 eval {
|
|
201 $version = `embossversion -auto`;
|
|
202 };
|
|
203 $self->throw("EMBOSS suite of programs is not available \n\n$@")
|
|
204 if $@;
|
|
205 chop $version;
|
|
206
|
|
207 # compare versions
|
|
208 my ($thisv, $embossv);
|
|
209 $version =~ /(\d+)\.(\d+)\.(\d+)/;
|
|
210 $thisv = "$1.$2$3";
|
|
211 $EMBOSSVERSION =~ /(\d+)\.(\d+)\.(\d+)/;
|
|
212 $embossv = "$1.$2$3";
|
|
213 $self->throw("EMBOSS has to be at least version $EMBOSSVERSION\n")
|
|
214 if $thisv < $embossv;
|
|
215
|
|
216 return $version;
|
|
217 }
|
|
218
|
|
219
|
|
220 =head2 Programs
|
|
221
|
|
222 These methods allow the programmer to query the EMBOSS suite and find
|
|
223 out which program names can be used and what arguments can be used.
|
|
224
|
|
225 =head2 program_info
|
|
226
|
|
227 Title : program_info
|
|
228 Usage : $embossfactory->program_info('emma')
|
|
229 Function: Finds out if the program is available.
|
|
230 Returns : definition string of the program, undef if program name not known
|
|
231 Args : string, prgramname
|
|
232
|
|
233 =cut
|
|
234
|
|
235 sub program_info {
|
|
236 my ($self, $value) = @_;
|
|
237 return $self->{'_programs'}->{$value};
|
|
238 }
|
|
239
|
|
240
|
|
241 =head2 Internal methods
|
|
242
|
|
243 Do not call these methods directly
|
|
244
|
|
245 =head2 _program_list
|
|
246
|
|
247 Title : _program_list
|
|
248 Usage : $embossfactory->_program_list()
|
|
249 Function: Finds out what programs are available.
|
|
250 Writes the names into an internal hash.
|
|
251 Returns : true if successful
|
|
252 Args : None
|
|
253
|
|
254 =cut
|
|
255
|
|
256 sub _program_list {
|
|
257 my ($self) = @_;
|
|
258 if( $^O =~ /MSWIN/i ||
|
|
259 $^O =~ /Mac/i ) { return; }
|
|
260 {
|
|
261 local * SAVERR;
|
|
262 open SAVERR, ">&STDERR";
|
|
263 open STDERR, ">/dev/null";
|
|
264 open(WOSSOUT, "wossname -auto |") || return;
|
|
265 open STDERR, ">&SAVERR";
|
|
266
|
|
267 }
|
|
268 local $/ = "\n\n";
|
|
269 while(<WOSSOUT> ) {
|
|
270 my ($groupname) = (/^([A-Z][A-Z0-9 ]+)$/m);
|
|
271 #print $groupname, "\n" if $groupname;
|
|
272 $self->{'_groups'}->{$groupname} = [] if $groupname;
|
|
273 while ( /^([a-z]\w+) +(.+)$/mg ) {
|
|
274 #print "$1\t$2 \n" if $1;
|
|
275 $self->{'_programs'}->{$1} = $2 if $1;
|
|
276 $self->{'_programgroup'}->{$1} = $groupname if $1;
|
|
277 push @{$self->{'_groups'}->{$groupname}}, $1 if $1;
|
|
278 }
|
|
279 }
|
|
280 close(WOSSOUT);
|
|
281
|
|
282 }
|
|
283
|
|
284 1;
|