annotate variant_effect_predictor/Bio/EnsEMBL/Utils/ConfParser.pm @ 0:1f6dce3d34e0

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