annotate variant_effect_predictor/Bio/Factory/EMBOSS.pm @ 3:d30fa12e4cc5 default tip

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