0
|
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
|