Mercurial > repos > mahtabm > ensembl
comparison variant_effect_predictor/Bio/EnsEMBL/Utils/ConfParser.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 =head1 LICENSE | |
2 | |
3 Copyright (c) 1999-2012 The European Bioinformatics Institute and | |
4 Genome Research Limited. All rights reserved. | |
5 | |
6 This software is distributed under a modified Apache license. | |
7 For license details, please see | |
8 | |
9 http://www.ensembl.org/info/about/code_licence.html | |
10 | |
11 =head1 CONTACT | |
12 | |
13 Please email comments or questions to the public Ensembl | |
14 developers list at <dev@ensembl.org>. | |
15 | |
16 Questions may also be sent to the Ensembl help desk at | |
17 <helpdesk@ensembl.org>. | |
18 | |
19 =cut | |
20 | |
21 =head1 NAME | |
22 | |
23 Bio::EnsEMBL::Utils::ConfParser - configuration parser for perl scripts | |
24 | |
25 =head1 SYNOPSIS | |
26 | |
27 my $conf = new Bio::EnsEMBL::Utils::ConfParser( | |
28 -SERVERROOT => "/path/to/ensembl", | |
29 -DEFAULT_CONF => "my.default.conf" | |
30 ); | |
31 | |
32 # parse options from configuration file and commandline | |
33 $conf->parse_options( | |
34 'mandatory_string_opt=s' => 1, | |
35 'optional_numeric_opt=n' => 0, | |
36 ); | |
37 | |
38 # get a paramter value | |
39 my $val = $conf->param('manadatory_string_op'); | |
40 | |
41 =head1 DESCRIPTION | |
42 | |
43 This module parses a configuration file and the commandline options | |
44 passed to a script (the latter superseed the former). Configuration | |
45 files contain ini-file style name-value pairs, and the commandline | |
46 options are passed to Getopt::Long for parsing. | |
47 | |
48 The parameter values are consequently accessible via the param() | |
49 method. You can also create a commandline string of all current | |
50 parameters and their values to pass to another script. | |
51 | |
52 =cut | |
53 | |
54 package Bio::EnsEMBL::Utils::ConfParser; | |
55 | |
56 use strict; | |
57 use warnings; | |
58 no warnings 'uninitialized'; | |
59 | |
60 use Getopt::Long; | |
61 use Text::Wrap; | |
62 use Cwd qw(abs_path); | |
63 use Pod::Usage qw(pod2usage); | |
64 use Bio::EnsEMBL::Utils::Argument qw(rearrange); | |
65 use Bio::EnsEMBL::Utils::Exception qw(throw warning); | |
66 use Bio::EnsEMBL::Utils::ScriptUtils qw(user_proceed); | |
67 | |
68 | |
69 =head2 new | |
70 | |
71 Arg [SERVERROOT] : | |
72 String $serverroot - root directory of your ensembl code | |
73 Arg [DEFAULT_CONF] : | |
74 String $default_conf - default configuration file | |
75 Example : my $conf = new Bio::EnsEMBL::Utils::ConfParser( | |
76 -SERVERROOT => '/path/to/ensembl', | |
77 -DEFAULT_CONF => 'my.default.conf' | |
78 ); | |
79 Description : object constructor | |
80 Return type : Bio::EnsEMBL::Utils::ConfParser object | |
81 Exceptions : thrown if no serverroot is provided | |
82 Caller : general | |
83 Status : At Risk | |
84 : under development | |
85 | |
86 =cut | |
87 | |
88 sub new { | |
89 my $caller = shift; | |
90 my $class = ref($caller) || $caller; | |
91 | |
92 my ($serverroot, $default_conf) = | |
93 rearrange([qw(SERVERROOT DEFAULT_CONF)], @_); | |
94 | |
95 throw("You must supply a serverroot.") unless ($serverroot); | |
96 | |
97 my $self = {}; | |
98 bless ($self, $class); | |
99 | |
100 $self->serverroot($serverroot); | |
101 $self->default_conf($default_conf || "$ENV{HOME}/.ensembl_script.conf"); | |
102 | |
103 return $self; | |
104 } | |
105 | |
106 | |
107 =head2 parse_options | |
108 | |
109 Arg[1..n] : pairs of option definitions and mandatory flag (see below for | |
110 details) | |
111 Example : $conf->parse_options( | |
112 'mandatory_string_opt=s' => 1, | |
113 'optional_numeric_opt=n' => 0, | |
114 ); | |
115 Description : This method reads options from an (optional) configuration file | |
116 and parses the commandline options supplied by the user. | |
117 Commandline options will superseed config file settings. The | |
118 string "$SERVERROOT" in the configuration entries will be | |
119 replaced by the appropriate value. | |
120 | |
121 The arguments passed to this method are pairs of a Getopt::Long | |
122 style option definition (in fact it will be passed to | |
123 GetOptions() directly) and a flag indicating whether this | |
124 option is mandatory (1) or optional (0). | |
125 | |
126 In addition to these user-defined options, a set of common | |
127 options is always parsed. See _common_options() for details. | |
128 | |
129 If you run your script with --interactive the user will be | |
130 asked to confirm the parameters after parsing. | |
131 | |
132 All parameters will then be accessible via $self->param('name'). | |
133 Return type : true on success | |
134 Exceptions : thrown if configuration file can't be opened | |
135 thrown on missing mandatory parameters | |
136 Caller : general | |
137 Status : At Risk | |
138 : under development | |
139 | |
140 =cut | |
141 | |
142 sub parse_options { | |
143 my ($self, @params) = @_; | |
144 | |
145 # add common options to user supplied list | |
146 push @params, $self->_common_options; | |
147 | |
148 # read common commandline options | |
149 my %h; | |
150 my %params = @params; | |
151 | |
152 Getopt::Long::Configure('pass_through'); | |
153 &GetOptions(\%h, keys %params); | |
154 | |
155 # reads config file | |
156 my $conffile = $h{'conffile'} || $self->default_conf; | |
157 $conffile = abs_path($conffile); | |
158 | |
159 if (-e $conffile) { | |
160 open(CONF, $conffile) or throw( | |
161 "Unable to open configuration file $conffile for reading: $!"); | |
162 | |
163 my $serverroot = $self->serverroot; | |
164 my $last; | |
165 | |
166 while (my $line = <CONF>) { | |
167 chomp $line; | |
168 | |
169 # remove leading and trailing whitespace | |
170 $line =~ s/^\s*//; | |
171 $line =~ s/\s*$//; | |
172 | |
173 # join with next line if terminated with backslash (this is to allow | |
174 # multiline configuration settings | |
175 $line = $last . $line; | |
176 if ($line =~ /\\$/) { | |
177 $line =~ s/\\$//; | |
178 $last = $line; | |
179 next; | |
180 } else { | |
181 $last = undef; | |
182 } | |
183 | |
184 # remove comments | |
185 $line =~ s/^[#;].*//; | |
186 $line =~ s/\s+[;].*$//; | |
187 | |
188 # read options into internal parameter datastructure | |
189 next unless ($line =~ /(\w\S*)\s*=\s*(.*)/); | |
190 my $name = $1; | |
191 my $val = $2; | |
192 | |
193 # strip optional quotes from parameter values | |
194 $val =~ s/^["'](.*)["']/$1/; | |
195 | |
196 # replace $SERVERROOT with value | |
197 if ($val =~ /\$SERVERROOT/) { | |
198 $val =~ s/\$SERVERROOT/$serverroot/g; | |
199 $val = abs_path($val); | |
200 } | |
201 $self->param($name, $val); | |
202 } | |
203 | |
204 $self->param('conffile', $conffile); | |
205 } | |
206 | |
207 # override configured parameter with commandline options | |
208 map { $self->param($_, $h{$_}) } keys %h; | |
209 | |
210 # check for required params, convert comma to list, maintain an ordered | |
211 # list of parameters and list of 'flag' type params | |
212 my @missing = (); | |
213 my $i = 0; | |
214 | |
215 foreach my $param (@params) { | |
216 next if ($i++ % 2); | |
217 | |
218 my $required = $params{$param}; | |
219 my ($list, $flag); | |
220 $list = 1 if ($param =~ /\@$/); | |
221 $flag = 1 if ($param =~ /!$/); | |
222 $param =~ s/(^\w+).*/$1/; | |
223 | |
224 $self->comma_to_list($param) if ($list); | |
225 | |
226 push @missing, $param if ($required and !$self->param($param)); | |
227 push @{ $self->{'_ordered_params'} }, $param; | |
228 $self->{'_flag_params'}->{$param} = 1 if ($flag); | |
229 } | |
230 | |
231 if (@missing) { | |
232 throw("Missing parameters: @missing.\nYou must specify them on the commandline or in your conffile.\n"); | |
233 } | |
234 | |
235 # error handling and --help | |
236 pod2usage(1) if ($self->param('help')); | |
237 | |
238 # ask user to confirm parameters to proceed | |
239 $self->confirm_params; | |
240 | |
241 return(1); | |
242 } | |
243 | |
244 | |
245 # | |
246 # Commonly used options. These are parsed by default even if they are not | |
247 # passed to parse_options() explicitely. | |
248 # | |
249 sub _common_options { | |
250 my $self = shift; | |
251 return ( | |
252 'conffile|conf=s' => 0, | |
253 'logfile|log=s' => 0, | |
254 'logauto!' => 0, | |
255 'logautobase=s' => 0, | |
256 'logautoid=s' => 0, | |
257 'logpath=s' => 0, | |
258 'logappend|log_append|log-append!' => 0, | |
259 'loglevel=s' => 0, | |
260 'is_component|is-component!' => 0, | |
261 'interactive|i!' => 0, | |
262 'dry_run|dry-run|dry|n!' => 0, | |
263 'help|h|?' => 0, | |
264 ); | |
265 } | |
266 | |
267 | |
268 =head2 confirm_params | |
269 | |
270 Example : $conf->confirm_params; | |
271 Description : If the script is run with the --interactive switch, this method | |
272 prints a table of all parameters and their values and asks user | |
273 to confirm if he wants to proceed. | |
274 Return type : true on success | |
275 Exceptions : none | |
276 Caller : parse_options() | |
277 Status : At Risk | |
278 : under development | |
279 | |
280 =cut | |
281 | |
282 sub confirm_params { | |
283 my $self = shift; | |
284 | |
285 if ($self->param('interactive')) { | |
286 # print parameter table | |
287 print "Running script with these parameters:\n\n"; | |
288 print $self->list_param_values; | |
289 | |
290 # ask user if he wants to proceed | |
291 exit unless user_proceed("Continue?", 1, 'n'); | |
292 } | |
293 | |
294 return(1); | |
295 } | |
296 | |
297 | |
298 =head2 param | |
299 | |
300 Arg[1] : Parameter name | |
301 Arg[2..n] : (optional) List of values to set | |
302 Example : # getter | |
303 my $dbname = $conf->param('dbname'); | |
304 | |
305 # setter | |
306 $conf->param('port', 3306); | |
307 $conf->param('chromosomes', 1, 6, 'X'); | |
308 Description : Getter/setter for parameters. Accepts single-value params and | |
309 list params. | |
310 Return type : Scalar value for single-value parameters, array of values for | |
311 list parameters | |
312 Exceptions : thrown if no parameter name is supplied | |
313 Caller : general | |
314 Status : At Risk | |
315 : under development | |
316 | |
317 =cut | |
318 | |
319 sub param { | |
320 my $self = shift; | |
321 my $name = shift or throw("You must supply a parameter name"); | |
322 | |
323 # setter | |
324 if (@_) { | |
325 if (scalar(@_) == 1) { | |
326 # single value | |
327 $self->{'_param'}->{$name} = shift; | |
328 } else { | |
329 # list of values | |
330 undef $self->{'_param'}->{$name}; | |
331 @{ $self->{'_param'}->{$name} } = @_; | |
332 } | |
333 } | |
334 | |
335 # getter | |
336 if (ref($self->{'_param'}->{$name}) eq 'ARRAY') { | |
337 # list parameter | |
338 return @{ $self->{'_param'}->{$name} }; | |
339 } elsif (defined($self->{'_param'}->{$name})) { | |
340 # single-value parameter | |
341 return $self->{'_param'}->{$name}; | |
342 } else { | |
343 return undef; | |
344 } | |
345 } | |
346 | |
347 | |
348 =head2 is_true | |
349 | |
350 Arg[1] : Parameter name | |
351 Example : unless ($conf->is_true('upload')) { | |
352 print "Won't upload data.\n"; | |
353 next; | |
354 } | |
355 Description : Checks whether a param value is set to 'true', which is defined | |
356 here as TRUE (in the Perl sense) but not the string 'no'. | |
357 Return type : Boolean | |
358 Exceptions : thrown if no parameter name is supplied | |
359 Caller : general | |
360 Status : At Risk | |
361 : under development | |
362 | |
363 =cut | |
364 | |
365 sub is_true { | |
366 my $self = shift; | |
367 my $name = shift or throw("You must supply a parameter name"); | |
368 | |
369 my $param = $self->param($name); | |
370 | |
371 if ($param and !($param =~ /^no$/i)) { | |
372 return(1); | |
373 } else { | |
374 return(0); | |
375 } | |
376 } | |
377 | |
378 | |
379 =head2 list_params | |
380 | |
381 Example : print "Current parameter names:\n"; | |
382 foreach my $param (@{ $conf->list_params }) { | |
383 print " $param\n"; | |
384 } | |
385 Description : Returns a list of the currently available parameter names. The | |
386 list will be in the same order as option definitions were | |
387 passed to the new() method. | |
388 Return type : Arrayref of parameter names | |
389 Exceptions : none | |
390 Caller : list_param_values(), create_commandline_options() | |
391 Status : At Risk | |
392 : under development | |
393 | |
394 =cut | |
395 | |
396 sub list_params { | |
397 my $self = shift; | |
398 return $self->{'_ordered_params'} || []; | |
399 } | |
400 | |
401 | |
402 =head2 list_param_values | |
403 | |
404 Example : print LOG $conf->list_param_values; | |
405 Description : prints a table of the parameters used in the script | |
406 Return type : String - the table to print | |
407 Exceptions : none | |
408 Caller : general | |
409 Status : At Risk | |
410 : under development | |
411 | |
412 =cut | |
413 | |
414 sub list_param_values { | |
415 my $self = shift; | |
416 | |
417 $Text::Wrap::colums = 72; | |
418 | |
419 my $txt = sprintf " %-20s%-40s\n", qw(PARAMETER VALUE); | |
420 $txt .= " " . "-"x70 . "\n"; | |
421 | |
422 foreach my $key (@{ $self->list_params }) { | |
423 my $val; | |
424 if (defined($self->param($key))) { | |
425 $txt .= Text::Wrap::wrap(sprintf(' %-19s ', $key), ' 'x24, | |
426 join(", ", $self->param($key)))."\n"; | |
427 } | |
428 } | |
429 | |
430 $txt .= "\n"; | |
431 | |
432 return $txt; | |
433 } | |
434 | |
435 | |
436 =head2 create_commandline_options | |
437 | |
438 Arg[1..n] : param/value pairs which should be added to or override the | |
439 currently defined parameters | |
440 Example : $conf->create_commandline_options( | |
441 'dbname' => 'homo_sapiens_vega_33_35e', | |
442 'interactive' => 0 | |
443 ); | |
444 Description : Creates a commandline options string of all current paramters | |
445 that can be passed to another script. | |
446 Return type : String - commandline options string | |
447 Exceptions : none | |
448 Caller : general | |
449 Status : At Risk | |
450 : under development | |
451 | |
452 =cut | |
453 | |
454 sub create_commandline_options { | |
455 my ($self, %replace) = @_; | |
456 | |
457 my %param_hash; | |
458 | |
459 # deal with list values | |
460 foreach my $param (@{ $self->list_params }) { | |
461 my ($first, @rest) = $self->param($param); | |
462 next unless (defined($first)); | |
463 | |
464 if (@rest) { | |
465 $first = join(",", $first, @rest); | |
466 } | |
467 $param_hash{$param} = $first; | |
468 } | |
469 | |
470 # replace values | |
471 foreach my $key (keys %replace) { | |
472 $param_hash{$key} = $replace{$key}; | |
473 } | |
474 | |
475 # create the commandline options string | |
476 my $options_string; | |
477 foreach my $param (keys %param_hash) { | |
478 | |
479 my $val = $param_hash{$param}; | |
480 | |
481 # deal with 'flag' type params correctly | |
482 if ($self->{'_flag_params'}->{$param}) { | |
483 # change 'myparam' to 'nomyparam' if no value set | |
484 $param = 'no'.$param unless ($val); | |
485 | |
486 # unset value (this is how flags behave) | |
487 $val = undef; | |
488 } else { | |
489 # don't add the param if it's not a flag param and no value is set | |
490 next unless (defined($val)); | |
491 | |
492 # quote the value if it contains blanks | |
493 if ($val =~ /\s+/) { | |
494 # use an appropriate quoting style | |
495 ($val =~ /'/) ? ($val = qq("$val")) : ($val = qq('$val')); | |
496 } | |
497 } | |
498 | |
499 $options_string .= sprintf(qq(--%s %s ), $param, $val); | |
500 } | |
501 | |
502 return $options_string; | |
503 } | |
504 | |
505 | |
506 =head2 comma_to_list | |
507 | |
508 Arg[1..n] : list of parameter names to parse | |
509 Example : $conf->comma_to_list('chromosomes'); | |
510 Description : Transparently converts comma-separated lists into arrays (to | |
511 allow different styles of commandline options, see perldoc | |
512 Getopt::Long for details). Parameters are converted in place | |
513 (accessible through $self->param('name')). | |
514 Return type : true on success | |
515 Exceptions : none | |
516 Caller : general | |
517 Status : At Risk | |
518 : under development | |
519 | |
520 =cut | |
521 | |
522 sub comma_to_list { | |
523 my $self = shift; | |
524 | |
525 foreach my $param (@_) { | |
526 $self->param($param, split (/,/, join (',', $self->param($param)))); | |
527 } | |
528 | |
529 return(1); | |
530 } | |
531 | |
532 | |
533 =head2 list_or_file | |
534 | |
535 Arg[1] : Name of parameter to parse | |
536 Example : $conf->list_or_file('gene'); | |
537 Description : Determines whether a parameter holds a list or it is a filename | |
538 to read the list entries from. | |
539 Return type : true on success | |
540 Exceptions : thrown if list file can't be opened | |
541 Caller : general | |
542 Status : At Risk | |
543 : under development | |
544 | |
545 =cut | |
546 | |
547 sub list_or_file { | |
548 my ($self, $param) = @_; | |
549 | |
550 my @vals = $self->param($param); | |
551 return unless (@vals); | |
552 | |
553 my $firstval = $vals[0]; | |
554 | |
555 if (scalar(@vals) == 1 && -e $firstval) { | |
556 # we didn't get a list of values, but a file to read values from | |
557 @vals = (); | |
558 | |
559 open(IN, $firstval) or throw("Cannot open $firstval for reading: $!"); | |
560 | |
561 while(<IN>){ | |
562 chomp; | |
563 push(@vals, $_); | |
564 } | |
565 | |
566 close(IN); | |
567 | |
568 $self->param($param, @vals); | |
569 } | |
570 | |
571 $self->comma_to_list($param); | |
572 | |
573 return(1); | |
574 } | |
575 | |
576 | |
577 =head2 serverroot | |
578 | |
579 Arg[1] : (optional) String - root directory of your ensembl checkout | |
580 Example : my $serverroot = $conf->serverroot; | |
581 Description : Getter/setter for the root directory of your ensembl checkout. | |
582 Return type : String | |
583 Exceptions : none | |
584 Caller : new(), general | |
585 Status : At Risk | |
586 : under development | |
587 | |
588 =cut | |
589 | |
590 sub serverroot { | |
591 my $self = shift; | |
592 $self->{'_serverroot'} = shift if (@_); | |
593 return $self->{'_serverroot'}; | |
594 } | |
595 | |
596 | |
597 =head2 default_conf | |
598 | |
599 Arg[1] : (optional) String - default configuration file | |
600 Example : $conf->default_conf('my.default.conf'); | |
601 Description : Getter/setter for the default configuration file. | |
602 Return type : String | |
603 Exceptions : none | |
604 Caller : new(), general | |
605 Status : At Risk | |
606 : under development | |
607 | |
608 =cut | |
609 | |
610 sub default_conf { | |
611 my $self = shift; | |
612 $self->{'_default_conf'} = shift if (@_); | |
613 return $self->{'_default_conf'}; | |
614 } | |
615 | |
616 | |
617 1; | |
618 |