annotate variant_effect_predictor/Bio/Factory/EMBOSS.pm @ 1:d6778b5d8382 draft default tip

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