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