line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
############################################################################# |
3
|
|
|
|
|
|
|
## $Id: Options.pm 14478 2010-10-12 15:49:12Z spadkins $ |
4
|
|
|
|
|
|
|
############################################################################# |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
package App::Options; |
7
|
|
|
|
|
|
|
|
8
|
2
|
|
|
2
|
|
41036
|
use vars qw($VERSION); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
669
|
|
9
|
2
|
|
|
2
|
|
11
|
use strict; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
56
|
|
10
|
|
|
|
|
|
|
|
11
|
2
|
|
|
2
|
|
10
|
use Carp; |
|
2
|
|
|
|
|
20
|
|
|
2
|
|
|
|
|
145
|
|
12
|
2
|
|
|
2
|
|
2012
|
use Sys::Hostname; |
|
2
|
|
|
|
|
2670
|
|
|
2
|
|
|
|
|
106
|
|
13
|
2
|
|
|
2
|
|
12
|
use Cwd 'abs_path'; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
84
|
|
14
|
2
|
|
|
2
|
|
13
|
use File::Spec; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
41
|
|
15
|
2
|
|
|
2
|
|
9
|
use Config; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
22101
|
|
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
$VERSION = "1.12"; |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
=head1 NAME |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
App::Options - Combine command line options, environment vars, and option file values (for program configuration) |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
=head1 SYNOPSIS |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
#!/usr/bin/perl -w |
26
|
|
|
|
|
|
|
use strict; |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
use App::Options; # reads option values into %App::options by default |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
# do something with the options (in %App::options) |
31
|
|
|
|
|
|
|
use DBI; |
32
|
|
|
|
|
|
|
$dsn = "dbi:mysql:database=$App::options{dbname}"; |
33
|
|
|
|
|
|
|
$dbh = DBI->connect($dsn, $App::options{dbuser}, $App::options{dbpass}); |
34
|
|
|
|
|
|
|
... |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
Get help from the command line (assuming program is named "prog") ... |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
prog -? |
39
|
|
|
|
|
|
|
prog --help |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
Option values may be provided on the command line, in environment |
42
|
|
|
|
|
|
|
variables, and option files. (i.e. $ENV{APP_DBNAME} would set |
43
|
|
|
|
|
|
|
the value of %App::options{dbname} by default.) |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
The "dbname" and other options could also be set in one of the |
46
|
|
|
|
|
|
|
following configuration files |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
/etc/app/policy.conf |
49
|
|
|
|
|
|
|
$HOME/.app/prog.conf |
50
|
|
|
|
|
|
|
$HOME/.app/app.conf |
51
|
|
|
|
|
|
|
$PROGDIR/prog.conf |
52
|
|
|
|
|
|
|
$PROGDIR/app.conf |
53
|
|
|
|
|
|
|
$PREFIX/etc/app/prog.conf |
54
|
|
|
|
|
|
|
$PREFIX/etc/app/app.conf |
55
|
|
|
|
|
|
|
/etc/app/app.conf |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
with a file format like |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
[prog] |
60
|
|
|
|
|
|
|
dbname = prod |
61
|
|
|
|
|
|
|
dbuser = scott |
62
|
|
|
|
|
|
|
dbpass = tiger |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
See below for a more detailed explanation of these and other |
65
|
|
|
|
|
|
|
advanced features. |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
=head1 DESCRIPTION |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
App::Options combines command-line arguments, environment variables, |
70
|
|
|
|
|
|
|
option files, and program defaults to produce a hash of |
71
|
|
|
|
|
|
|
option values. |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
=head1 RELATION TO OTHER CONFIGURATION/OPTION PARSING MODULES |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
A number of modules are posted on CPAN which do command-line |
76
|
|
|
|
|
|
|
processing. |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
http://search.cpan.org/modlist/Option_Parameter_Config_Processing |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
App::Options is different than most of the Getopt::* modules |
81
|
|
|
|
|
|
|
because it integrates the processing of command line options, |
82
|
|
|
|
|
|
|
environment variables, and config files. |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
Furthermore, its special treatment of the "perlinc" |
85
|
|
|
|
|
|
|
option facilitates the inclusion ("use") of application-specific |
86
|
|
|
|
|
|
|
perl modules from special places to enable the installation of |
87
|
|
|
|
|
|
|
multiple versions of an application on the same system (i.e. |
88
|
|
|
|
|
|
|
/usr/myproduct/version). |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
The description of the AppConfig distribution sounds similar |
91
|
|
|
|
|
|
|
to what is described here. However, the following are some key |
92
|
|
|
|
|
|
|
differences. |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
* App::Options does its option processing in the BEGIN block. |
95
|
|
|
|
|
|
|
This allows for the @INC variable to be modified in time |
96
|
|
|
|
|
|
|
for subsequent "use" and "require" statements. |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
* App::Options "sections" (i.e. "[cleanup]") are conditional. |
99
|
|
|
|
|
|
|
It is conditional in App::Options, allowing you to use one |
100
|
|
|
|
|
|
|
set of option files to configure an entire suite of programs |
101
|
|
|
|
|
|
|
and scripts. In AppConfig, the section name is simply a |
102
|
|
|
|
|
|
|
prefix which gets prepended to subsequest option names. |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
* App::Options consults a cascading set of option files. |
105
|
|
|
|
|
|
|
These files include those which are system global, project |
106
|
|
|
|
|
|
|
global, and user private. This allows for system |
107
|
|
|
|
|
|
|
administrators, project developers, and individual |
108
|
|
|
|
|
|
|
users to all have complementary roles in defining |
109
|
|
|
|
|
|
|
the configuration values. |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
* App::Options is not a toolkit but a standardized way of |
112
|
|
|
|
|
|
|
doing option processing. With AppConfig, you still have |
113
|
|
|
|
|
|
|
to decide where to put config files, and you still have to |
114
|
|
|
|
|
|
|
code the "--help" feature. With App::Options, you simply |
115
|
|
|
|
|
|
|
"use App::Options;" and all the hard work is done. |
116
|
|
|
|
|
|
|
Advanced options can be added later as necessary as args |
117
|
|
|
|
|
|
|
to the "use App::Options;" statement. |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
App::Options is also the easiest command-line processing system |
120
|
|
|
|
|
|
|
that I have found anywhere. It then provides a smooth transition to |
121
|
|
|
|
|
|
|
more advanced features only as they are needed. Every single |
122
|
|
|
|
|
|
|
quick and dirty script I ever write from now on can afford |
123
|
|
|
|
|
|
|
to use App::Options. |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
The documentation of App::Options takes three forms below. |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
API Reference - describing the API (methods, args) |
128
|
|
|
|
|
|
|
Logic Flow - describing the order and logic of processing |
129
|
|
|
|
|
|
|
Usage Tutorial - describing how to use the API in practical situations |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
=head1 RELATION TO THE P5EE PROJECT |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
App::Options was motivated by and supports the P5EE/App-Context variant |
134
|
|
|
|
|
|
|
of the Perl 5 Enterprise Environment (P5EE). However, App::Options has no |
135
|
|
|
|
|
|
|
dependency on any other module in the P5EE project, and it is very useful |
136
|
|
|
|
|
|
|
without any knowledge or use of other elements of the P5EE project. |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
See the P5EE web sites for more information on the P5EE project. |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
http://www.officevision.com/pub/p5ee/index.html |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
=head1 API REFERENCE: Methods |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
=cut |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
############################################################################# |
147
|
|
|
|
|
|
|
# init() |
148
|
|
|
|
|
|
|
############################################################################# |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
=head2 init() |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
* Signature: App::Options->init(); |
153
|
|
|
|
|
|
|
* Signature: App::Options->init(%named); |
154
|
|
|
|
|
|
|
* Signature: App::Options->init($myvalues); |
155
|
|
|
|
|
|
|
* Signature: App::Options->init($myvalues, %named); |
156
|
|
|
|
|
|
|
(NOTE: %named represents a list of name/value pairs used as named args. |
157
|
|
|
|
|
|
|
Params listed below without a $ are named args.) |
158
|
|
|
|
|
|
|
* Param: $myvalues HASH |
159
|
|
|
|
|
|
|
specify a hash reference other than %App::options to put |
160
|
|
|
|
|
|
|
configuration values in. |
161
|
|
|
|
|
|
|
* Param: values HASH |
162
|
|
|
|
|
|
|
specify a hash reference other than %App::options to put |
163
|
|
|
|
|
|
|
configuration values in. |
164
|
|
|
|
|
|
|
* Param: options ARRAY |
165
|
|
|
|
|
|
|
specify a limited, ordered list of options to be displayed |
166
|
|
|
|
|
|
|
when the "--help" or "-?" options are invoked |
167
|
|
|
|
|
|
|
* Param: option HASH |
168
|
|
|
|
|
|
|
specify additional attributes of any of |
169
|
|
|
|
|
|
|
the various options to the program (see below) |
170
|
|
|
|
|
|
|
* Param: no_cmd_args |
171
|
|
|
|
|
|
|
do not process command line arguments |
172
|
|
|
|
|
|
|
* Param: no_env_vars |
173
|
|
|
|
|
|
|
do not read environment variables |
174
|
|
|
|
|
|
|
* Param: no_option_file |
175
|
|
|
|
|
|
|
do not read in the option file(s) |
176
|
|
|
|
|
|
|
* Param: print_usage |
177
|
|
|
|
|
|
|
provide an alternate print_usage() function |
178
|
|
|
|
|
|
|
* Return: void |
179
|
|
|
|
|
|
|
* Throws: "App::Options->init(): must have an even number of vars/values for named args" |
180
|
|
|
|
|
|
|
* Throws: "App::Options->init(): 'values' arg must be a hash reference" |
181
|
|
|
|
|
|
|
* Throws: "App::Options->init(): 'option' arg must be a hash reference" |
182
|
|
|
|
|
|
|
* Throws: "App::Options->init(): 'options' arg must be an array reference" |
183
|
|
|
|
|
|
|
* Since: 0.60 |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
Sample Usage: (normal) |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
use App::Options; # invokes init() automatically via import() |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
This is functionally equivalent to the following, but that's not |
190
|
|
|
|
|
|
|
near as nice to write at the top of your programs. |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
BEGIN { |
193
|
|
|
|
|
|
|
use App::Options qw(:none); # import() does not call init() |
194
|
|
|
|
|
|
|
App::Options->init(); # we call init() manually |
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
Or we could have used a more full-featured version ... |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
use App::Options ( |
200
|
|
|
|
|
|
|
values => \%MyPackage::options, |
201
|
|
|
|
|
|
|
options => [ "option_file", "prefix", "app", |
202
|
|
|
|
|
|
|
"perlinc", "debug_options", "import", ], |
203
|
|
|
|
|
|
|
option => { |
204
|
|
|
|
|
|
|
option_file => { default => "~/.app/app.conf" }, # set default |
205
|
|
|
|
|
|
|
app => { default => "app", type => "string" }, # default & type |
206
|
|
|
|
|
|
|
prefix => { type => "string", required => 1; env => "PREFIX" }, |
207
|
|
|
|
|
|
|
perlinc => undef, # no default |
208
|
|
|
|
|
|
|
debug_options => { type => "int" }, |
209
|
|
|
|
|
|
|
import => { type => "string" }, |
210
|
|
|
|
|
|
|
flush_imports => 1, |
211
|
|
|
|
|
|
|
}, |
212
|
|
|
|
|
|
|
no_cmd_args => 1, |
213
|
|
|
|
|
|
|
no_env_vars => 1, |
214
|
|
|
|
|
|
|
no_option_file => 1, |
215
|
|
|
|
|
|
|
print_usage => sub { my ($values, $init_args) = @_; print "Use it right!\n"; }, |
216
|
|
|
|
|
|
|
); |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
The init() method is usually called during the import() operation |
219
|
|
|
|
|
|
|
when the normal usage ("use App::Options;") is invoked. |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
The init() method reads the command line args (@ARGV), |
222
|
|
|
|
|
|
|
then finds an options file, and loads it, all in a way which |
223
|
|
|
|
|
|
|
can be done in a BEGIN block (minimal dependencies). This is |
224
|
|
|
|
|
|
|
important to be able |
225
|
|
|
|
|
|
|
to modify the @INC array so that normal "use" and "require" |
226
|
|
|
|
|
|
|
statements will work with the configured @INC path. |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
The following named arguments are understood by the init() method. |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
values - specify a hash reference other than %App::options to |
231
|
|
|
|
|
|
|
put option values in. |
232
|
|
|
|
|
|
|
options - specify a limited, ordered list of options to be |
233
|
|
|
|
|
|
|
displayed when the "--help" or "-?" options are invoked |
234
|
|
|
|
|
|
|
option - specify optional additional information about any of |
235
|
|
|
|
|
|
|
the various options to the program (see below) |
236
|
|
|
|
|
|
|
no_cmd_args - do not process command line arguments |
237
|
|
|
|
|
|
|
no_env_vars - do not read environment variables |
238
|
|
|
|
|
|
|
no_option_file - do not read in the option file |
239
|
|
|
|
|
|
|
show_all - force showing all options in "--help" even when |
240
|
|
|
|
|
|
|
"options" list specified |
241
|
|
|
|
|
|
|
print_usage - provide an alternate print_usage() function |
242
|
|
|
|
|
|
|
args_description - provide descriptive text for what the args |
243
|
|
|
|
|
|
|
of the program are (command line args after the options). |
244
|
|
|
|
|
|
|
This is printed in the usage page (--help or -?). |
245
|
|
|
|
|
|
|
By default, it is simply "[args]". |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
The additional information that can be specified about any individual |
248
|
|
|
|
|
|
|
option variable using the "option" arg above is as follows. |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
default - the default value if none supplied on the command |
251
|
|
|
|
|
|
|
line, in an environment variable, or in an option file |
252
|
|
|
|
|
|
|
required - the program will not run unless a value is provided |
253
|
|
|
|
|
|
|
for this option |
254
|
|
|
|
|
|
|
type - if a value is provided, the program will not run unless |
255
|
|
|
|
|
|
|
the value matches the type ("string", "integer", "float", |
256
|
|
|
|
|
|
|
"boolean", "date", "time", "datetime", "/regexp/"). |
257
|
|
|
|
|
|
|
env - a list of semicolon-separated environment variable names |
258
|
|
|
|
|
|
|
to be used to find the value instead of "APP_{VARNAME}". |
259
|
|
|
|
|
|
|
description - printed next to the option in the "usage" page |
260
|
|
|
|
|
|
|
secure - identifies an option as being "secure" (i.e. a password) |
261
|
|
|
|
|
|
|
and that it should never be printed in plain text in a help |
262
|
|
|
|
|
|
|
message (-?). All options which end in "pass", "passwd", or |
263
|
|
|
|
|
|
|
"password" are also assumed to be secure unless a secure => 0 |
264
|
|
|
|
|
|
|
setting exists. If the value of the "secure" attribute is greater |
265
|
|
|
|
|
|
|
than 1, a heightened security level is enforced: 2=ensure that |
266
|
|
|
|
|
|
|
the value can never be supplied on a command line or from the |
267
|
|
|
|
|
|
|
environment but only from a file that only the user running the |
268
|
|
|
|
|
|
|
program has read/write access to. This value will also never be |
269
|
|
|
|
|
|
|
read from the environment or the command line because these are |
270
|
|
|
|
|
|
|
visible to other users. If the security_policy_level variable |
271
|
|
|
|
|
|
|
is set, any true value for the "secure" attribute will result in |
272
|
|
|
|
|
|
|
the value being set to the "security_policy_level" value. |
273
|
|
|
|
|
|
|
value_description - printed within angle brackets ("<>") in the |
274
|
|
|
|
|
|
|
"usage" page as the description of the option value |
275
|
|
|
|
|
|
|
(i.e. --option_name=) |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
The init() method stores command line options and option |
278
|
|
|
|
|
|
|
file values all in the global %App::options hash (unless the |
279
|
|
|
|
|
|
|
"values" argument specifies another reference to a hash to use). |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
The special options are as follows. |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
option_file - specifies the exact file name of the option file to be |
284
|
|
|
|
|
|
|
used (i.e. "app --option_file=/path/to/app.conf"). |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
app - specifies the tag that will be used when searching for |
287
|
|
|
|
|
|
|
an option file. (i.e. "app --app=myapp" will search for "myapp.conf" |
288
|
|
|
|
|
|
|
before it searches for "app.conf") |
289
|
|
|
|
|
|
|
"app" is automatically set with the stem of the program file that |
290
|
|
|
|
|
|
|
was run (or the first part of PATH_INFO) if it is not supplied at |
291
|
|
|
|
|
|
|
the outset as an argument. |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
prefix - This represents the base directory of the software |
294
|
|
|
|
|
|
|
installation (i.e. "/usr/myproduct/1.3.12"). If it is not |
295
|
|
|
|
|
|
|
set explicitly, it is detected from the following places: |
296
|
|
|
|
|
|
|
1. PREFIX environment variable |
297
|
|
|
|
|
|
|
2. the real path of the program with /bin or /cgi-bin stripped |
298
|
|
|
|
|
|
|
3. /usr/local (or whatever "prefix" perl was compiled with) |
299
|
|
|
|
|
|
|
If it is autodetected from one of those three places, that is |
300
|
|
|
|
|
|
|
only provisional, in order to find the "option_file". The "prefix" |
301
|
|
|
|
|
|
|
variable should be set authoritatively in the "option_file" if it |
302
|
|
|
|
|
|
|
is desired to be in the $values structure. |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
perlinc - a path of directories to prepend to the @INC search path. |
305
|
|
|
|
|
|
|
This list of directories is separated by any combination of |
306
|
|
|
|
|
|
|
[,; ] characters. |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
debug_options - if this is set, a variety of debug information is |
309
|
|
|
|
|
|
|
printed out during the option processing. This helps in debugging |
310
|
|
|
|
|
|
|
which option files are being used and what the resulting variable |
311
|
|
|
|
|
|
|
values are. The following numeric values are defined. |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
1 = print the basic steps of option processing |
314
|
|
|
|
|
|
|
2 = print each option file searched, final values, and resulting @INC |
315
|
|
|
|
|
|
|
3 = print each value as it is set in the option hash |
316
|
|
|
|
|
|
|
4 = print overrides from ENV and variable substitutions |
317
|
|
|
|
|
|
|
5 = print each line of each file with exclude_section indicator |
318
|
|
|
|
|
|
|
6 = print option file section tags, condition evaluation, and |
319
|
|
|
|
|
|
|
each value found (even if it is not set in the final values) |
320
|
|
|
|
|
|
|
7 = print final values |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
import - a list of additional option files to be processed. |
323
|
|
|
|
|
|
|
An imported file goes on the head of the queue of files to be |
324
|
|
|
|
|
|
|
processed. |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
hostname - the hostname as returned by the hostname() function |
327
|
|
|
|
|
|
|
provided by Sys::Hostname (may or may not include domain |
328
|
|
|
|
|
|
|
qualifiers as a fully qualified domain name). |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
host - same as hostname, but with any trailing domain name removed. |
331
|
|
|
|
|
|
|
(everything after the first ".") |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
flush_imports - flush all pending imported option files. |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
security_policy_level - When set, this enforces that whenever secure |
336
|
|
|
|
|
|
|
attributes are applied, they are set to the same level. When set |
337
|
|
|
|
|
|
|
0, all of the security features are disabled (passwords can be |
338
|
|
|
|
|
|
|
viewed with "--security_policy_level=0 --help"). When set to 2, |
339
|
|
|
|
|
|
|
all secure options can only be read from files which do not have |
340
|
|
|
|
|
|
|
read/write permission by any other user except the one running the |
341
|
|
|
|
|
|
|
program. |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
=cut |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
my ($default_option_processor); # a reference to the singleton App::Options object that parsed the command line |
346
|
|
|
|
|
|
|
my (%path_is_secure); |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
# This translates the procedural App::Options::import() into the class method App::Options->_import() (for subclassing) |
349
|
|
|
|
|
|
|
sub import { |
350
|
2
|
|
|
2
|
|
27
|
my ($package, @args) = @_; |
351
|
2
|
|
|
|
|
9
|
$package->_import(@args); |
352
|
|
|
|
|
|
|
} |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
sub _import_test { |
355
|
7
|
|
|
7
|
|
56063
|
my ($class, @args) = @_; |
356
|
7
|
|
|
|
|
18
|
$default_option_processor = undef; |
357
|
7
|
|
|
|
|
436
|
$class->_import(@args); |
358
|
|
|
|
|
|
|
} |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
sub _import { |
361
|
9
|
|
|
9
|
|
31
|
my ($class, @args) = @_; |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
# We only do this once (the default App::Options option processor is a singleton) |
364
|
9
|
50
|
|
|
|
54
|
if (!$default_option_processor) { |
365
|
|
|
|
|
|
|
# can supply initial hashref to use for option values instead of global %App::options |
366
|
9
|
100
|
100
|
|
|
101
|
my $values = ($#args > -1 && ref($args[0]) eq "HASH") ? shift(@args) : \%App::options; |
367
|
|
|
|
|
|
|
|
368
|
9
|
50
|
|
|
|
50
|
($#args % 2 == 1) || croak "App::Options::import(): must have an even number of vars/values for named args"; |
369
|
9
|
|
|
|
|
29
|
my $init_args = { @args }; |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
# "values" in named arg list overrides the one supplied as an initial hashref |
372
|
9
|
100
|
|
|
|
43
|
if (defined $init_args->{values}) { |
373
|
2
|
50
|
|
|
|
31
|
(ref($init_args->{values}) eq "HASH") || croak "App::Options->new(): 'values' arg must be a hash reference"; |
374
|
2
|
|
|
|
|
17
|
$values = $init_args->{values}; |
375
|
|
|
|
|
|
|
} |
376
|
|
|
|
|
|
|
|
377
|
9
|
|
|
|
|
44
|
my $option_processor = $class->new($init_args); |
378
|
9
|
|
|
|
|
18
|
$default_option_processor = $option_processor; # save it in the singleton location |
379
|
|
|
|
|
|
|
|
380
|
9
|
|
|
|
|
48
|
$option_processor->read_options($values); # read in all the options from various places |
381
|
9
|
|
|
|
|
5405
|
$option_processor->{values} = $values; # store it for future (currently undefined) uses |
382
|
|
|
|
|
|
|
} |
383
|
|
|
|
|
|
|
} |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
sub new { |
386
|
9
|
|
|
9
|
0
|
31
|
my ($this, $init_args) = @_; |
387
|
9
|
|
33
|
|
|
95
|
my $class = ref($this) || $this; |
388
|
9
|
|
|
|
|
23
|
my $self = {}; |
389
|
9
|
|
|
|
|
569
|
$self->{init_args} = $init_args; |
390
|
9
|
|
|
|
|
44
|
$self->{argv} = [ @ARGV ]; |
391
|
9
|
|
|
|
|
61
|
$self->{options} = [ ]; |
392
|
9
|
|
|
|
|
37
|
bless $self, $class; |
393
|
9
|
|
|
|
|
25
|
return($self); |
394
|
|
|
|
|
|
|
} |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
sub read_options { |
397
|
9
|
|
|
9
|
0
|
27
|
my ($self, $values) = @_; |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
####################################################################### |
400
|
|
|
|
|
|
|
# populate "option" (the information about each option!) |
401
|
|
|
|
|
|
|
####################################################################### |
402
|
|
|
|
|
|
|
|
403
|
9
|
|
|
|
|
19
|
my ($var, $value, @vars); |
404
|
9
|
|
|
|
|
296
|
my $init_args = $self->{init_args}; |
405
|
9
|
|
100
|
|
|
78
|
my $option_defs = $init_args->{option} || {}; |
406
|
9
|
|
|
|
|
19
|
my (%secure_options, %option_source); |
407
|
|
|
|
|
|
|
|
408
|
9
|
50
|
|
|
|
39
|
if ($option_defs) { |
409
|
9
|
50
|
|
|
|
51
|
croak "App::Options->read_options(): 'option' arg must be a hash reference" |
410
|
|
|
|
|
|
|
if (ref($option_defs) ne "HASH"); |
411
|
|
|
|
|
|
|
|
412
|
9
|
|
|
|
|
17
|
my (@args, $option_def, $arg); |
413
|
|
|
|
|
|
|
# Convert archaic forms where everything is packed in a scalar, to the newer, |
414
|
|
|
|
|
|
|
# more verbose form where attributes of an option are in a hashref. |
415
|
9
|
|
|
|
|
119
|
foreach $var (keys %$option_defs) { |
416
|
6
|
|
|
|
|
11
|
$value = $option_defs->{$var}; |
417
|
6
|
50
|
|
|
|
16
|
if (ref($value) eq "") { |
418
|
0
|
|
|
|
|
0
|
$option_def = {}; |
419
|
0
|
|
|
|
|
0
|
$option_defs->{$var} = $option_def; |
420
|
0
|
|
|
|
|
0
|
@args = split(/ *; */,$value); |
421
|
0
|
|
|
|
|
0
|
foreach $arg (@args) { |
422
|
0
|
0
|
|
|
|
0
|
if ($arg =~ /^([^=]+)=(.*)$/) { |
|
|
0
|
|
|
|
|
|
423
|
0
|
|
|
|
|
0
|
$option_def->{$1} = $2; |
424
|
|
|
|
|
|
|
} |
425
|
|
|
|
|
|
|
elsif (! defined $option_def->{default}) { |
426
|
0
|
|
|
|
|
0
|
$option_def->{default} = $arg; |
427
|
|
|
|
|
|
|
} |
428
|
|
|
|
|
|
|
else { |
429
|
0
|
|
|
|
|
0
|
$option_def->{$arg} = 1; |
430
|
|
|
|
|
|
|
} |
431
|
|
|
|
|
|
|
} |
432
|
|
|
|
|
|
|
} |
433
|
|
|
|
|
|
|
else { |
434
|
6
|
|
|
|
|
9
|
$option_def = $value; |
435
|
|
|
|
|
|
|
} |
436
|
6
|
50
|
33
|
|
|
57
|
if (! defined $option_def->{secure} && $var =~ /(pass|password|passwd)$/) { |
437
|
0
|
|
|
|
|
0
|
$option_def->{secure} = 1; |
438
|
|
|
|
|
|
|
} |
439
|
|
|
|
|
|
|
} |
440
|
|
|
|
|
|
|
} |
441
|
9
|
50
|
|
|
|
36
|
if ($init_args->{options}) { |
442
|
0
|
|
|
|
|
0
|
foreach $var (@{$init_args->{options}}) { |
|
0
|
|
|
|
|
0
|
|
443
|
0
|
0
|
0
|
|
|
0
|
if (! defined $option_defs->{$var}{secure} && $var =~ /(pass|password|passwd)$/) { |
444
|
0
|
|
|
|
|
0
|
$option_defs->{$var}{secure} = 1; |
445
|
|
|
|
|
|
|
} |
446
|
|
|
|
|
|
|
} |
447
|
|
|
|
|
|
|
} |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
################################################################# |
450
|
|
|
|
|
|
|
# we do all this within a BEGIN block because we want to get an |
451
|
|
|
|
|
|
|
# option file and update @INC so that it will be used by |
452
|
|
|
|
|
|
|
# "require" and "use". |
453
|
|
|
|
|
|
|
# The global option hash (%App::options) is set from 3 sources: |
454
|
|
|
|
|
|
|
# command line options, environment variables, and option files. |
455
|
|
|
|
|
|
|
################################################################# |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
################################################################# |
458
|
|
|
|
|
|
|
# 0. Set system-supplied values (i.e. hostname/host) |
459
|
|
|
|
|
|
|
################################################################# |
460
|
9
|
|
|
|
|
481
|
my $host = hostname; |
461
|
9
|
|
|
|
|
87
|
$values->{hostname} = $host; |
462
|
9
|
|
|
|
|
31
|
$host =~ s/\..*//; # get rid of extra domain name qualifiers |
463
|
9
|
|
|
|
|
33
|
$values->{host} = $host; |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
################################################################# |
466
|
|
|
|
|
|
|
# 1. Read the command-line options |
467
|
|
|
|
|
|
|
# (anything starting with one or two dashes is an option var |
468
|
|
|
|
|
|
|
# i.e. --debugmode=record -debugmode=replay |
469
|
|
|
|
|
|
|
# an option without an "=" (i.e. --help) acts as --help=1 |
470
|
|
|
|
|
|
|
# Put the var/value pairs in %$values |
471
|
|
|
|
|
|
|
################################################################# |
472
|
9
|
|
50
|
|
|
4084
|
my $debug_options = $values->{debug_options} || 0; |
473
|
9
|
|
|
|
|
28
|
my $show_help = 0; |
474
|
9
|
|
|
|
|
16
|
my $show_version = 0; |
475
|
9
|
|
|
|
|
110
|
my $exit_status = -1; |
476
|
|
|
|
|
|
|
|
477
|
9
|
50
|
|
|
|
104
|
if (! $init_args->{no_cmd_args}) { |
478
|
9
|
|
|
|
|
21
|
my $options = $self->{options}; |
479
|
9
|
|
33
|
|
|
58
|
while ($#ARGV >= 0 && $ARGV[0] =~ /^--?([^=-][^=]*)(=?)(.*)/) { |
480
|
0
|
|
|
|
|
0
|
$var = $1; |
481
|
0
|
0
|
|
|
|
0
|
$value = ($2 eq "") ? 1 : $3; |
482
|
0
|
|
|
|
|
0
|
push(@$options, shift @ARGV); |
483
|
0
|
0
|
0
|
|
|
0
|
if ($option_defs->{$var} && $option_defs->{$var}{secure} && defined $values->{security_policy_level} && $values->{security_policy_level} >= 2) { |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
484
|
0
|
|
|
|
|
0
|
$exit_status = 1; |
485
|
0
|
|
|
|
|
0
|
print "Error: \"$var\" may not be supplied on the command line because it is a secure option.\n"; |
486
|
|
|
|
|
|
|
} |
487
|
0
|
|
|
|
|
0
|
$values->{$var} = $value; |
488
|
0
|
|
|
|
|
0
|
$option_source{$var} = "CMDLINE"; |
489
|
|
|
|
|
|
|
} |
490
|
9
|
50
|
33
|
|
|
47
|
if ($#ARGV >= 0 && $ARGV[0] eq "--") { |
491
|
0
|
|
|
|
|
0
|
shift @ARGV; |
492
|
|
|
|
|
|
|
} |
493
|
9
|
50
|
|
|
|
565
|
if ($values->{help}) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
494
|
0
|
|
|
|
|
0
|
$show_help = 1; |
495
|
0
|
|
|
|
|
0
|
delete $values->{help}; |
496
|
|
|
|
|
|
|
} |
497
|
|
|
|
|
|
|
elsif ($values->{"?"}) { |
498
|
0
|
|
|
|
|
0
|
$show_help = 1; |
499
|
0
|
|
|
|
|
0
|
delete $values->{"?"}; |
500
|
|
|
|
|
|
|
} |
501
|
|
|
|
|
|
|
elsif ($values->{version}) { |
502
|
0
|
|
|
|
|
0
|
$show_version = $values->{version}; |
503
|
0
|
|
|
|
|
0
|
delete $values->{version}; |
504
|
|
|
|
|
|
|
} |
505
|
9
|
|
50
|
|
|
230
|
$debug_options = $values->{debug_options} || 0; |
506
|
9
|
50
|
|
|
|
31
|
print STDERR "1. Parsed Command Line Options. [@$options]\n" if ($debug_options); |
507
|
|
|
|
|
|
|
} |
508
|
|
|
|
|
|
|
else { |
509
|
0
|
0
|
|
|
|
0
|
print STDERR "1. Skipped Command Line Option Parsing.\n" if ($debug_options); |
510
|
|
|
|
|
|
|
} |
511
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
################################################################# |
513
|
|
|
|
|
|
|
# 2. find the directory the program was run from. |
514
|
|
|
|
|
|
|
# we will use this directory to search for the |
515
|
|
|
|
|
|
|
# option file. |
516
|
|
|
|
|
|
|
################################################################# |
517
|
|
|
|
|
|
|
|
518
|
9
|
|
|
|
|
14
|
my ($prog_cat, $prog_dir, $prog_file); |
519
|
|
|
|
|
|
|
# i.e. C:\perl\bin\app, \app |
520
|
9
|
|
|
|
|
661
|
($prog_cat, $prog_dir, $prog_file) = File::Spec->splitpath($0); |
521
|
9
|
|
|
|
|
31
|
$prog_dir =~ s!\\!/!g; # transform to POSIX-compliant (forward slashes) |
522
|
9
|
50
|
|
|
|
82
|
$prog_dir =~ s!/$!! if ($prog_dir ne "/"); # remove trailing slash |
523
|
9
|
50
|
|
|
|
32
|
$prog_dir = "." if ($prog_dir eq ""); |
524
|
9
|
50
|
33
|
|
|
79
|
$prog_dir = $prog_cat . $prog_dir if ($^O =~ /MSWin32/ and $prog_dir =~ m!^/!); |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
################################################################# |
527
|
|
|
|
|
|
|
# 3. guess the "prefix" directory for the entire |
528
|
|
|
|
|
|
|
# software installation. The program is usually in |
529
|
|
|
|
|
|
|
# $prefix/bin or $prefix/cgi-bin. |
530
|
|
|
|
|
|
|
################################################################# |
531
|
9
|
|
|
|
|
21
|
my $prefix = $values->{prefix}; # possibly set on command line |
532
|
9
|
|
|
|
|
20
|
my $prefix_origin = "command line"; |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
# it can be set in environment. |
535
|
9
|
50
|
66
|
|
|
82
|
if (!$prefix && $ENV{PREFIX}) { |
536
|
0
|
|
|
|
|
0
|
$prefix = $ENV{PREFIX}; |
537
|
0
|
|
|
|
|
0
|
$prefix_origin = "environment"; |
538
|
|
|
|
|
|
|
} |
539
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
# Using "abs_path" gets rid of all symbolic links and gives the real path |
541
|
|
|
|
|
|
|
# to the directory in which the script runs. |
542
|
9
|
100
|
|
|
|
31
|
if (!$prefix) { |
543
|
6
|
|
|
|
|
347
|
my $abs_prog_dir = abs_path($prog_dir); |
544
|
6
|
|
|
|
|
16
|
$abs_prog_dir =~ s!\\!/!g; # transform to POSIX-compliant (forward slashes) |
545
|
6
|
50
|
|
|
|
23
|
$abs_prog_dir =~ s!/$!! if ($abs_prog_dir ne "/"); # remove trailing slash |
546
|
6
|
50
|
|
|
|
38
|
if ($abs_prog_dir =~ s!/bin$!!) { |
|
|
50
|
|
|
|
|
|
547
|
0
|
|
|
|
|
0
|
$prefix = $abs_prog_dir; |
548
|
0
|
|
|
|
|
0
|
$prefix_origin = "parent of bin dir"; |
549
|
|
|
|
|
|
|
} |
550
|
|
|
|
|
|
|
elsif ($abs_prog_dir =~ s!/cgi-bin.*$!!) { |
551
|
0
|
|
|
|
|
0
|
$prefix = $abs_prog_dir; |
552
|
0
|
|
|
|
|
0
|
$prefix_origin = "parent of cgi-bin dir"; |
553
|
|
|
|
|
|
|
} |
554
|
|
|
|
|
|
|
} |
555
|
|
|
|
|
|
|
|
556
|
9
|
100
|
|
|
|
28
|
if (!$prefix) { # last resort: perl's prefix |
557
|
6
|
|
|
|
|
2273
|
$prefix = $Config{prefix}; |
558
|
6
|
|
|
|
|
12588
|
$prefix =~ s!\\!/!g; # transform to POSIX-compliant |
559
|
6
|
50
|
|
|
|
29
|
$prefix =~ s!/$!! if ($prefix ne "/"); # remove trailing slash |
560
|
6
|
|
|
|
|
21
|
$prefix_origin = "perl prefix"; |
561
|
|
|
|
|
|
|
} |
562
|
9
|
50
|
|
|
|
45
|
print STDERR "3. Provisional prefix Set. prefix=[$prefix] origin=[$prefix_origin]\n" |
563
|
|
|
|
|
|
|
if ($debug_options); |
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
################################################################# |
566
|
|
|
|
|
|
|
# 4. find the app. |
567
|
|
|
|
|
|
|
# by default this is the basename of the program |
568
|
|
|
|
|
|
|
# in a web application, this is overridden by any existing |
569
|
|
|
|
|
|
|
# first part of the PATH_INFO |
570
|
|
|
|
|
|
|
################################################################# |
571
|
9
|
|
|
|
|
33
|
my $app = $values->{app}; |
572
|
9
|
|
|
|
|
17
|
my $app_origin = "command line"; |
573
|
9
|
100
|
|
|
|
137
|
if (!$app) { |
574
|
8
|
|
|
|
|
64
|
($app, $app_origin) = App::Options->determine_app($prefix, $prog_dir, $prog_file, $ENV{PATH_INFO}, $ENV{HOME}); |
575
|
8
|
|
|
|
|
33
|
$values->{app} = $app; |
576
|
|
|
|
|
|
|
} |
577
|
9
|
50
|
|
|
|
28
|
print STDERR "4. Set app variable. app=[$app] origin=[$app_origin]\n" if ($debug_options); |
578
|
|
|
|
|
|
|
#print STDERR "04 option_defs [", join("|", sort keys %$option_defs), "]\n"; |
579
|
|
|
|
|
|
|
|
580
|
9
|
|
|
|
|
16
|
my ($env_var, @env_vars, $regexp); |
581
|
9
|
50
|
|
|
|
31
|
if (! $init_args->{no_option_file}) { |
582
|
|
|
|
|
|
|
################################################################# |
583
|
|
|
|
|
|
|
# 5. Define the standard places to look for an option file |
584
|
|
|
|
|
|
|
################################################################# |
585
|
9
|
|
|
|
|
17
|
my @option_files = (); |
586
|
9
|
|
|
|
|
28
|
push(@option_files, "/etc/app/policy.conf"); |
587
|
9
|
50
|
|
|
|
27
|
push(@option_files, $values->{option_file}) if ($values->{option_file}); |
588
|
9
|
50
|
33
|
|
|
119
|
push(@option_files, "$ENV{HOME}/.app/$app.conf") if ($ENV{HOME} && $app ne "app"); |
589
|
9
|
50
|
|
|
|
40
|
push(@option_files, "$ENV{HOME}/.app/app.conf") if ($ENV{HOME}); |
590
|
9
|
50
|
|
|
|
42
|
push(@option_files, "$prog_dir/$app.conf") if ($app ne "app"); |
591
|
9
|
|
|
|
|
21
|
push(@option_files, "$prog_dir/app.conf"); |
592
|
9
|
50
|
|
|
|
34
|
push(@option_files, "\${prefix}/etc/app/$app.conf") if ($app ne "app"); |
593
|
9
|
|
|
|
|
17
|
push(@option_files, "\${prefix}/etc/app/app.conf"); |
594
|
9
|
|
|
|
|
17
|
push(@option_files, "/etc/app/app.conf"); |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
################################################################# |
597
|
|
|
|
|
|
|
# 5. now actually read in the file(s) |
598
|
|
|
|
|
|
|
# we read a set of standard files, and |
599
|
|
|
|
|
|
|
# we may continue to read in additional files if they |
600
|
|
|
|
|
|
|
# are indicated by an "import" line |
601
|
|
|
|
|
|
|
################################################################# |
602
|
9
|
50
|
|
|
|
20
|
print STDERR "5. Scanning Option Files\n" if ($debug_options); |
603
|
|
|
|
|
|
|
|
604
|
9
|
|
|
|
|
49
|
$self->read_option_files($values, \@option_files, $prefix, $option_defs); |
605
|
|
|
|
|
|
|
|
606
|
9
|
|
50
|
|
|
139
|
$debug_options = $values->{debug_options} || 0; |
607
|
|
|
|
|
|
|
} |
608
|
|
|
|
|
|
|
else { |
609
|
0
|
0
|
|
|
|
0
|
print STDERR "5. Skip Option File Processing\n" if ($debug_options); |
610
|
|
|
|
|
|
|
} |
611
|
|
|
|
|
|
|
#print STDERR "05 option_defs [", join("|", sort keys %$option_defs), "]\n" if ($prefix eq "/usr"); |
612
|
9
|
0
|
33
|
|
|
56
|
if ($values->{perl_restart} && !$ENV{MOD_PERL} && !$ENV{PERL_RESTART}) { |
|
|
|
33
|
|
|
|
|
613
|
0
|
|
|
|
|
0
|
$ENV{PERL_RESTART} = 1; |
614
|
0
|
|
|
|
|
0
|
exec($^X, $0, @{$self->{argv}}); |
|
0
|
|
|
|
|
0
|
|
615
|
|
|
|
|
|
|
} |
616
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
################################################################# |
618
|
|
|
|
|
|
|
# 6. fill in ENV vars |
619
|
|
|
|
|
|
|
################################################################# |
620
|
|
|
|
|
|
|
|
621
|
9
|
50
|
|
|
|
46
|
if (!$init_args->{no_env_vars}) { |
622
|
9
|
|
|
|
|
33
|
@vars = (); |
623
|
9
|
50
|
|
|
|
55
|
if ($init_args->{options}) { |
624
|
0
|
0
|
|
|
|
0
|
croak "App::Options->read_options(): 'options' arg must be an array reference" |
625
|
|
|
|
|
|
|
if (ref($init_args->{options}) ne "ARRAY"); |
626
|
0
|
|
|
|
|
0
|
push(@vars, @{$init_args->{options}}); |
|
0
|
|
|
|
|
0
|
|
627
|
|
|
|
|
|
|
} |
628
|
|
|
|
|
|
|
|
629
|
9
|
50
|
|
|
|
29
|
if ($option_defs) { |
630
|
9
|
|
|
|
|
67
|
push(@vars, (sort keys %$option_defs)); |
631
|
|
|
|
|
|
|
} |
632
|
|
|
|
|
|
|
|
633
|
9
|
50
|
|
|
|
25
|
print STDERR "6. Scanning for Environment Variables.\n" if ($debug_options); |
634
|
|
|
|
|
|
|
|
635
|
9
|
|
|
|
|
276
|
foreach $var (@vars) { |
636
|
6
|
50
|
|
|
|
30
|
if (!defined $values->{$var}) { |
637
|
6
|
|
|
|
|
13
|
$value = undef; |
638
|
6
|
50
|
|
|
|
23
|
if (!$init_args->{no_env_vars}) { |
639
|
6
|
100
|
66
|
|
|
153
|
if ($option_defs && defined $option_defs->{$var}{env}) { |
640
|
4
|
50
|
|
|
|
17
|
if ($option_defs->{$var}{env} eq "") { |
641
|
0
|
|
|
|
|
0
|
@env_vars = (); |
642
|
|
|
|
|
|
|
} |
643
|
|
|
|
|
|
|
else { |
644
|
4
|
|
|
|
|
41
|
@env_vars = split(/[,;]/, $option_defs->{$var}{env}); |
645
|
|
|
|
|
|
|
} |
646
|
|
|
|
|
|
|
} |
647
|
|
|
|
|
|
|
else { |
648
|
2
|
|
|
|
|
16
|
@env_vars = ( "APP_" . uc($var) ); |
649
|
|
|
|
|
|
|
} |
650
|
6
|
|
|
|
|
13
|
foreach $env_var (@env_vars) { |
651
|
8
|
100
|
66
|
|
|
59
|
if ($env_var && defined $ENV{$env_var}) { |
652
|
6
|
|
|
|
|
18
|
$value = $ENV{$env_var}; |
653
|
6
|
50
|
|
|
|
21
|
print STDERR " Env Var Found : [$var] = [$value] from [$env_var] of [@env_vars].\n" |
654
|
|
|
|
|
|
|
if ($debug_options >= 4); |
655
|
6
|
|
|
|
|
16
|
last; |
656
|
|
|
|
|
|
|
} |
657
|
|
|
|
|
|
|
} |
658
|
|
|
|
|
|
|
} |
659
|
|
|
|
|
|
|
# do variable substitutions, var = ${prefix}/bin, var = $ENV{PATH} |
660
|
6
|
50
|
|
|
|
19
|
if (defined $value) { |
661
|
6
|
50
|
|
|
|
27
|
if ($value =~ /\{.*\}/) { |
662
|
0
|
0
|
|
|
|
0
|
$value =~ s/\$\{([a-zA-Z0-9_\.-]+)\}/(defined $values->{$1} ? $values->{$1} : "")/eg; |
|
0
|
|
|
|
|
0
|
|
663
|
0
|
0
|
|
|
|
0
|
$value =~ s/\$ENV\{([a-zA-Z0-9_\.-]+)\}/(defined $ENV{$1} ? $ENV{$1} : "")/eg; |
|
0
|
|
|
|
|
0
|
|
664
|
0
|
0
|
|
|
|
0
|
print STDERR " Env Var Underwent Substitutions : [$var] = [$value]\n" |
665
|
|
|
|
|
|
|
if ($debug_options >= 4); |
666
|
|
|
|
|
|
|
} |
667
|
|
|
|
|
|
|
else { |
668
|
6
|
50
|
|
|
|
28
|
print STDERR " Env Var : [$var] = [$value]\n" |
669
|
|
|
|
|
|
|
if ($debug_options >= 3); |
670
|
|
|
|
|
|
|
} |
671
|
6
|
|
|
|
|
15
|
$values->{$var} = $value; # save all in %App::options |
672
|
6
|
|
|
|
|
24
|
$option_source{$var} = "ENV"; |
673
|
|
|
|
|
|
|
} |
674
|
|
|
|
|
|
|
} |
675
|
|
|
|
|
|
|
} |
676
|
|
|
|
|
|
|
|
677
|
9
|
|
|
|
|
349
|
foreach $env_var (keys %ENV) { |
678
|
239
|
100
|
|
|
|
696
|
next if ($env_var !~ /^APP_/); |
679
|
12
|
|
|
|
|
48
|
$var = lc($env_var); |
680
|
12
|
|
|
|
|
63
|
$var =~ s/^app_//; |
681
|
12
|
100
|
|
|
|
60
|
if (! defined $values->{$var}) { |
682
|
10
|
0
|
33
|
|
|
47
|
if ($option_defs->{$var} && $option_defs->{$var}{secure} && defined $values->{security_policy_level} && $values->{security_policy_level} >= 2) { |
|
|
|
33
|
|
|
|
|
|
|
|
0
|
|
|
|
|
683
|
0
|
|
|
|
|
0
|
$exit_status = 1; |
684
|
0
|
|
|
|
|
0
|
print "Error: \"$var\" may not be supplied from the environment ($env_var) because it is a secure option.\n"; |
685
|
|
|
|
|
|
|
} |
686
|
10
|
|
|
|
|
79
|
$values->{$var} = $ENV{$env_var}; |
687
|
10
|
|
|
|
|
49
|
$option_source{$var} = "ENV"; |
688
|
10
|
50
|
|
|
|
35
|
print STDERR " Env Var [$var] = [$value] from [$env_var] (assumed).\n" |
689
|
|
|
|
|
|
|
if ($debug_options >= 3); |
690
|
|
|
|
|
|
|
} |
691
|
|
|
|
|
|
|
} |
692
|
9
|
|
50
|
|
|
203
|
$debug_options = $values->{debug_options} || 0; |
693
|
|
|
|
|
|
|
} |
694
|
|
|
|
|
|
|
else { |
695
|
0
|
0
|
|
|
|
0
|
print STDERR "6. Skipped Environment Variable Processing\n" if ($debug_options); |
696
|
|
|
|
|
|
|
} |
697
|
|
|
|
|
|
|
#print STDERR "06 option_defs [", join("|", sort keys %$option_defs), "]\n" if ($prefix eq "/usr"); |
698
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
################################################################# |
700
|
|
|
|
|
|
|
# 7. establish the definitive (not inferred) $prefix |
701
|
|
|
|
|
|
|
################################################################# |
702
|
9
|
100
|
|
|
|
35
|
if ($values->{prefix}) { |
703
|
3
|
50
|
|
|
|
20
|
if ($prefix eq $values->{prefix}) { |
704
|
3
|
50
|
|
|
|
19
|
print STDERR "7. Definitive prefix found [$prefix] (no change)\n" if ($debug_options); |
705
|
|
|
|
|
|
|
} |
706
|
|
|
|
|
|
|
else { |
707
|
0
|
0
|
|
|
|
0
|
print STDERR "7. Definitive prefix found [$prefix] => [$values->{prefix}]\n" if ($debug_options); |
708
|
0
|
|
|
|
|
0
|
$prefix = $values->{prefix}; |
709
|
|
|
|
|
|
|
} |
710
|
|
|
|
|
|
|
} |
711
|
|
|
|
|
|
|
else { |
712
|
6
|
|
|
|
|
43
|
$values->{prefix} = $prefix; |
713
|
6
|
50
|
|
|
|
22
|
print STDERR "7. prefix Made Definitive [$prefix]\n" if ($debug_options); |
714
|
|
|
|
|
|
|
} |
715
|
|
|
|
|
|
|
#print STDERR "07 option_defs [", join("|", sort keys %$option_defs), "]\n" if ($prefix eq "/usr"); |
716
|
|
|
|
|
|
|
|
717
|
|
|
|
|
|
|
################################################################# |
718
|
|
|
|
|
|
|
# 8. set defaults |
719
|
|
|
|
|
|
|
################################################################# |
720
|
9
|
50
|
|
|
|
25
|
if ($option_defs) { |
721
|
9
|
50
|
|
|
|
39
|
@vars = (defined $init_args->{options}) ? @{$init_args->{options}} : (); |
|
0
|
|
|
|
|
0
|
|
722
|
9
|
|
|
|
|
24
|
push(@vars, (sort keys %$option_defs)); |
723
|
|
|
|
|
|
|
|
724
|
9
|
50
|
|
|
|
30
|
print STDERR "8. Set Defaults.\n" if ($debug_options); |
725
|
|
|
|
|
|
|
|
726
|
9
|
|
|
|
|
22
|
foreach $var (@vars) { |
727
|
6
|
50
|
|
|
|
47
|
if (!defined $values->{$var}) { |
728
|
0
|
0
|
0
|
|
|
0
|
if (defined $option_defs->{$var} && defined $option_defs->{$var}{default} && $option_defs->{$var}{secure} && |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
729
|
|
|
|
|
|
|
defined $values->{security_policy_level} && $values->{security_policy_level} >= 2) { |
730
|
0
|
|
|
|
|
0
|
$exit_status = 1; |
731
|
0
|
|
|
|
|
0
|
print "Error: \"$var\" may not be supplied as a program default because it is a secure option.\n"; |
732
|
|
|
|
|
|
|
} |
733
|
0
|
|
|
|
|
0
|
$value = $option_defs->{$var}{default}; |
734
|
|
|
|
|
|
|
# do variable substitutions, var = ${prefix}/bin, var = $ENV{PATH} |
735
|
0
|
0
|
|
|
|
0
|
if (defined $value) { |
736
|
0
|
0
|
|
|
|
0
|
if ($value =~ /\{.*\}/) { |
737
|
0
|
0
|
|
|
|
0
|
$value =~ s/\$\{([a-zA-Z0-9_\.-]+)\}/(defined $values->{$1} ? $values->{$1} : "")/eg; |
|
0
|
|
|
|
|
0
|
|
738
|
0
|
0
|
|
|
|
0
|
$value =~ s/\$ENV\{([a-zA-Z0-9_\.-]+)\}/(defined $ENV{$1} ? $ENV{$1} : "")/eg; |
|
0
|
|
|
|
|
0
|
|
739
|
0
|
0
|
|
|
|
0
|
print STDERR " Default Underwent Substitutions : [$var] = [$value]\n" |
740
|
|
|
|
|
|
|
if ($debug_options >= 4); |
741
|
|
|
|
|
|
|
} |
742
|
0
|
|
|
|
|
0
|
$values->{$var} = $value; # save all in %App::options |
743
|
0
|
|
|
|
|
0
|
$option_source{$var} = "DEFAULT"; |
744
|
0
|
0
|
|
|
|
0
|
print STDERR " Default Var [$var] = [$value]\n" if ($debug_options >= 3); |
745
|
|
|
|
|
|
|
} |
746
|
|
|
|
|
|
|
} |
747
|
|
|
|
|
|
|
} |
748
|
|
|
|
|
|
|
} |
749
|
|
|
|
|
|
|
else { |
750
|
0
|
0
|
|
|
|
0
|
print STDERR "8. Skipped Defaults (no option defaults defined)\n" if ($debug_options); |
751
|
|
|
|
|
|
|
} |
752
|
|
|
|
|
|
|
#print STDERR "08 option_defs [", join("|", sort keys %$option_defs), "]\n" if ($prefix eq "/usr"); |
753
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
################################################################# |
755
|
|
|
|
|
|
|
# 9. add "perlinc" directories to @INC, OR |
756
|
|
|
|
|
|
|
# automatically include (if not already) the directories |
757
|
|
|
|
|
|
|
# $PREFIX/lib/$^V and $PREFIX/lib/site_perl/$^V |
758
|
|
|
|
|
|
|
# i.e. /usr/mycompany/lib/5.6.1 and /usr/mycompany/lib/site_perl/5.6.1 |
759
|
|
|
|
|
|
|
################################################################# |
760
|
|
|
|
|
|
|
|
761
|
9
|
100
|
|
|
|
33
|
if (defined $values->{perlinc}) { # add perlinc entries |
762
|
2
|
50
|
|
|
|
19
|
if ($values->{perlinc}) { |
763
|
2
|
|
|
|
|
31
|
unshift(@INC, split(/[,; ]+/,$values->{perlinc})); |
764
|
2
|
50
|
|
|
|
17
|
if ($debug_options >= 2) { |
765
|
0
|
|
|
|
|
0
|
print STDERR "9. perlinc Directories Added to \@INC\n ", |
766
|
|
|
|
|
|
|
join("\n ", @INC), "\n"; |
767
|
|
|
|
|
|
|
} |
768
|
|
|
|
|
|
|
} |
769
|
|
|
|
|
|
|
else { |
770
|
0
|
0
|
|
|
|
0
|
print STDERR "9. No Directories Added to \@INC\n" if ($debug_options >= 2); |
771
|
|
|
|
|
|
|
} |
772
|
|
|
|
|
|
|
} |
773
|
|
|
|
|
|
|
else { |
774
|
7
|
|
|
|
|
39
|
my $libdir = "$prefix/lib"; |
775
|
7
|
|
|
|
|
11
|
my $libdir_found = 0; |
776
|
|
|
|
|
|
|
# Look to see whether this PREFIX has been included already in @INC. |
777
|
|
|
|
|
|
|
# If it has, we do *not* want to automagically guess which directories |
778
|
|
|
|
|
|
|
# should be searched and in which order. |
779
|
7
|
|
|
|
|
27
|
foreach my $incdir (@INC) { |
780
|
53
|
100
|
|
|
|
362
|
if ($incdir =~ m!^$libdir!) { |
781
|
7
|
|
|
|
|
11
|
$libdir_found = 1; |
782
|
7
|
|
|
|
|
14
|
last; |
783
|
|
|
|
|
|
|
} |
784
|
|
|
|
|
|
|
} |
785
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
# The traditional way to install software from CPAN uses |
787
|
|
|
|
|
|
|
# ExtUtils::MakeMaker via Makefile.PL with the "make install" |
788
|
|
|
|
|
|
|
# command. If you are installing this software to non-standard |
789
|
|
|
|
|
|
|
# places, you would use the "perl Makefile.PL PREFIX=$PREFIX" |
790
|
|
|
|
|
|
|
# command. This would typically put modules into the |
791
|
|
|
|
|
|
|
# $PREFIX/lib/perl5/site_perl/$perlversion directory. |
792
|
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
# However, a newer way to install software (and recent versions |
794
|
|
|
|
|
|
|
# of CPAN.pm understand this) uses Module::Build via Build.PL |
795
|
|
|
|
|
|
|
# with the "Build install" command. If you are installing this |
796
|
|
|
|
|
|
|
# software to non-standard places, you would use the |
797
|
|
|
|
|
|
|
# "perl Build.PL install_base=$PREFIX" command. This would |
798
|
|
|
|
|
|
|
# typically put modules into the $PREFIX/lib directory. |
799
|
|
|
|
|
|
|
|
800
|
|
|
|
|
|
|
# So if we need to guess about extra directories to add to the |
801
|
|
|
|
|
|
|
# @INC variable ($PREFIX/lib is nowhere currently represented |
802
|
|
|
|
|
|
|
# in @INC), we should add directories which work for software |
803
|
|
|
|
|
|
|
# installed with either Module::Build or ExtUtils::MakeMaker. |
804
|
|
|
|
|
|
|
|
805
|
7
|
50
|
|
|
|
26
|
if (!$libdir_found) { |
806
|
0
|
|
|
|
|
0
|
unshift(@INC, "$libdir"); |
807
|
0
|
0
|
|
|
|
0
|
if ($^V) { |
808
|
0
|
|
|
|
|
0
|
my $perlversion = sprintf("%vd", $^V); |
809
|
0
|
|
|
|
|
0
|
unshift(@INC, $libdir); |
810
|
0
|
0
|
|
|
|
0
|
if (-d "$libdir/perl5") { |
|
|
0
|
|
|
|
|
|
811
|
0
|
|
|
|
|
0
|
unshift(@INC, "$libdir/perl5/site_perl/$perlversion"); # site_perl goes first! |
812
|
0
|
|
|
|
|
0
|
unshift(@INC, "$libdir/perl5/$perlversion"); |
813
|
|
|
|
|
|
|
} |
814
|
|
|
|
|
|
|
elsif (-d "$libdir/perl") { |
815
|
0
|
|
|
|
|
0
|
unshift(@INC, "$libdir/perl/site_perl/$perlversion"); # site_perl goes first! |
816
|
0
|
|
|
|
|
0
|
unshift(@INC, "$libdir/perl/$perlversion"); |
817
|
|
|
|
|
|
|
} |
818
|
0
|
0
|
|
|
|
0
|
if (-d "$prefix/share/perl") { |
819
|
0
|
|
|
|
|
0
|
unshift(@INC, "$prefix/share/perl/site_perl/$perlversion"); # site_perl goes first! |
820
|
0
|
|
|
|
|
0
|
unshift(@INC, "$prefix/share/perl/$perlversion"); |
821
|
|
|
|
|
|
|
} |
822
|
|
|
|
|
|
|
} |
823
|
|
|
|
|
|
|
} |
824
|
7
|
50
|
|
|
|
24
|
if ($debug_options >= 2) { |
825
|
0
|
|
|
|
|
0
|
print STDERR "9. Standard Directories Added to \@INC (libdir_found=$libdir_found)\n ", |
826
|
|
|
|
|
|
|
join("\n ", @INC), "\n"; |
827
|
|
|
|
|
|
|
} |
828
|
|
|
|
|
|
|
} |
829
|
|
|
|
|
|
|
#print STDERR "09 option_defs [", join("|", sort keys %$option_defs), "]\n" if ($prefix eq "/usr"); |
830
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
################################################################# |
832
|
|
|
|
|
|
|
# 10. print stuff out for options debugging |
833
|
|
|
|
|
|
|
################################################################# |
834
|
|
|
|
|
|
|
|
835
|
9
|
50
|
|
|
|
26
|
if ($debug_options >= 7) { |
836
|
0
|
|
|
|
|
0
|
print STDERR "FINAL VALUES: \%App::options (or other) =\n"; |
837
|
0
|
|
|
|
|
0
|
foreach $var (sort keys %$values) { |
838
|
0
|
0
|
|
|
|
0
|
if (defined $values->{$var}) { |
839
|
0
|
|
|
|
|
0
|
print STDERR " $var = [$values->{$var}]\n"; |
840
|
|
|
|
|
|
|
} |
841
|
|
|
|
|
|
|
else { |
842
|
0
|
|
|
|
|
0
|
print STDERR " $var = [undef]\n"; |
843
|
|
|
|
|
|
|
} |
844
|
|
|
|
|
|
|
} |
845
|
|
|
|
|
|
|
} |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
################################################################# |
848
|
|
|
|
|
|
|
# 11. print version information (--version) |
849
|
|
|
|
|
|
|
################################################################# |
850
|
|
|
|
|
|
|
|
851
|
9
|
50
|
|
|
|
31
|
if ($show_version) { |
852
|
0
|
|
|
|
|
0
|
&print_version($prog_file, $show_version, $values); |
853
|
0
|
|
|
|
|
0
|
exit(0); |
854
|
|
|
|
|
|
|
} |
855
|
|
|
|
|
|
|
|
856
|
|
|
|
|
|
|
################################################################# |
857
|
|
|
|
|
|
|
# 12. perform validations, print help, and exit |
858
|
|
|
|
|
|
|
################################################################# |
859
|
|
|
|
|
|
|
|
860
|
9
|
50
|
|
|
|
24
|
if ($show_help) { |
861
|
0
|
|
|
|
|
0
|
$exit_status = 0; |
862
|
|
|
|
|
|
|
} |
863
|
|
|
|
|
|
|
#print STDERR "12 option_defs [", join("|", sort keys %$option_defs), "]\n" if ($prefix eq "/usr"); |
864
|
|
|
|
|
|
|
|
865
|
|
|
|
|
|
|
################################################################# |
866
|
|
|
|
|
|
|
# These are the actual Perl regular expressions which match |
867
|
|
|
|
|
|
|
# numbers. The regexes we use are approximately correct. |
868
|
|
|
|
|
|
|
################################################################# |
869
|
|
|
|
|
|
|
# \d(_?\d)*(\.(\d(_?\d)*)?)?[Ee][\+\-]?(\d(_?\d)*) 12 12.34 12. |
870
|
|
|
|
|
|
|
# \.\d(_?\d)*[Ee][\+\-]?(\d(_?\d)*) .34 |
871
|
|
|
|
|
|
|
# 0b[01](_?[01])* |
872
|
|
|
|
|
|
|
# 0[0-7](_?[0-7])* |
873
|
|
|
|
|
|
|
# 0x[0-9A-Fa-f](_?[0-9A-Fa-f])* |
874
|
|
|
|
|
|
|
|
875
|
9
|
|
|
|
|
34
|
my ($type); |
876
|
9
|
50
|
|
|
|
40
|
if ($option_defs) { |
877
|
9
|
|
|
|
|
30
|
@vars = (sort keys %$option_defs); |
878
|
9
|
|
|
|
|
31
|
foreach $var (@vars) { |
879
|
6
|
|
|
|
|
11
|
$type = $option_defs->{$var}{type}; |
880
|
6
|
50
|
|
|
|
17
|
next if (!$type); # nothing to validate against |
881
|
0
|
|
|
|
|
0
|
$value = $values->{$var}; |
882
|
0
|
0
|
|
|
|
0
|
next if (! defined $value); |
883
|
0
|
0
|
|
|
|
0
|
if ($type eq "integer") { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
884
|
0
|
0
|
|
|
|
0
|
if ($value !~ /^-?[0-9_]+$/) { |
885
|
0
|
|
|
|
|
0
|
$exit_status = 1; |
886
|
0
|
|
|
|
|
0
|
print "Error: \"$var\" must be of type \"$type\" (not \"$value\")\n"; |
887
|
|
|
|
|
|
|
} |
888
|
|
|
|
|
|
|
} |
889
|
|
|
|
|
|
|
elsif ($type eq "float") { |
890
|
0
|
0
|
0
|
|
|
0
|
if ($value !~ /^-?[0-9_]+\.?[0-9_]*([eE][+-]?[0-9_]+)?$/ && |
891
|
|
|
|
|
|
|
$value !~ /^-?\.[0-9_]+([eE][+-]?[0-9_]+)?$/) { |
892
|
0
|
|
|
|
|
0
|
$exit_status = 1; |
893
|
0
|
|
|
|
|
0
|
print "Error: \"$var\" must be of type \"$type\" (not \"$value\")\n"; |
894
|
|
|
|
|
|
|
} |
895
|
|
|
|
|
|
|
} |
896
|
|
|
|
|
|
|
elsif ($type eq "string") { |
897
|
|
|
|
|
|
|
# anything is OK |
898
|
|
|
|
|
|
|
} |
899
|
|
|
|
|
|
|
elsif ($type eq "boolean") { |
900
|
0
|
0
|
|
|
|
0
|
if ($value !~ /^[01]$/) { |
901
|
0
|
|
|
|
|
0
|
$exit_status = 1; |
902
|
0
|
|
|
|
|
0
|
print "Error: \"$var\" must be of type \"$type\" (\"0\" or \"1\") (not \"$value\")\n"; |
903
|
|
|
|
|
|
|
} |
904
|
|
|
|
|
|
|
} |
905
|
|
|
|
|
|
|
elsif ($type eq "date") { |
906
|
0
|
0
|
|
|
|
0
|
if ($value !~ /^[0-9]{4}-[01][0-9]-[0-3][0-9]$/) { |
907
|
0
|
|
|
|
|
0
|
$exit_status = 1; |
908
|
0
|
|
|
|
|
0
|
print "Error: \"$var\" must be of type \"$type\" (format \"YYYY-MM-DD\") (not \"$value\")\n"; |
909
|
|
|
|
|
|
|
} |
910
|
|
|
|
|
|
|
} |
911
|
|
|
|
|
|
|
elsif ($type eq "datetime") { |
912
|
0
|
0
|
|
|
|
0
|
if ($value !~ /^[0-9]{4}-[01][0-9]-[0-3][0-9] [0-2][0-9]:[0-5][0-9]:[0-5][0-9]$/) { |
913
|
0
|
|
|
|
|
0
|
$exit_status = 1; |
914
|
0
|
|
|
|
|
0
|
print "Error: \"$var\" must be of type \"$type\" (format \"YYYY-MM-DD HH:MM:SS\") (not \"$value\")\n"; |
915
|
|
|
|
|
|
|
} |
916
|
|
|
|
|
|
|
} |
917
|
|
|
|
|
|
|
elsif ($type eq "time") { |
918
|
0
|
0
|
|
|
|
0
|
if ($value !~ /^[0-2][0-9]:[0-5][0-9]:[0-5][0-9]$/) { |
919
|
0
|
|
|
|
|
0
|
$exit_status = 1; |
920
|
0
|
|
|
|
|
0
|
print "Error: \"$var\" must be of type \"$type\" (format \"HH:MM:SS\") (not \"$value\")\n"; |
921
|
|
|
|
|
|
|
} |
922
|
|
|
|
|
|
|
} |
923
|
|
|
|
|
|
|
elsif ($type =~ m!^/(.*)/$!) { |
924
|
0
|
|
|
|
|
0
|
$regexp = $1; |
925
|
0
|
0
|
|
|
|
0
|
if ($value !~ /$regexp/) { |
926
|
0
|
|
|
|
|
0
|
$exit_status = 1; |
927
|
0
|
|
|
|
|
0
|
print "Error: \"$var\" must match \"$type\" (not \"$value\")\n"; |
928
|
|
|
|
|
|
|
} |
929
|
|
|
|
|
|
|
} |
930
|
|
|
|
|
|
|
} |
931
|
9
|
|
|
|
|
22
|
foreach $var (@vars) { |
932
|
6
|
50
|
33
|
|
|
146
|
next if (!$option_defs->{$var}{required} || defined $values->{$var}); |
933
|
0
|
|
|
|
|
0
|
$exit_status = 1; |
934
|
0
|
|
|
|
|
0
|
print "Error: \"$var\" is a required option but is not defined\n"; |
935
|
|
|
|
|
|
|
} |
936
|
|
|
|
|
|
|
} |
937
|
|
|
|
|
|
|
|
938
|
|
|
|
|
|
|
#print STDERR "13 option_defs [", join("|", sort keys %$option_defs), "]\n" if ($prefix eq "/usr"); |
939
|
9
|
50
|
|
|
|
1159
|
if ($exit_status >= 0) { |
940
|
0
|
0
|
|
|
|
0
|
if ($init_args->{print_usage}) { |
941
|
0
|
|
|
|
|
0
|
&{$init_args->{print_usage}}($values, $init_args); |
|
0
|
|
|
|
|
0
|
|
942
|
|
|
|
|
|
|
} |
943
|
|
|
|
|
|
|
else { |
944
|
0
|
|
|
|
|
0
|
App::Options->print_usage($values, $init_args); |
945
|
|
|
|
|
|
|
} |
946
|
0
|
|
|
|
|
0
|
exit($exit_status); |
947
|
|
|
|
|
|
|
} |
948
|
|
|
|
|
|
|
} |
949
|
|
|
|
|
|
|
|
950
|
|
|
|
|
|
|
# ($app, $app_origin) = App::Options->determine_app($prefix, $prog_dir, $prog_file, $ENV{PATH_INFO}, $ENV{HOME}); |
951
|
|
|
|
|
|
|
sub determine_app { |
952
|
8
|
|
|
8
|
0
|
47
|
my ($class, $prefix, $prog_dir, $prog_file, $path_info, $home_dir) = @_; |
953
|
8
|
|
|
|
|
16
|
my ($app, $app_origin); |
954
|
8
|
|
50
|
|
|
70
|
$path_info ||= ""; |
955
|
8
|
|
|
|
|
17
|
$path_info =~ s!/+$!!; # strip off trailing slashes ("/") |
956
|
8
|
50
|
33
|
|
|
32
|
if ($path_info && $path_info =~ m!^/([^/]+)!) { |
957
|
0
|
|
|
|
|
0
|
my $path_info_app = $1; # first part of PATH_INFO (without slashes) |
958
|
0
|
0
|
0
|
|
|
0
|
if ($home_dir && -f "$home_dir/.app/$path_info_app.conf") { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
959
|
0
|
|
|
|
|
0
|
$app = $path_info_app; |
960
|
0
|
|
|
|
|
0
|
$app_origin = "PATH_INFO=$path_info matches $home_dir/.app/$path_info_app.conf"; |
961
|
|
|
|
|
|
|
} |
962
|
|
|
|
|
|
|
elsif (-f "$prog_dir/$path_info_app.conf") { |
963
|
0
|
|
|
|
|
0
|
$app = $path_info_app; |
964
|
0
|
|
|
|
|
0
|
$app_origin = "PATH_INFO=$path_info matches $prog_dir/$path_info_app.conf"; |
965
|
|
|
|
|
|
|
} |
966
|
|
|
|
|
|
|
elsif (-f "$prefix/etc/app/$path_info_app.conf") { |
967
|
0
|
|
|
|
|
0
|
$app = $path_info_app; |
968
|
0
|
|
|
|
|
0
|
$app_origin = "PATH_INFO=$path_info matches $prefix/etc/app/$path_info_app.conf"; |
969
|
|
|
|
|
|
|
} |
970
|
|
|
|
|
|
|
} |
971
|
8
|
50
|
|
|
|
23
|
if (!$app) { |
972
|
8
|
|
|
|
|
13
|
$app = $prog_file; # start with the full program name |
973
|
8
|
|
|
|
|
92
|
$app =~ s/\.[^.]+$//; # strip off trailing file type (i.e. ".pl") |
974
|
8
|
|
|
|
|
37
|
$app_origin = "program name ($0)"; |
975
|
|
|
|
|
|
|
} |
976
|
8
|
50
|
|
|
|
21
|
if (wantarray) { |
977
|
8
|
|
|
|
|
98
|
return($app, $app_origin); |
978
|
|
|
|
|
|
|
} |
979
|
|
|
|
|
|
|
else { |
980
|
0
|
|
|
|
|
0
|
return($app); |
981
|
|
|
|
|
|
|
} |
982
|
|
|
|
|
|
|
} |
983
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
sub print_usage { |
985
|
0
|
|
|
0
|
0
|
0
|
my ($self, $values, $init_args) = @_; |
986
|
0
|
0
|
|
|
|
0
|
$values = {} if (!$values); |
987
|
0
|
0
|
|
|
|
0
|
$init_args = {} if (!$init_args); |
988
|
|
|
|
|
|
|
|
989
|
0
|
|
|
|
|
0
|
my ($args_description); |
990
|
0
|
0
|
|
|
|
0
|
if (defined $init_args->{args_description}) { |
991
|
0
|
|
|
|
|
0
|
$args_description = " " . $init_args->{args_description}; |
992
|
|
|
|
|
|
|
} |
993
|
|
|
|
|
|
|
else { |
994
|
0
|
|
|
|
|
0
|
$args_description = " [args]"; |
995
|
|
|
|
|
|
|
} |
996
|
|
|
|
|
|
|
|
997
|
0
|
|
|
|
|
0
|
print STDERR "Usage: $0 [options]$args_description\n"; |
998
|
0
|
|
|
|
|
0
|
printf STDERR " --%-32s print this message (also -?)\n", "help"; |
999
|
0
|
|
|
|
|
0
|
my (@vars, $show_all, %option_seen); |
1000
|
0
|
|
|
|
|
0
|
$show_all = $init_args->{show_all}; |
1001
|
0
|
0
|
|
|
|
0
|
$show_all = $values->{show_all} if (defined $values->{show_all}); |
1002
|
0
|
0
|
0
|
|
|
0
|
$show_all = 1 if (!defined $show_all && !defined $init_args->{option} && !defined $init_args->{options}); |
|
|
|
0
|
|
|
|
|
1003
|
|
|
|
|
|
|
#print "DEBUG: show_all=[$show_all] option=[$init_args->{option}] options=[$init_args->{options}]\n" if ($values->{foo}); |
1004
|
0
|
0
|
|
|
|
0
|
if ($init_args->{options}) { |
1005
|
0
|
|
|
|
|
0
|
@vars = @{$init_args->{options}}; |
|
0
|
|
|
|
|
0
|
|
1006
|
|
|
|
|
|
|
} |
1007
|
0
|
0
|
|
|
|
0
|
if ($init_args->{option}) { |
1008
|
0
|
|
|
|
|
0
|
push(@vars, (sort keys %{$init_args->{option}})); |
|
0
|
|
|
|
|
0
|
|
1009
|
|
|
|
|
|
|
} |
1010
|
0
|
0
|
|
|
|
0
|
if ($show_all) { |
1011
|
0
|
|
|
|
|
0
|
push(@vars, (sort keys %$values)); |
1012
|
|
|
|
|
|
|
} |
1013
|
0
|
|
|
|
|
0
|
my ($var, $value, $type, $desc, $option_defs); |
1014
|
0
|
|
|
|
|
0
|
my ($var_str, $value_str, $type_str, $desc_str, $val_desc, $secure); |
1015
|
0
|
|
0
|
|
|
0
|
$option_defs = $init_args->{option} || {}; |
1016
|
0
|
|
|
|
|
0
|
foreach $var (@vars) { |
1017
|
0
|
0
|
|
|
|
0
|
next if ($option_seen{$var}); |
1018
|
0
|
|
|
|
|
0
|
$option_seen{$var} = 1; |
1019
|
0
|
0
|
0
|
|
|
0
|
next if ($var eq "?" || $var eq "help"); |
1020
|
0
|
|
|
|
|
0
|
$value = $values->{$var}; |
1021
|
0
|
|
0
|
|
|
0
|
$type = $option_defs->{$var}{type} || ""; |
1022
|
0
|
|
0
|
|
|
0
|
$desc = $option_defs->{$var}{description} || ""; |
1023
|
0
|
|
|
|
|
0
|
$secure = $option_defs->{$var}{secure}; |
1024
|
0
|
0
|
0
|
|
|
0
|
$secure = 1 if (! defined $secure && $var =~ /(pass|password|passwd)$/); |
1025
|
0
|
0
|
0
|
|
|
0
|
$secure = $values->{security_policy_level} if (defined $secure && defined $values->{security_policy_level}); |
1026
|
0
|
|
0
|
|
|
0
|
$val_desc = $option_defs->{$var}{value_description} || ""; |
1027
|
0
|
0
|
|
|
|
0
|
$var_str = ($type eq "boolean") ? $var : ($val_desc ? "$var=<$val_desc>" : "$var="); |
|
|
0
|
|
|
|
|
|
1028
|
0
|
0
|
|
|
|
0
|
$value_str = (defined $value) ? ($secure ? "********" : $value) : "undef"; |
|
|
0
|
|
|
|
|
|
1029
|
0
|
0
|
|
|
|
0
|
$type_str = ($type) ? " ($type)" : ""; |
1030
|
0
|
0
|
|
|
|
0
|
$desc_str = ($desc) ? " $desc" : ""; |
1031
|
0
|
|
|
|
|
0
|
$desc_str =~ s/%/%%/g; |
1032
|
0
|
|
|
|
|
0
|
printf STDERR " --%-32s [%s]$type_str$desc_str\n", $var_str, $value_str; |
1033
|
|
|
|
|
|
|
} |
1034
|
|
|
|
|
|
|
#print STDERR "PU option_defs [", join("|", sort keys %$option_defs), "]\n" if ($values->{prefix} eq "/usr"); |
1035
|
|
|
|
|
|
|
} |
1036
|
|
|
|
|
|
|
|
1037
|
|
|
|
|
|
|
sub print_version { |
1038
|
0
|
|
|
0
|
0
|
0
|
my ($self, $prog_file, $show_version, $values) = @_; |
1039
|
0
|
|
|
|
|
0
|
print "Program: $prog_file\n"; |
1040
|
0
|
|
|
|
|
0
|
print "(use --version_packages to see version info for specific perl packages)\n"; |
1041
|
0
|
|
|
|
|
0
|
my ($module, $package, $version, $full_path); |
1042
|
0
|
0
|
|
|
|
0
|
if ($values->{version_packages}) { |
1043
|
0
|
|
|
|
|
0
|
foreach my $package (split(/[ ;,]+/,$values->{version_packages})) { |
1044
|
0
|
|
|
|
|
0
|
$module = "$package.pm"; |
1045
|
0
|
|
|
|
|
0
|
$module =~ s!::!/!g; |
1046
|
0
|
0
|
|
|
|
0
|
if ($package =~ /^[A-Z][A-Za-z0-9:_]*$/) { |
1047
|
0
|
|
|
|
|
0
|
eval { |
1048
|
0
|
|
|
|
|
0
|
require $module; |
1049
|
|
|
|
|
|
|
}; |
1050
|
0
|
0
|
|
|
|
0
|
if ($@) { |
1051
|
0
|
|
|
|
|
0
|
my $error = $@; |
1052
|
0
|
|
|
|
|
0
|
$error =~ s/ *\(\@INC contains:.*//s; |
1053
|
0
|
|
|
|
|
0
|
print "WARNING: $package: $error\n"; |
1054
|
|
|
|
|
|
|
} |
1055
|
|
|
|
|
|
|
} |
1056
|
|
|
|
|
|
|
} |
1057
|
|
|
|
|
|
|
} |
1058
|
0
|
|
|
|
|
0
|
print "Version Package\n"; |
1059
|
0
|
|
|
|
|
0
|
print "------- ----------------------------\n"; |
1060
|
0
|
|
0
|
|
|
0
|
printf("%7s main\n", $main::VERSION || "undef"); |
1061
|
|
|
|
|
|
|
|
1062
|
0
|
|
|
|
|
0
|
my ($show_module, @package_pattern, $version_sys_packages); |
1063
|
|
|
|
|
|
|
|
1064
|
|
|
|
|
|
|
# There are lots of modules which get loaded up which have |
1065
|
|
|
|
|
|
|
# nothing to do with your program and which you would ordinarily |
1066
|
|
|
|
|
|
|
# not want to see. So ... |
1067
|
|
|
|
|
|
|
# --version=1 will show only the packages you specify |
1068
|
|
|
|
|
|
|
# --version=2 will show all packages |
1069
|
0
|
0
|
|
|
|
0
|
if ($values->{version_packages}) { |
1070
|
0
|
|
|
|
|
0
|
$version_sys_packages = $values->{version_sys_packages}; |
1071
|
0
|
0
|
|
|
|
0
|
$version_sys_packages = "App::Options,Carp,Sys::Hostname,Cwd,File::Spec,Config" |
1072
|
|
|
|
|
|
|
if (!defined $version_sys_packages); |
1073
|
0
|
|
|
|
|
0
|
@package_pattern = split(/[ ;,]+/,$version_sys_packages); |
1074
|
0
|
0
|
|
|
|
0
|
if ($values->{version_packages}) { |
1075
|
0
|
|
|
|
|
0
|
push(@package_pattern, split(/[ ;,]+/,$values->{version_packages})); |
1076
|
|
|
|
|
|
|
} |
1077
|
|
|
|
|
|
|
} |
1078
|
|
|
|
|
|
|
|
1079
|
|
|
|
|
|
|
# I should look into doing this from the symbol table rather |
1080
|
|
|
|
|
|
|
# than %INC which reflects the *modules*, not the packages. |
1081
|
|
|
|
|
|
|
# For most purposes, this will be good enough. |
1082
|
0
|
|
|
|
|
0
|
foreach $module (sort keys %INC) { |
1083
|
0
|
|
|
|
|
0
|
$full_path = $INC{$module}; |
1084
|
0
|
|
|
|
|
0
|
$package = $module; |
1085
|
0
|
|
|
|
|
0
|
$package =~ s/\.p[lm]$//; |
1086
|
0
|
|
|
|
|
0
|
$package =~ s!/!::!g; |
1087
|
|
|
|
|
|
|
|
1088
|
0
|
0
|
0
|
|
|
0
|
if ($values->{version_packages} && $show_version ne "all") { |
1089
|
0
|
|
|
|
|
0
|
$show_module = 0; |
1090
|
0
|
|
|
|
|
0
|
foreach my $package_pattern (@package_pattern) { |
1091
|
0
|
0
|
|
|
|
0
|
if ($package =~ /$package_pattern/) { |
1092
|
0
|
|
|
|
|
0
|
$show_module = 1; |
1093
|
0
|
|
|
|
|
0
|
last; |
1094
|
|
|
|
|
|
|
} |
1095
|
|
|
|
|
|
|
} |
1096
|
|
|
|
|
|
|
} |
1097
|
|
|
|
|
|
|
else { |
1098
|
0
|
|
|
|
|
0
|
$show_module = 1; |
1099
|
|
|
|
|
|
|
} |
1100
|
|
|
|
|
|
|
|
1101
|
0
|
0
|
|
|
|
0
|
if ($show_module) { |
1102
|
0
|
|
|
|
|
0
|
$version = ""; |
1103
|
0
|
|
|
|
|
0
|
eval "\$version = \$${package}::VERSION;"; |
1104
|
0
|
0
|
|
|
|
0
|
$version = "undef" if (!$version); |
1105
|
0
|
|
|
|
|
0
|
printf("%7s %-20s\n", $version, $package); |
1106
|
|
|
|
|
|
|
#printf("%7s %-20s %s\n", "", $module, $full_path); |
1107
|
|
|
|
|
|
|
} |
1108
|
|
|
|
|
|
|
} |
1109
|
|
|
|
|
|
|
} |
1110
|
|
|
|
|
|
|
|
1111
|
|
|
|
|
|
|
sub read_option_files { |
1112
|
9
|
|
|
9
|
0
|
38
|
my ($self, $values, $option_files, $prefix, $option_defs) = @_; |
1113
|
9
|
|
|
|
|
19
|
my $init_args = $self->{init_args}; |
1114
|
9
|
|
|
|
|
20
|
local(*App::Options::FILE); |
1115
|
9
|
|
|
|
|
16
|
my ($option_file, $exclude_section, $var, @env_vars, $env_var, $value, $regexp); |
1116
|
0
|
|
|
|
|
0
|
my ($cond, @cond, $exclude, $heredoc_end); |
1117
|
9
|
|
50
|
|
|
59
|
my $debug_options = $values->{debug_options} || 0; |
1118
|
9
|
|
|
|
|
21
|
my $is_mod_perl = $ENV{MOD_PERL}; |
1119
|
9
|
|
|
|
|
36
|
while ($#$option_files > -1) { |
1120
|
45
|
|
|
|
|
428
|
$option_file = shift(@$option_files); |
1121
|
45
|
50
|
|
|
|
144
|
if ($option_file =~ m!\$\{prefix\}!) { |
1122
|
0
|
0
|
|
|
|
0
|
if ($values->{prefix}) { |
1123
|
0
|
|
|
|
|
0
|
$option_file =~ s!\$\{prefix\}!$values->{prefix}!; |
1124
|
|
|
|
|
|
|
} |
1125
|
|
|
|
|
|
|
else { |
1126
|
0
|
|
|
|
|
0
|
$option_file =~ s!\$\{prefix\}!$prefix!; |
1127
|
|
|
|
|
|
|
} |
1128
|
|
|
|
|
|
|
} |
1129
|
45
|
|
|
|
|
53
|
$exclude_section = 0; |
1130
|
45
|
50
|
|
|
|
87
|
print STDERR " Looking for Option File [$option_file]" if ($debug_options); |
1131
|
45
|
100
|
|
|
|
1387
|
if (open(App::Options::FILE, "< $option_file")) { |
1132
|
9
|
50
|
|
|
|
22
|
print STDERR " : Found\n" if ($debug_options); |
1133
|
9
|
|
|
|
|
13
|
my ($orig_line); |
1134
|
9
|
|
|
|
|
1684
|
while () { |
1135
|
450
|
|
|
|
|
7490
|
chomp; |
1136
|
450
|
|
|
|
|
663
|
s/\r$//; # remove final CR (for Windows files) |
1137
|
450
|
|
|
|
|
641
|
$orig_line = $_; |
1138
|
|
|
|
|
|
|
# for lines that are like "[regexp]" or even "[regexp] var = value" |
1139
|
|
|
|
|
|
|
# or "[value;var=value]" or "[/regexp/;var1=value1;var2=/regexp2/]" |
1140
|
450
|
100
|
|
|
|
2381
|
if (s!^\s*\[(.*)\]\s*!!) { |
1141
|
189
|
50
|
|
|
|
544
|
print STDERR " Checking Section : [$1]\n" if ($debug_options >= 6); |
1142
|
189
|
|
|
|
|
626
|
@cond = split(/;/,$1); # separate the conditions that must be satisfied |
1143
|
189
|
|
|
|
|
379
|
$exclude = 0; # assume the condition allows inclusion (! $exclude) |
1144
|
189
|
|
|
|
|
255
|
foreach $cond (@cond) { # check each condition |
1145
|
180
|
100
|
|
|
|
477
|
if ($cond =~ /^([^=]+)=(.*)$/) { # i.e. [city=ATL] or [name=/[Ss]tephen/] |
1146
|
36
|
|
|
|
|
53
|
$var = $1; |
1147
|
36
|
|
|
|
|
69
|
$value = $2; |
1148
|
|
|
|
|
|
|
} |
1149
|
|
|
|
|
|
|
else { # i.e. [go] matches the program (app) named "go" |
1150
|
144
|
|
|
|
|
651
|
$var = "app"; |
1151
|
144
|
|
|
|
|
200
|
$value = $cond; |
1152
|
|
|
|
|
|
|
} |
1153
|
180
|
100
|
66
|
|
|
1168
|
if ($value =~ m!^/(.*)/$!) { # variable's value must match the regexp |
|
|
100
|
66
|
|
|
|
|
1154
|
18
|
|
|
|
|
32
|
$regexp = $1; |
1155
|
18
|
50
|
|
|
|
344
|
$exclude = ((defined $values->{$var} ? $values->{$var} : "") !~ /$regexp/) ? 1 : 0; |
|
|
100
|
|
|
|
|
|
1156
|
18
|
0
|
|
|
|
60
|
print STDERR " Checking Section Condition var=[$var] [$value] matches [$regexp] : result=", |
|
|
50
|
|
|
|
|
|
1157
|
|
|
|
|
|
|
($exclude ? "[ignore]" : "[use]"), "\n" |
1158
|
|
|
|
|
|
|
if ($debug_options >= 6); |
1159
|
|
|
|
|
|
|
} |
1160
|
|
|
|
|
|
|
elsif ($var eq "app" && ($value eq "" || $value eq "ALL")) { |
1161
|
27
|
|
|
|
|
120
|
$exclude = 0; # "" and "ALL" are special wildcards for the "app" variable |
1162
|
27
|
0
|
|
|
|
67
|
print STDERR " Checking Section Condition var=[$var] [$value] = ALL : result=", |
|
|
50
|
|
|
|
|
|
1163
|
|
|
|
|
|
|
($exclude ? "[ignore]" : "[use]"), "\n" |
1164
|
|
|
|
|
|
|
if ($debug_options >= 6); |
1165
|
|
|
|
|
|
|
} |
1166
|
|
|
|
|
|
|
else { # a variable's value must match exactly |
1167
|
135
|
100
|
|
|
|
1648
|
$exclude = ((defined $values->{$var} ? $values->{$var} : "") ne $value) ? 1 : 0; |
|
|
100
|
|
|
|
|
|
1168
|
135
|
0
|
|
|
|
264
|
print STDERR " Checking Section Condition var=[$var] [$value] = [", |
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1169
|
|
|
|
|
|
|
(defined $values->{$var} ? $values->{$var} : ""), |
1170
|
|
|
|
|
|
|
"] : result=", |
1171
|
|
|
|
|
|
|
($exclude ? "[ignore]" : "[use]"), "\n" |
1172
|
|
|
|
|
|
|
if ($debug_options >= 6); |
1173
|
|
|
|
|
|
|
} |
1174
|
180
|
100
|
|
|
|
407
|
last if ($exclude); |
1175
|
|
|
|
|
|
|
} |
1176
|
189
|
|
|
|
|
267
|
s/^#.*$//; # delete comments |
1177
|
189
|
0
|
|
|
|
394
|
print STDERR " ", ($exclude ? "[ignore]" : "[use] "), " $orig_line\n" if ($debug_options >= 5); |
|
|
50
|
|
|
|
|
|
1178
|
189
|
100
|
|
|
|
307
|
if ($_) { |
1179
|
|
|
|
|
|
|
# this is a single-line condition, don't change the $exclude_section flag |
1180
|
90
|
100
|
|
|
|
427
|
next if ($exclude); |
1181
|
|
|
|
|
|
|
} |
1182
|
|
|
|
|
|
|
else { |
1183
|
|
|
|
|
|
|
# this condition pertains to all lines after it |
1184
|
99
|
|
|
|
|
102
|
$exclude_section = $exclude; |
1185
|
99
|
|
|
|
|
338
|
next; |
1186
|
|
|
|
|
|
|
} |
1187
|
|
|
|
|
|
|
} |
1188
|
|
|
|
|
|
|
else { |
1189
|
261
|
0
|
|
|
|
636
|
print STDERR " ", ($exclude_section ? "[ignore]" : "[use] "), " $orig_line\n" if ($debug_options >= 5); |
|
|
50
|
|
|
|
|
|
1190
|
|
|
|
|
|
|
} |
1191
|
315
|
100
|
|
|
|
645
|
next if ($exclude_section); |
1192
|
|
|
|
|
|
|
|
1193
|
261
|
|
|
|
|
426
|
s/#.*$//; # delete comments |
1194
|
261
|
|
|
|
|
796
|
s/^\s+//; # delete leading spaces |
1195
|
261
|
|
|
|
|
852
|
s/\s+$//; # delete trailing spaces |
1196
|
261
|
100
|
|
|
|
1142
|
next if (/^$/); # skip blank lines |
1197
|
|
|
|
|
|
|
|
1198
|
|
|
|
|
|
|
# look for "var = value" (ignore other lines) |
1199
|
243
|
50
|
|
|
|
1385
|
if (/^([^\s=]+)\s*=\s*(.*)/) { # untainting also happens |
1200
|
243
|
|
|
|
|
1591
|
$var = $1; |
1201
|
243
|
|
|
|
|
1256
|
$value = $2; |
1202
|
|
|
|
|
|
|
|
1203
|
243
|
50
|
|
|
|
841
|
if (!$is_mod_perl) { |
1204
|
243
|
0
|
33
|
|
|
640
|
if ($var eq "perl_restart" && $value && $value ne "1") { |
|
|
|
33
|
|
|
|
|
1205
|
0
|
|
|
|
|
0
|
foreach my $env_var (split(/,/,$value)) { |
1206
|
0
|
0
|
|
|
|
0
|
if (!$ENV{$env_var}) { |
1207
|
0
|
|
|
|
|
0
|
$value = 1; |
1208
|
0
|
|
|
|
|
0
|
last; |
1209
|
|
|
|
|
|
|
} |
1210
|
|
|
|
|
|
|
} |
1211
|
|
|
|
|
|
|
} |
1212
|
|
|
|
|
|
|
} |
1213
|
|
|
|
|
|
|
|
1214
|
|
|
|
|
|
|
# "here documents": var = <
|
1215
|
243
|
100
|
100
|
|
|
2067
|
if ($value =~ /^<<(.*)/) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
1216
|
9
|
|
|
|
|
57
|
$heredoc_end = $1; |
1217
|
9
|
|
|
|
|
27
|
$value = ""; |
1218
|
9
|
|
|
|
|
61
|
while () { |
1219
|
27
|
100
|
|
|
|
233
|
last if ($_ =~ /^$heredoc_end\s*$/); |
1220
|
18
|
|
|
|
|
84
|
$value .= $_; |
1221
|
|
|
|
|
|
|
} |
1222
|
9
|
|
|
|
|
25
|
$heredoc_end = ""; |
1223
|
|
|
|
|
|
|
} |
1224
|
|
|
|
|
|
|
# get value from a file |
1225
|
|
|
|
|
|
|
elsif ($value =~ /^<\s*(.+)/ || $value =~ /^(.+)\s*\|$/) { |
1226
|
27
|
50
|
|
|
|
111
|
$value =~ s/\$\{([a-zA-Z0-9_\.-]+)\}/(defined $values->{$1} ? $values->{$1} : "")/eg; |
|
27
|
|
|
|
|
131
|
|
1227
|
27
|
50
|
|
|
|
74227
|
if (open(App::Options::FILE2, $value)) { |
1228
|
27
|
|
|
|
|
12903
|
$value = join("", ); |
1229
|
27
|
|
|
|
|
2390
|
close(App::Options::FILE2); |
1230
|
|
|
|
|
|
|
} |
1231
|
|
|
|
|
|
|
else { |
1232
|
0
|
|
|
|
|
0
|
$value = "Can't read file [$value] for variable [$var]: $!"; |
1233
|
|
|
|
|
|
|
} |
1234
|
|
|
|
|
|
|
} |
1235
|
|
|
|
|
|
|
# get additional line(s) due to continuation chars |
1236
|
|
|
|
|
|
|
elsif ($value =~ s/\\\s*$//) { |
1237
|
18
|
|
|
|
|
70
|
while () { |
1238
|
36
|
100
|
|
|
|
216
|
if ($_ =~ s/\\\s*[\r\n]*$//) { # remove trailing newline |
1239
|
18
|
|
|
|
|
47
|
s/^\s+//; # remove leading space when following a line continuation character |
1240
|
18
|
|
|
|
|
60
|
$value .= $_; |
1241
|
|
|
|
|
|
|
} |
1242
|
|
|
|
|
|
|
else { |
1243
|
18
|
|
|
|
|
29
|
chomp; # remove trailing newline when following a line continuation character |
1244
|
18
|
|
|
|
|
80
|
s/^\s+//; # remove leading space when following a line continuation character |
1245
|
18
|
|
|
|
|
35
|
$value .= $_; |
1246
|
18
|
|
|
|
|
29
|
last; |
1247
|
|
|
|
|
|
|
} |
1248
|
|
|
|
|
|
|
} |
1249
|
|
|
|
|
|
|
} |
1250
|
|
|
|
|
|
|
else { |
1251
|
189
|
|
|
|
|
270
|
$value =~ s/^"(.*)"$/$1/; # quoting, var = " hello world " (enables leading/trailing spaces) |
1252
|
|
|
|
|
|
|
} |
1253
|
|
|
|
|
|
|
|
1254
|
243
|
50
|
|
|
|
969
|
print STDERR " Var Found in File : var=[$var] value=[$value]\n" if ($debug_options >= 6); |
1255
|
|
|
|
|
|
|
|
1256
|
|
|
|
|
|
|
# only add values which have never been defined before |
1257
|
243
|
100
|
|
|
|
1219
|
if ($var =~ /^ENV\{([^{}]+)\}$/) { |
|
|
100
|
|
|
|
|
|
1258
|
9
|
|
|
|
|
22
|
$env_var = $1; |
1259
|
9
|
|
|
|
|
184
|
$ENV{$env_var} = $value; |
1260
|
|
|
|
|
|
|
} |
1261
|
|
|
|
|
|
|
elsif (!defined $values->{$var}) { |
1262
|
193
|
50
|
|
|
|
560
|
if (!$init_args->{no_env_vars}) { |
1263
|
193
|
50
|
33
|
|
|
1361
|
if ($option_defs && defined $option_defs->{$var} && defined $option_defs->{$var}{env}) { |
|
|
|
33
|
|
|
|
|
1264
|
0
|
0
|
|
|
|
0
|
if ($option_defs->{$var}{env} eq "") { |
1265
|
0
|
|
|
|
|
0
|
@env_vars = (); |
1266
|
|
|
|
|
|
|
} |
1267
|
|
|
|
|
|
|
else { |
1268
|
0
|
|
|
|
|
0
|
@env_vars = split(/[,;]/, $option_defs->{$var}{env}); |
1269
|
|
|
|
|
|
|
} |
1270
|
|
|
|
|
|
|
} |
1271
|
|
|
|
|
|
|
else { |
1272
|
193
|
|
|
|
|
1166
|
@env_vars = ( "APP_" . uc($var) ); |
1273
|
|
|
|
|
|
|
} |
1274
|
193
|
|
|
|
|
381
|
foreach $env_var (@env_vars) { |
1275
|
193
|
50
|
33
|
|
|
1444
|
if ($env_var && defined $ENV{$env_var}) { |
1276
|
0
|
|
|
|
|
0
|
$value = $ENV{$env_var}; |
1277
|
0
|
0
|
|
|
|
0
|
print STDERR " Override File Value from Env : var=[$var] value=[$value] from [$env_var] of [@env_vars]\n" if ($debug_options >= 4); |
1278
|
0
|
|
|
|
|
0
|
last; |
1279
|
|
|
|
|
|
|
} |
1280
|
|
|
|
|
|
|
} |
1281
|
|
|
|
|
|
|
} |
1282
|
|
|
|
|
|
|
# do variable substitutions, var = ${prefix}/bin, var = $ENV{PATH} |
1283
|
193
|
50
|
|
|
|
427
|
if (defined $value) { |
1284
|
193
|
100
|
|
|
|
549
|
if ($value =~ /\{.*\}/) { |
1285
|
32
|
0
|
|
|
|
105
|
$value =~ s/\$\{([a-zA-Z0-9_\.-]+)\}/(defined $values->{$1} ? $values->{$1} : ($1 eq "prefix" ? $prefix : ""))/eg; |
|
24
|
50
|
|
|
|
124
|
|
1286
|
32
|
100
|
|
|
|
103
|
$value =~ s/\$ENV\{([a-zA-Z0-9_\.-]+)\}/(defined $ENV{$1} ? $ENV{$1} : "")/eg; |
|
8
|
|
|
|
|
53
|
|
1287
|
32
|
50
|
|
|
|
72
|
print STDERR " File Var Underwent Substitutions : [$var] = [$value]\n" |
1288
|
|
|
|
|
|
|
if ($debug_options >= 4); |
1289
|
|
|
|
|
|
|
} |
1290
|
193
|
50
|
|
|
|
473
|
print STDERR " Var Used : var=[$var] value=[$value]\n" if ($debug_options >= 3); |
1291
|
193
|
0
|
33
|
|
|
787
|
if ($option_defs->{$var} && $option_defs->{$var}{secure} && |
|
|
|
33
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
1292
|
|
|
|
|
|
|
defined $values->{security_policy_level} && $values->{security_policy_level} >= 2 && !&file_is_secure($option_file)) { |
1293
|
0
|
|
|
|
|
0
|
print "Error: \"$var\" may not be supplied from an insecure file because it is a secure option.\n"; |
1294
|
0
|
|
|
|
|
0
|
print " File: [$option_file]\n"; |
1295
|
0
|
|
|
|
|
0
|
print " (The file and all of its parent directories must be readable/writable only by the user running the program.)\n"; |
1296
|
0
|
|
|
|
|
0
|
exit(1); |
1297
|
|
|
|
|
|
|
} |
1298
|
193
|
|
|
|
|
1776
|
$values->{$var} = $value; # save all in %App::options |
1299
|
|
|
|
|
|
|
} |
1300
|
|
|
|
|
|
|
} |
1301
|
|
|
|
|
|
|
} |
1302
|
|
|
|
|
|
|
} |
1303
|
9
|
|
|
|
|
133
|
close(App::Options::FILE); |
1304
|
|
|
|
|
|
|
|
1305
|
9
|
50
|
|
|
|
53
|
if ($values->{flush_imports}) { |
1306
|
9
|
|
|
|
|
107
|
@$option_files = (); # throw out other files to look for |
1307
|
9
|
|
|
|
|
56
|
delete $values->{flush_imports}; |
1308
|
|
|
|
|
|
|
} |
1309
|
9
|
50
|
|
|
|
436
|
if ($values->{import}) { |
1310
|
0
|
|
|
|
|
0
|
unshift(@$option_files, split(/[,; ]+/, $values->{import})); |
1311
|
0
|
|
|
|
|
0
|
delete $values->{import}; |
1312
|
|
|
|
|
|
|
} |
1313
|
|
|
|
|
|
|
} |
1314
|
|
|
|
|
|
|
else { |
1315
|
36
|
50
|
|
|
|
146
|
print STDERR "\n" if ($debug_options); |
1316
|
|
|
|
|
|
|
} |
1317
|
|
|
|
|
|
|
} |
1318
|
|
|
|
|
|
|
} |
1319
|
|
|
|
|
|
|
|
1320
|
|
|
|
|
|
|
sub file_is_secure { |
1321
|
0
|
|
|
0
|
0
|
|
my ($file) = @_; |
1322
|
0
|
|
|
|
|
|
my ($secure, $dir); |
1323
|
0
|
|
|
|
|
|
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks); |
1324
|
0
|
0
|
|
|
|
|
if ($^O =~ /MSWin32/) { |
1325
|
0
|
|
|
|
|
|
$secure = 1; # say it is without really checking |
1326
|
|
|
|
|
|
|
} |
1327
|
|
|
|
|
|
|
else { |
1328
|
0
|
|
|
|
|
|
$secure = $path_is_secure{$file}; |
1329
|
0
|
0
|
|
|
|
|
if (!defined $secure) { |
1330
|
0
|
|
|
|
|
|
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat($file); |
1331
|
0
|
0
|
|
|
|
|
if (!($mode & 0400)) { |
|
|
0
|
|
|
|
|
|
1332
|
0
|
|
|
|
|
|
$secure = 0; |
1333
|
0
|
|
|
|
|
|
print "Error: Option file is not secure because it is not readable by the owner.\n"; |
1334
|
|
|
|
|
|
|
} |
1335
|
|
|
|
|
|
|
elsif ($mode & 0077) { |
1336
|
0
|
|
|
|
|
|
$secure = 0; |
1337
|
0
|
|
|
|
|
|
print "Error: Option file is not secure because it is readable/writable by users other than the owner.\n"; |
1338
|
|
|
|
|
|
|
} |
1339
|
|
|
|
|
|
|
else { |
1340
|
0
|
|
|
|
|
|
$dir =~ s!/?[^/]+$!!; |
1341
|
0
|
|
0
|
|
|
|
while ($dir && $secure) { |
1342
|
0
|
|
|
|
|
|
$secure = $path_is_secure{$file}; |
1343
|
0
|
0
|
|
|
|
|
if (!defined $secure) { |
1344
|
0
|
|
|
|
|
|
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat("$dir/."); # navigate symlink to the directory |
1345
|
0
|
0
|
0
|
|
|
|
if ($uid >= 100 && $uid != $>) { |
|
|
0
|
|
|
|
|
|
1346
|
0
|
|
|
|
|
|
$secure = 0; |
1347
|
0
|
|
|
|
|
|
print "Error: Option file is not secure because a parent directory is owned by a different user.\n"; |
1348
|
0
|
|
|
|
|
|
print " Dir=[$dir]\n"; |
1349
|
|
|
|
|
|
|
} |
1350
|
|
|
|
|
|
|
elsif ($mode & 0077) { |
1351
|
0
|
|
|
|
|
|
$secure = 0; |
1352
|
0
|
|
|
|
|
|
print "Error: Option file is not secure because a parent directory is readable/writable by other users.\n"; |
1353
|
0
|
|
|
|
|
|
print " Dir=[$dir]\n"; |
1354
|
|
|
|
|
|
|
} |
1355
|
0
|
|
|
|
|
|
$path_is_secure{$file} = 1; # I don't know this yet, but if we ever get around to asking again, it means that the directory was secure. |
1356
|
|
|
|
|
|
|
} |
1357
|
0
|
|
|
|
|
|
$dir =~ s!/?[^/]+$!!; |
1358
|
|
|
|
|
|
|
} |
1359
|
0
|
0
|
|
|
|
|
$secure = 1 if (!defined $secure); |
1360
|
|
|
|
|
|
|
} |
1361
|
0
|
|
|
|
|
|
$path_is_secure{$file} = $secure; |
1362
|
|
|
|
|
|
|
} |
1363
|
|
|
|
|
|
|
} |
1364
|
0
|
|
|
|
|
|
return($secure); |
1365
|
|
|
|
|
|
|
} |
1366
|
|
|
|
|
|
|
|
1367
|
|
|
|
|
|
|
=head1 LOGIC FLOW: OPTION PROCESSING DETAILS |
1368
|
|
|
|
|
|
|
|
1369
|
|
|
|
|
|
|
Basic Concept - By calling App::Options->init(), |
1370
|
|
|
|
|
|
|
your program parses the command line, environment variables, |
1371
|
|
|
|
|
|
|
and option files, and puts var/value pairs into a |
1372
|
|
|
|
|
|
|
global option hash, %App::options. |
1373
|
|
|
|
|
|
|
Just include the following at the top of your program |
1374
|
|
|
|
|
|
|
in order to imbue it with many valuable option-setting |
1375
|
|
|
|
|
|
|
capabilities. |
1376
|
|
|
|
|
|
|
|
1377
|
|
|
|
|
|
|
use App::Options; |
1378
|
|
|
|
|
|
|
|
1379
|
|
|
|
|
|
|
When you "use" the App::Options module, the import() method |
1380
|
|
|
|
|
|
|
is called automatically. This calls the init() method, |
1381
|
|
|
|
|
|
|
passing along all of its parameters. |
1382
|
|
|
|
|
|
|
|
1383
|
|
|
|
|
|
|
One of the args to init() is the "values" arg, which allows |
1384
|
|
|
|
|
|
|
for a different hash to be specified as the target of all |
1385
|
|
|
|
|
|
|
option variables and values. |
1386
|
|
|
|
|
|
|
|
1387
|
|
|
|
|
|
|
use App::Options (values => \%Mymodule::opts); |
1388
|
|
|
|
|
|
|
|
1389
|
|
|
|
|
|
|
Throughout the following description of option processing, |
1390
|
|
|
|
|
|
|
the %App::options hash may be referred to as the "options hash". |
1391
|
|
|
|
|
|
|
However it will be understood that some other hash (as |
1392
|
|
|
|
|
|
|
specified by the "values" arg) may actually be used. |
1393
|
|
|
|
|
|
|
|
1394
|
|
|
|
|
|
|
=head2 Command Line Arguments |
1395
|
|
|
|
|
|
|
|
1396
|
|
|
|
|
|
|
Unless the "no_cmd_args" arg is specified to init(), the |
1397
|
|
|
|
|
|
|
first source of option values is the command line. |
1398
|
|
|
|
|
|
|
|
1399
|
|
|
|
|
|
|
Each command line argument that begins with a "-" or a "--" is |
1400
|
|
|
|
|
|
|
considered to be an option. It may take any form such as |
1401
|
|
|
|
|
|
|
|
1402
|
|
|
|
|
|
|
--verbose # long option, no arg |
1403
|
|
|
|
|
|
|
--verbose=5 # long option, with arg |
1404
|
|
|
|
|
|
|
--city=ATL # long option, with arg |
1405
|
|
|
|
|
|
|
-x # short option, no arg |
1406
|
|
|
|
|
|
|
-t=12:30 # short option, with arg |
1407
|
|
|
|
|
|
|
|
1408
|
|
|
|
|
|
|
All detected options are shifted out of @ARGV and the values are |
1409
|
|
|
|
|
|
|
set in the options hash (%App::options). Options without args |
1410
|
|
|
|
|
|
|
are understood to have a value of "1". So "--verbose" is |
1411
|
|
|
|
|
|
|
identical to "--verbose=1". |
1412
|
|
|
|
|
|
|
|
1413
|
|
|
|
|
|
|
Naturally, the "--" option terminates command line option processing. |
1414
|
|
|
|
|
|
|
|
1415
|
|
|
|
|
|
|
=head2 Command Line Argument Variable Substitution |
1416
|
|
|
|
|
|
|
|
1417
|
|
|
|
|
|
|
Any value which includes a variable undergoes variable substitution |
1418
|
|
|
|
|
|
|
before it is placed in the option hash. i.e. |
1419
|
|
|
|
|
|
|
|
1420
|
|
|
|
|
|
|
logdir = ${prefix}/log |
1421
|
|
|
|
|
|
|
|
1422
|
|
|
|
|
|
|
This line will be expanded properly. |
1423
|
|
|
|
|
|
|
(Of course, the variable and its value should be already set in the |
1424
|
|
|
|
|
|
|
option hash.) |
1425
|
|
|
|
|
|
|
|
1426
|
|
|
|
|
|
|
Variable substitution is also performed to interpolate values from |
1427
|
|
|
|
|
|
|
the environment. |
1428
|
|
|
|
|
|
|
|
1429
|
|
|
|
|
|
|
port = $ENV{HTTP_PORT} |
1430
|
|
|
|
|
|
|
|
1431
|
|
|
|
|
|
|
=head2 Special Option "app" |
1432
|
|
|
|
|
|
|
|
1433
|
|
|
|
|
|
|
If the special option, "app", was not given on the command line, |
1434
|
|
|
|
|
|
|
it is initialized. This option is useful for including or excluding |
1435
|
|
|
|
|
|
|
different sections of the option files. |
1436
|
|
|
|
|
|
|
|
1437
|
|
|
|
|
|
|
To handle the special case that the program is running in a CGI |
1438
|
|
|
|
|
|
|
environment, the PATH_INFO variable is checked first. |
1439
|
|
|
|
|
|
|
The first segment of the PATH_INFO is stripped off, and that becomes |
1440
|
|
|
|
|
|
|
the value of the "app" option. |
1441
|
|
|
|
|
|
|
|
1442
|
|
|
|
|
|
|
Otherwise, the stem of the program name becomes the value of the |
1443
|
|
|
|
|
|
|
"app" option. The stem is the program name without any trailing |
1444
|
|
|
|
|
|
|
extension (i.e. ".exe", ".pl", etc.). |
1445
|
|
|
|
|
|
|
|
1446
|
|
|
|
|
|
|
=head2 The Program Directory |
1447
|
|
|
|
|
|
|
|
1448
|
|
|
|
|
|
|
One of the places that will be searched for option files is the |
1449
|
|
|
|
|
|
|
directory in which the program exists on the file system. |
1450
|
|
|
|
|
|
|
This directory is known internally as "$prog_dir". |
1451
|
|
|
|
|
|
|
|
1452
|
|
|
|
|
|
|
=head2 Special Option "prefix" |
1453
|
|
|
|
|
|
|
|
1454
|
|
|
|
|
|
|
The special option, "prefix", represents the root directory of the |
1455
|
|
|
|
|
|
|
software installation. On a Unix system, a suite of software might |
1456
|
|
|
|
|
|
|
by installed at "/usr/myproduct/thisversion", and that would be |
1457
|
|
|
|
|
|
|
the "prefix". Under this directory, you would expect to find the |
1458
|
|
|
|
|
|
|
"src", "bin", "lib", and "etc" directories, as well as perhaps |
1459
|
|
|
|
|
|
|
"cgi-bin", "htdocs", and others. |
1460
|
|
|
|
|
|
|
|
1461
|
|
|
|
|
|
|
If the "prefix" option is not specified on the command line, |
1462
|
|
|
|
|
|
|
the $PREFIX environment variable is used. |
1463
|
|
|
|
|
|
|
|
1464
|
|
|
|
|
|
|
If that is not set, the $prog_dir with the trailing "/bin" or |
1465
|
|
|
|
|
|
|
"/cgi-bin" stripped off is used. |
1466
|
|
|
|
|
|
|
|
1467
|
|
|
|
|
|
|
=head2 Option Files |
1468
|
|
|
|
|
|
|
|
1469
|
|
|
|
|
|
|
Unless the "no_option_file" arg is specified to init(), the |
1470
|
|
|
|
|
|
|
next source of option values is the option files. |
1471
|
|
|
|
|
|
|
|
1472
|
|
|
|
|
|
|
By default, a cascading set of option files are all consulted |
1473
|
|
|
|
|
|
|
to allow individual users to specify values that override the |
1474
|
|
|
|
|
|
|
normal values for certain programs. Furthermore, the |
1475
|
|
|
|
|
|
|
values for individual programs can override the values configured |
1476
|
|
|
|
|
|
|
generally system-wide. |
1477
|
|
|
|
|
|
|
|
1478
|
|
|
|
|
|
|
The resulting value for an option variable comes from the first |
1479
|
|
|
|
|
|
|
place that it is ever seen. Subsequent mentions of the option |
1480
|
|
|
|
|
|
|
variable within the same or other option files will be ignored. |
1481
|
|
|
|
|
|
|
|
1482
|
|
|
|
|
|
|
The following files are consulted in order. |
1483
|
|
|
|
|
|
|
|
1484
|
|
|
|
|
|
|
$ENV{HOME}/.app/$app.conf |
1485
|
|
|
|
|
|
|
$ENV{HOME}/.app/app.conf |
1486
|
|
|
|
|
|
|
$prog_dir/$app.conf |
1487
|
|
|
|
|
|
|
$prog_dir/app.conf |
1488
|
|
|
|
|
|
|
$prefix/etc/app/$app.conf |
1489
|
|
|
|
|
|
|
$prefix/etc/app/app.conf |
1490
|
|
|
|
|
|
|
/etc/app/app.conf |
1491
|
|
|
|
|
|
|
|
1492
|
|
|
|
|
|
|
Thus, a system administrator might set up the $prefix/etc/app/app.conf |
1493
|
|
|
|
|
|
|
file with system-wide defaults. All option configuration could be done |
1494
|
|
|
|
|
|
|
in this single file, separating the relevant variables into different |
1495
|
|
|
|
|
|
|
sections for each different program to be configured. |
1496
|
|
|
|
|
|
|
|
1497
|
|
|
|
|
|
|
However, if the administrator decided that there were too many parameters |
1498
|
|
|
|
|
|
|
for a single program such that it cluttered this file, he might put the |
1499
|
|
|
|
|
|
|
option values for that program into the $prefix/etc/app/$app.conf file. |
1500
|
|
|
|
|
|
|
This distinction is a matter of preference, as both methods are equally |
1501
|
|
|
|
|
|
|
functional. |
1502
|
|
|
|
|
|
|
|
1503
|
|
|
|
|
|
|
A program developer may decide to override some of the system-wide |
1504
|
|
|
|
|
|
|
option values for everyone by putting option files in the program's own |
1505
|
|
|
|
|
|
|
directory. |
1506
|
|
|
|
|
|
|
|
1507
|
|
|
|
|
|
|
Furthermore, a user may decide to override some of the resulting |
1508
|
|
|
|
|
|
|
option values by putting some option files in the appropriate |
1509
|
|
|
|
|
|
|
place under his home directory. |
1510
|
|
|
|
|
|
|
|
1511
|
|
|
|
|
|
|
This separation of config files also allows for secure information |
1512
|
|
|
|
|
|
|
(such as database passwords) to be required to be provided in the |
1513
|
|
|
|
|
|
|
user's own (secured) option files rather than in read-only |
1514
|
|
|
|
|
|
|
system-wide option files. |
1515
|
|
|
|
|
|
|
|
1516
|
|
|
|
|
|
|
Specifying the "--debug_options" option on the command line will |
1517
|
|
|
|
|
|
|
assist in figuring out which files App::Options is looking at. |
1518
|
|
|
|
|
|
|
|
1519
|
|
|
|
|
|
|
=head2 Option File Format |
1520
|
|
|
|
|
|
|
|
1521
|
|
|
|
|
|
|
In general an option file takes the form of lines with "var = value". |
1522
|
|
|
|
|
|
|
|
1523
|
|
|
|
|
|
|
dbname = prod # this is the production database |
1524
|
|
|
|
|
|
|
dbuser = scott |
1525
|
|
|
|
|
|
|
dbpass = tiger |
1526
|
|
|
|
|
|
|
|
1527
|
|
|
|
|
|
|
Trailing comments (preceded by a "#") are trimmed off. |
1528
|
|
|
|
|
|
|
Spaces before and after the variable, and before and after the value |
1529
|
|
|
|
|
|
|
are all trimmed off. Then enclosing double-quotes (") are trimmed |
1530
|
|
|
|
|
|
|
off. Variables can be any of the characters in |
1531
|
|
|
|
|
|
|
[a-zA-Z0-9_.-]. Values can be any printable characters or the |
1532
|
|
|
|
|
|
|
empty string. Any lines which aren't recognizable as "var = value" |
1533
|
|
|
|
|
|
|
lines or section headers (see below) are ignored. |
1534
|
|
|
|
|
|
|
|
1535
|
|
|
|
|
|
|
If certain variables should be set only for certain programs (or |
1536
|
|
|
|
|
|
|
under certain other conditions), section headers may be introduced. |
1537
|
|
|
|
|
|
|
The special section headers "[ALL]" and "[]" specify the end of a |
1538
|
|
|
|
|
|
|
conditional section and the resumption of unconditional option |
1539
|
|
|
|
|
|
|
variables. |
1540
|
|
|
|
|
|
|
|
1541
|
|
|
|
|
|
|
[progtest] |
1542
|
|
|
|
|
|
|
dbname = test # this is the test database |
1543
|
|
|
|
|
|
|
[ALL] |
1544
|
|
|
|
|
|
|
dbname = prod # this is the production database |
1545
|
|
|
|
|
|
|
dbuser = scott |
1546
|
|
|
|
|
|
|
dbpass = tiger |
1547
|
|
|
|
|
|
|
|
1548
|
|
|
|
|
|
|
In this case, the "progtest" program will get "dbname = test" while |
1549
|
|
|
|
|
|
|
all other programs will get "dbname = prod". |
1550
|
|
|
|
|
|
|
|
1551
|
|
|
|
|
|
|
Note that you would not get the desired results if |
1552
|
|
|
|
|
|
|
the "dbname = prod" statement was above the "[progtest]" |
1553
|
|
|
|
|
|
|
header. Once an option variable is set, no other occurrence |
1554
|
|
|
|
|
|
|
of that variable in any option file will override it. |
1555
|
|
|
|
|
|
|
|
1556
|
|
|
|
|
|
|
For the special case where you want to specify a section for |
1557
|
|
|
|
|
|
|
only one variable as above, the following shortcut is provided. |
1558
|
|
|
|
|
|
|
|
1559
|
|
|
|
|
|
|
[progtest] dbname = test # this is the test database |
1560
|
|
|
|
|
|
|
dbname = prod # this is the production database |
1561
|
|
|
|
|
|
|
dbuser = scott |
1562
|
|
|
|
|
|
|
dbpass = tiger |
1563
|
|
|
|
|
|
|
|
1564
|
|
|
|
|
|
|
The "[progtest]" section header applied for only the single line. |
1565
|
|
|
|
|
|
|
|
1566
|
|
|
|
|
|
|
Furthermore, if it were desired to make this override for all |
1567
|
|
|
|
|
|
|
programs containing "test" in them, you would use the following |
1568
|
|
|
|
|
|
|
syntax. |
1569
|
|
|
|
|
|
|
|
1570
|
|
|
|
|
|
|
[/test/] dbname = test # this is the test database |
1571
|
|
|
|
|
|
|
dbname = prod # this is the production database |
1572
|
|
|
|
|
|
|
dbuser = scott |
1573
|
|
|
|
|
|
|
dbpass = tiger |
1574
|
|
|
|
|
|
|
|
1575
|
|
|
|
|
|
|
The "[/test/]" section header tested the "app" option using |
1576
|
|
|
|
|
|
|
an arbitrary regular expression. |
1577
|
|
|
|
|
|
|
|
1578
|
|
|
|
|
|
|
The section headers can create a condition for inclusion |
1579
|
|
|
|
|
|
|
based on any of the variables currently in the option |
1580
|
|
|
|
|
|
|
hash. In fact, "[progtest]" is just a synonym for |
1581
|
|
|
|
|
|
|
"[app=progtest]" and "[/test/]" is a synonym for "[app=/test/]". |
1582
|
|
|
|
|
|
|
|
1583
|
|
|
|
|
|
|
If, for instance, the usernames and passwords were different |
1584
|
|
|
|
|
|
|
for the different databases, you might have the following. |
1585
|
|
|
|
|
|
|
|
1586
|
|
|
|
|
|
|
[/test/] dbname = test # progs with "test" go to test database |
1587
|
|
|
|
|
|
|
dbname = prod # other progs go to the production database |
1588
|
|
|
|
|
|
|
[dbname=test] # progs |
1589
|
|
|
|
|
|
|
dbuser = scott |
1590
|
|
|
|
|
|
|
dbpass = tiger |
1591
|
|
|
|
|
|
|
[dbname=prod] |
1592
|
|
|
|
|
|
|
dbuser = mike |
1593
|
|
|
|
|
|
|
dbpass = leopard |
1594
|
|
|
|
|
|
|
|
1595
|
|
|
|
|
|
|
The conditions created by a section header may be the result of more |
1596
|
|
|
|
|
|
|
than a single condition. |
1597
|
|
|
|
|
|
|
|
1598
|
|
|
|
|
|
|
[dbname=test;dbuser=scott] |
1599
|
|
|
|
|
|
|
dbpass = tiger |
1600
|
|
|
|
|
|
|
[dbname=test;dbuser=ken] |
1601
|
|
|
|
|
|
|
dbpass = ocelot |
1602
|
|
|
|
|
|
|
[dbname=prod;dbuser=scott] |
1603
|
|
|
|
|
|
|
dbpass = tiger62 |
1604
|
|
|
|
|
|
|
[dbname=prod;dbuser=ken] |
1605
|
|
|
|
|
|
|
dbpass = 3.ocelot_ |
1606
|
|
|
|
|
|
|
|
1607
|
|
|
|
|
|
|
Any number of conditions can be included with semicolons separating |
1608
|
|
|
|
|
|
|
them. |
1609
|
|
|
|
|
|
|
|
1610
|
|
|
|
|
|
|
Each time a variable/value pair is found in an option file, |
1611
|
|
|
|
|
|
|
it is only included in the option hash if that variable is |
1612
|
|
|
|
|
|
|
currently not defined in the option hash. Therefore, option |
1613
|
|
|
|
|
|
|
files never override command line parameters. |
1614
|
|
|
|
|
|
|
|
1615
|
|
|
|
|
|
|
=head2 Option Environment Variables and Variable Substitution |
1616
|
|
|
|
|
|
|
|
1617
|
|
|
|
|
|
|
For each variable/value pair that is to be inserted into the |
1618
|
|
|
|
|
|
|
option hash from the option files, the corresponding environment |
1619
|
|
|
|
|
|
|
variables are searched to see if they are defined. The environment |
1620
|
|
|
|
|
|
|
always overrides an option file value. (If the |
1621
|
|
|
|
|
|
|
"no_env_vars" arg was given to the init() method, this whole |
1622
|
|
|
|
|
|
|
step of checking the environment is skipped.) |
1623
|
|
|
|
|
|
|
|
1624
|
|
|
|
|
|
|
By default, the environment variable for an option variable named |
1625
|
|
|
|
|
|
|
"dbuser" would be "APP_DBUSER". However, if the "env" attribute |
1626
|
|
|
|
|
|
|
of the "dbuser" option is set, a different environment variable |
1627
|
|
|
|
|
|
|
may be checked instead (see the Tutorial below for examples). |
1628
|
|
|
|
|
|
|
|
1629
|
|
|
|
|
|
|
After checking the environment for override values, |
1630
|
|
|
|
|
|
|
any value which includes a variable undergoes variable substitution |
1631
|
|
|
|
|
|
|
before it is placed in the option hash. |
1632
|
|
|
|
|
|
|
|
1633
|
|
|
|
|
|
|
=head2 Setting Environment Variables from Option Files |
1634
|
|
|
|
|
|
|
|
1635
|
|
|
|
|
|
|
Any variable of the form "ENV{XYZ}" will set the variable XYZ in |
1636
|
|
|
|
|
|
|
the environment rather than in the options hash. Thus, the syntax |
1637
|
|
|
|
|
|
|
|
1638
|
|
|
|
|
|
|
ENV{LD_LIBRARY_PATH} = ${prefix}/lib |
1639
|
|
|
|
|
|
|
|
1640
|
|
|
|
|
|
|
will enhance the LD_LIBRARY_PATH appropriately. |
1641
|
|
|
|
|
|
|
|
1642
|
|
|
|
|
|
|
Note that this only works for options set in an options file. |
1643
|
|
|
|
|
|
|
It does not work for options set on the command line, from the |
1644
|
|
|
|
|
|
|
environment itself, or from the program-supplied default. |
1645
|
|
|
|
|
|
|
|
1646
|
|
|
|
|
|
|
Under some circumstances, the perl interpreter will |
1647
|
|
|
|
|
|
|
need to be restarted in order to pick up the new LD_LIBRARY_PATH. |
1648
|
|
|
|
|
|
|
In that case, you can include the special option |
1649
|
|
|
|
|
|
|
|
1650
|
|
|
|
|
|
|
perl_restart = 1 |
1651
|
|
|
|
|
|
|
|
1652
|
|
|
|
|
|
|
An example of where this might be useful is for CGI scripts that |
1653
|
|
|
|
|
|
|
use the DBI and DBD::Oracle because the Oracle libraries are |
1654
|
|
|
|
|
|
|
dynamically linked at runtime. |
1655
|
|
|
|
|
|
|
|
1656
|
|
|
|
|
|
|
NOTE: The other standard way to handle CGI scripts which require special |
1657
|
|
|
|
|
|
|
environment variables to be set is with Apache directives in the |
1658
|
|
|
|
|
|
|
httpd.conf or .htaccess files. i.e. |
1659
|
|
|
|
|
|
|
|
1660
|
|
|
|
|
|
|
SetEnv LD_LIBRARY_PATH /home/oracle/oracle/product/10.2.0/oraclient/lib |
1661
|
|
|
|
|
|
|
SetEnv ORACLE_HOME /home/oracle/oracle/product/10.2.0/oraclient |
1662
|
|
|
|
|
|
|
|
1663
|
|
|
|
|
|
|
NOTE: Yet another standard way to handle CGI scripts which require |
1664
|
|
|
|
|
|
|
an enhanced LD_LIBRARY_PATH specifically is to use the /etc/ld.so.conf |
1665
|
|
|
|
|
|
|
file. Edit /etc/ld.so.conf and then run ldconfig (as root). |
1666
|
|
|
|
|
|
|
This adds your specific path to the "standard system places" that |
1667
|
|
|
|
|
|
|
are searched for shared libraries. This has nothing to do with |
1668
|
|
|
|
|
|
|
App::Options or environment variables of course. |
1669
|
|
|
|
|
|
|
|
1670
|
|
|
|
|
|
|
=head2 import and flush_imports |
1671
|
|
|
|
|
|
|
|
1672
|
|
|
|
|
|
|
After each option file is read, the special option "flush_imports" |
1673
|
|
|
|
|
|
|
is checked. If set, the list of pending option files to be |
1674
|
|
|
|
|
|
|
parsed is cleared, and the flush_imports option is also cleared. |
1675
|
|
|
|
|
|
|
|
1676
|
|
|
|
|
|
|
This is useful if you do not want to inherit any of the option |
1677
|
|
|
|
|
|
|
values defined in system-wide option files. |
1678
|
|
|
|
|
|
|
|
1679
|
|
|
|
|
|
|
The special option "import" is checked next. If it is set, it is |
1680
|
|
|
|
|
|
|
understood to be a list of option files (separated by /[,; ]+/) |
1681
|
|
|
|
|
|
|
to be prepended to the list of pending option files. |
1682
|
|
|
|
|
|
|
The import option itself is cleared. |
1683
|
|
|
|
|
|
|
|
1684
|
|
|
|
|
|
|
=head2 Other Environment Variables and Defaults |
1685
|
|
|
|
|
|
|
|
1686
|
|
|
|
|
|
|
After command line options and option files have been parsed, |
1687
|
|
|
|
|
|
|
all of the other options which are known to the program are |
1688
|
|
|
|
|
|
|
checked for environment variables and defaults. |
1689
|
|
|
|
|
|
|
|
1690
|
|
|
|
|
|
|
Options can be defined for the program with either the |
1691
|
|
|
|
|
|
|
"options" arg or the "option" arg to the init() method |
1692
|
|
|
|
|
|
|
(or a combination of both). |
1693
|
|
|
|
|
|
|
|
1694
|
|
|
|
|
|
|
use App::Options ( |
1695
|
|
|
|
|
|
|
options => [ "dbname", "dbuser", "dbpass" ], |
1696
|
|
|
|
|
|
|
option => { |
1697
|
|
|
|
|
|
|
dbname => { |
1698
|
|
|
|
|
|
|
env => "DBNAME", |
1699
|
|
|
|
|
|
|
default => "devel", |
1700
|
|
|
|
|
|
|
}, |
1701
|
|
|
|
|
|
|
dbuser => { |
1702
|
|
|
|
|
|
|
env => "DBUSER;DBI_USER", |
1703
|
|
|
|
|
|
|
}, |
1704
|
|
|
|
|
|
|
dbpass => { |
1705
|
|
|
|
|
|
|
env => "", # password in %ENV is security breach |
1706
|
|
|
|
|
|
|
}, |
1707
|
|
|
|
|
|
|
}, |
1708
|
|
|
|
|
|
|
); |
1709
|
|
|
|
|
|
|
|
1710
|
|
|
|
|
|
|
For each option variable known, if the value is not already set, |
1711
|
|
|
|
|
|
|
then the environment is checked, the default is checked, variable |
1712
|
|
|
|
|
|
|
expansion is performed, and the value is entered into the |
1713
|
|
|
|
|
|
|
option hash. |
1714
|
|
|
|
|
|
|
|
1715
|
|
|
|
|
|
|
=head2 Special Option prefix |
1716
|
|
|
|
|
|
|
|
1717
|
|
|
|
|
|
|
The special option "prefix" is reconciled and finalized next. |
1718
|
|
|
|
|
|
|
|
1719
|
|
|
|
|
|
|
Unless it was specified on the command line, the original "prefix" |
1720
|
|
|
|
|
|
|
was autodetected. This may have resulted in a path which was |
1721
|
|
|
|
|
|
|
technically correct but was different than intended due to |
1722
|
|
|
|
|
|
|
symbolic linking on the file system. |
1723
|
|
|
|
|
|
|
|
1724
|
|
|
|
|
|
|
Since the "prefix" variable may also be set in an option file, |
1725
|
|
|
|
|
|
|
there may be a difference between the auto-detected "prefix" |
1726
|
|
|
|
|
|
|
and the option file "prefix". If this case occurs, the |
1727
|
|
|
|
|
|
|
option file "prefix" is the one that is accepted as authoritative. |
1728
|
|
|
|
|
|
|
|
1729
|
|
|
|
|
|
|
=head2 Special Option perlinc |
1730
|
|
|
|
|
|
|
|
1731
|
|
|
|
|
|
|
One of the primary design goals of App::Options was to be able |
1732
|
|
|
|
|
|
|
to support multiple installations of software on a single machine. |
1733
|
|
|
|
|
|
|
|
1734
|
|
|
|
|
|
|
Thus, you might have different versions of software installed |
1735
|
|
|
|
|
|
|
under various directories such as |
1736
|
|
|
|
|
|
|
|
1737
|
|
|
|
|
|
|
/usr/product1/1.0.0 |
1738
|
|
|
|
|
|
|
/usr/product1/1.1.0 |
1739
|
|
|
|
|
|
|
/usr/product1/2.1.5 |
1740
|
|
|
|
|
|
|
|
1741
|
|
|
|
|
|
|
Naturally, slightly different versions of your perl modules will |
1742
|
|
|
|
|
|
|
be installed under each different "prefix" directory. |
1743
|
|
|
|
|
|
|
When a program runs from /usr/product1/1.1.0/bin, the "prefix" |
1744
|
|
|
|
|
|
|
will by "/usr/product1/1.1.0" and we want the @INC variable to |
1745
|
|
|
|
|
|
|
be modified so that the appropriate perl modules are included |
1746
|
|
|
|
|
|
|
from $prefix/lib/*. |
1747
|
|
|
|
|
|
|
|
1748
|
|
|
|
|
|
|
This is where the "perlinc" option comes in. |
1749
|
|
|
|
|
|
|
|
1750
|
|
|
|
|
|
|
If "perlinc" is set, it is understood to be a list of paths |
1751
|
|
|
|
|
|
|
(separated by /[ ,;]+/) to be prepended to the @INC variable. |
1752
|
|
|
|
|
|
|
|
1753
|
|
|
|
|
|
|
If "perlinc" is not set, |
1754
|
|
|
|
|
|
|
"$prefix/lib/perl5/$perlversion" and |
1755
|
|
|
|
|
|
|
"$prefix/lib/perl5/site_perl/$perlversion" are automatically |
1756
|
|
|
|
|
|
|
prepended to the @INC variable as a best guess. |
1757
|
|
|
|
|
|
|
|
1758
|
|
|
|
|
|
|
=head2 Special Option debug_options |
1759
|
|
|
|
|
|
|
|
1760
|
|
|
|
|
|
|
If the "debug_options" variable is set (often on the command |
1761
|
|
|
|
|
|
|
line), the list of option files that was searched is printed |
1762
|
|
|
|
|
|
|
out, the resulting list of variable values is printed out, |
1763
|
|
|
|
|
|
|
and the resulting list of include directories (@INC) is printed |
1764
|
|
|
|
|
|
|
out. |
1765
|
|
|
|
|
|
|
|
1766
|
|
|
|
|
|
|
=head2 Version |
1767
|
|
|
|
|
|
|
|
1768
|
|
|
|
|
|
|
After all values have been parsed, various conditions are |
1769
|
|
|
|
|
|
|
checked to see if the program should print diagnostic information |
1770
|
|
|
|
|
|
|
rather than continue running. Two of these examples are --version |
1771
|
|
|
|
|
|
|
and --help. |
1772
|
|
|
|
|
|
|
|
1773
|
|
|
|
|
|
|
If the "--version" option is set on the command line, |
1774
|
|
|
|
|
|
|
the version information for all loaded modules is printed, |
1775
|
|
|
|
|
|
|
and the program is exited. (The version of a package/module is |
1776
|
|
|
|
|
|
|
assumed to be the value of the $VERSION variable in that package. |
1777
|
|
|
|
|
|
|
i.e. The version of the XYZ::Foo package is $XYZ::Foo::VERSION.) |
1778
|
|
|
|
|
|
|
|
1779
|
|
|
|
|
|
|
prog --version |
1780
|
|
|
|
|
|
|
|
1781
|
|
|
|
|
|
|
Of course, this is all done implicitly in the BEGIN block (during |
1782
|
|
|
|
|
|
|
"use App::Options;"). If your program tried to set |
1783
|
|
|
|
|
|
|
$main::VERSION, it may not be set unless it is set explicitly |
1784
|
|
|
|
|
|
|
in the BEGIN block. |
1785
|
|
|
|
|
|
|
|
1786
|
|
|
|
|
|
|
#!/usr/bin/perl |
1787
|
|
|
|
|
|
|
BEGIN { |
1788
|
|
|
|
|
|
|
$VERSION = "1.12"; |
1789
|
|
|
|
|
|
|
} |
1790
|
|
|
|
|
|
|
use App::Options; |
1791
|
|
|
|
|
|
|
|
1792
|
|
|
|
|
|
|
This can be integrated with CVS file versioning using something |
1793
|
|
|
|
|
|
|
like the following. |
1794
|
|
|
|
|
|
|
|
1795
|
|
|
|
|
|
|
#!/usr/bin/perl |
1796
|
|
|
|
|
|
|
BEGIN { |
1797
|
|
|
|
|
|
|
$VERSION = do { my @r=(q$Revision: 14478 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r}; |
1798
|
|
|
|
|
|
|
} |
1799
|
|
|
|
|
|
|
use App::Options; |
1800
|
|
|
|
|
|
|
|
1801
|
|
|
|
|
|
|
Furthermore, the version information about some modules that you |
1802
|
|
|
|
|
|
|
might expect to have seen will not be printed because those modules |
1803
|
|
|
|
|
|
|
have not yet been loaded. To fix this, use the --version_packages |
1804
|
|
|
|
|
|
|
option (or set it in an option file). This option contains a |
1805
|
|
|
|
|
|
|
comma-separated list of modules and/or module regular expressions. |
1806
|
|
|
|
|
|
|
The modules are loaded, and the version information from all |
1807
|
|
|
|
|
|
|
resulting packages that match any of the patterns is printed. |
1808
|
|
|
|
|
|
|
|
1809
|
|
|
|
|
|
|
prog --version --version_packages=CGI |
1810
|
|
|
|
|
|
|
prog --version --version_packages=CGI,Template |
1811
|
|
|
|
|
|
|
|
1812
|
|
|
|
|
|
|
This also cuts down on the miscellaneous |
1813
|
|
|
|
|
|
|
modules (and pragmas) which might have cluttered up your view |
1814
|
|
|
|
|
|
|
of the version information you were interested in. |
1815
|
|
|
|
|
|
|
If you really wish to see version information for all |
1816
|
|
|
|
|
|
|
modules, use the --version=all option. |
1817
|
|
|
|
|
|
|
|
1818
|
|
|
|
|
|
|
prog --version=all --version_packages=CGI,Template |
1819
|
|
|
|
|
|
|
|
1820
|
|
|
|
|
|
|
=head2 Help and Validations |
1821
|
|
|
|
|
|
|
|
1822
|
|
|
|
|
|
|
If the "-?" or "--help" options were set on the command line, |
1823
|
|
|
|
|
|
|
the usage statement is printed, and the program is exited. |
1824
|
|
|
|
|
|
|
|
1825
|
|
|
|
|
|
|
Then each of the options which is defined may be validated. |
1826
|
|
|
|
|
|
|
|
1827
|
|
|
|
|
|
|
If an option is designated as "required", its value must be |
1828
|
|
|
|
|
|
|
defined somewhere (although it may be the empty string). |
1829
|
|
|
|
|
|
|
(If it is also required to be a non-empty string, a regex |
1830
|
|
|
|
|
|
|
may be provided for the type, i.e. type => "/./".) |
1831
|
|
|
|
|
|
|
|
1832
|
|
|
|
|
|
|
If an option is designated as having a "type", its value |
1833
|
|
|
|
|
|
|
must either be undefined or match a specific regular expression. |
1834
|
|
|
|
|
|
|
|
1835
|
|
|
|
|
|
|
Type Regular Expression |
1836
|
|
|
|
|
|
|
========= ========================================= |
1837
|
|
|
|
|
|
|
string (any) |
1838
|
|
|
|
|
|
|
integer /^-?[0-9_]+$/ |
1839
|
|
|
|
|
|
|
float /^-?[0-9_]+\.?[0-9_]*([eE][+-]?[0-9_]+)?$/ |
1840
|
|
|
|
|
|
|
(or) /^-?\.[0-9_]+([eE][+-]?[0-9_]+)?$/ |
1841
|
|
|
|
|
|
|
boolean /^[01]$/ |
1842
|
|
|
|
|
|
|
date /^[0-9]{4}-[01][0-9]-[0-3][0-9]$/ |
1843
|
|
|
|
|
|
|
datetime /^[0-9]{4}-[01][0-9]-[0-3][0-9] [0-2][0-9]:[0-5][0-9]:[0-5][0-9]$/ |
1844
|
|
|
|
|
|
|
time /^[0-2][0-9]:[0-5][0-9]:[0-5][0-9]$/ |
1845
|
|
|
|
|
|
|
/regexp/ /regexp/ |
1846
|
|
|
|
|
|
|
|
1847
|
|
|
|
|
|
|
Note that an arbitrary regular expression may be designated |
1848
|
|
|
|
|
|
|
as the "type" by enclosing it in slashes (i.e. "/^[YN]$/"). |
1849
|
|
|
|
|
|
|
|
1850
|
|
|
|
|
|
|
If the options fail any of the "required" or "type" validation |
1851
|
|
|
|
|
|
|
tests, the App::Options::print_usage() function is called |
1852
|
|
|
|
|
|
|
to print out a usage statement and the program is exited. |
1853
|
|
|
|
|
|
|
|
1854
|
|
|
|
|
|
|
=head1 USAGE TUTORIAL |
1855
|
|
|
|
|
|
|
|
1856
|
|
|
|
|
|
|
=head2 Getting Started |
1857
|
|
|
|
|
|
|
|
1858
|
|
|
|
|
|
|
Create a perl program called "demo1". |
1859
|
|
|
|
|
|
|
|
1860
|
|
|
|
|
|
|
#!/usr/bin/perl |
1861
|
|
|
|
|
|
|
use App::Options; |
1862
|
|
|
|
|
|
|
print "Wow. Here are the options...\n"; |
1863
|
|
|
|
|
|
|
foreach (sort keys %App::options) { # options appear here! |
1864
|
|
|
|
|
|
|
printf("%-20s => %s\n", $_, $App::options{$_}); |
1865
|
|
|
|
|
|
|
} |
1866
|
|
|
|
|
|
|
|
1867
|
|
|
|
|
|
|
Run it different kinds of ways to see how it responds. |
1868
|
|
|
|
|
|
|
|
1869
|
|
|
|
|
|
|
demo1 |
1870
|
|
|
|
|
|
|
demo1 -x |
1871
|
|
|
|
|
|
|
demo1 -x --verbose |
1872
|
|
|
|
|
|
|
demo1 --x -verbose |
1873
|
|
|
|
|
|
|
demo1 -x=5 --verbose=10 --foo=bar |
1874
|
|
|
|
|
|
|
demo1 --help |
1875
|
|
|
|
|
|
|
demo1 -x=8 --help |
1876
|
|
|
|
|
|
|
demo1 -? |
1877
|
|
|
|
|
|
|
demo1 --debug_options -? |
1878
|
|
|
|
|
|
|
demo1 -x=5 --verbose=10 --foo=bar --debug_options -? |
1879
|
|
|
|
|
|
|
|
1880
|
|
|
|
|
|
|
demo1 --version |
1881
|
|
|
|
|
|
|
demo1 --version --version_packages=CGI |
1882
|
|
|
|
|
|
|
|
1883
|
|
|
|
|
|
|
Now create a copy of the program. |
1884
|
|
|
|
|
|
|
|
1885
|
|
|
|
|
|
|
cp demo1 demo2 |
1886
|
|
|
|
|
|
|
|
1887
|
|
|
|
|
|
|
Start putting entries like the following |
1888
|
|
|
|
|
|
|
|
1889
|
|
|
|
|
|
|
x = 7 |
1890
|
|
|
|
|
|
|
hello = world |
1891
|
|
|
|
|
|
|
[demo2] |
1892
|
|
|
|
|
|
|
verbose=3 |
1893
|
|
|
|
|
|
|
[/demo/] |
1894
|
|
|
|
|
|
|
baz = foo |
1895
|
|
|
|
|
|
|
|
1896
|
|
|
|
|
|
|
in the following files |
1897
|
|
|
|
|
|
|
|
1898
|
|
|
|
|
|
|
$HOME/.app/demo1.conf |
1899
|
|
|
|
|
|
|
$HOME/.app/demo2.conf |
1900
|
|
|
|
|
|
|
$HOME/.app/app.conf |
1901
|
|
|
|
|
|
|
demo1.conf (same directory as the demo* programs) |
1902
|
|
|
|
|
|
|
demo2.conf (same directory as the demo* programs) |
1903
|
|
|
|
|
|
|
app.conf (same directory as the demo* programs) |
1904
|
|
|
|
|
|
|
$PREFIX/etc/app/demo1.conf |
1905
|
|
|
|
|
|
|
$PREFIX/etc/app/demo2.conf |
1906
|
|
|
|
|
|
|
$PREFIX/etc/app/app.conf |
1907
|
|
|
|
|
|
|
/etc/app/app.conf |
1908
|
|
|
|
|
|
|
|
1909
|
|
|
|
|
|
|
and see how the programs respond in each different case. |
1910
|
|
|
|
|
|
|
|
1911
|
|
|
|
|
|
|
Next set environment variables like the following and |
1912
|
|
|
|
|
|
|
see how the programs respond. |
1913
|
|
|
|
|
|
|
|
1914
|
|
|
|
|
|
|
export APP_X=14 |
1915
|
|
|
|
|
|
|
export APP_VERBOSE=7 |
1916
|
|
|
|
|
|
|
export APP_FOO=xyzzy |
1917
|
|
|
|
|
|
|
export APP_HELLO=Plugh! |
1918
|
|
|
|
|
|
|
|
1919
|
|
|
|
|
|
|
You are well on your way. |
1920
|
|
|
|
|
|
|
|
1921
|
|
|
|
|
|
|
=head2 A Development Scenario |
1922
|
|
|
|
|
|
|
|
1923
|
|
|
|
|
|
|
Now let's imagine that we are writing a suite of programs which operate |
1924
|
|
|
|
|
|
|
on a relational database. These programs are part of a larger |
1925
|
|
|
|
|
|
|
system which goes through a development cycle of development, |
1926
|
|
|
|
|
|
|
test, and production. Each step in the development cycle, the |
1927
|
|
|
|
|
|
|
programs will run against different databases, but we don't want |
1928
|
|
|
|
|
|
|
that to affect the code. |
1929
|
|
|
|
|
|
|
|
1930
|
|
|
|
|
|
|
Let's suppose that we write a program which lists the customers |
1931
|
|
|
|
|
|
|
in a customer table. |
1932
|
|
|
|
|
|
|
|
1933
|
|
|
|
|
|
|
create table person ( |
1934
|
|
|
|
|
|
|
person_id integer not null auto_increment primary key, |
1935
|
|
|
|
|
|
|
first_name varchar(99) null, |
1936
|
|
|
|
|
|
|
last_name varchar(99) null, |
1937
|
|
|
|
|
|
|
birth_dt date null, |
1938
|
|
|
|
|
|
|
company_id integer null, |
1939
|
|
|
|
|
|
|
wholesale_ind char(1) null, |
1940
|
|
|
|
|
|
|
change_dttm datetime not null, |
1941
|
|
|
|
|
|
|
); |
1942
|
|
|
|
|
|
|
|
1943
|
|
|
|
|
|
|
We call this program "listcust". |
1944
|
|
|
|
|
|
|
|
1945
|
|
|
|
|
|
|
#!/usr/bin/perl -e |
1946
|
|
|
|
|
|
|
use strict; |
1947
|
|
|
|
|
|
|
use App::Options; |
1948
|
|
|
|
|
|
|
use DBI; |
1949
|
|
|
|
|
|
|
my $dsn = "dbi:$App::options{dbdriver}:database=$App::options{dbname}"; |
1950
|
|
|
|
|
|
|
my $dbh = DBI->connect($dsn, $App::options{dbuser}, $App::options{dbpass}); |
1951
|
|
|
|
|
|
|
my $sql = "select first_name, last_name, birth_dt, company_id, wholesale_ind, change_dttm from person"; |
1952
|
|
|
|
|
|
|
my $cust = $dbh->selectall_arrayref($sql); |
1953
|
|
|
|
|
|
|
foreach my $row (@$cust) { |
1954
|
|
|
|
|
|
|
printf("%-24 %-24 %s %9d %s\n", @$row); |
1955
|
|
|
|
|
|
|
} |
1956
|
|
|
|
|
|
|
$dbh->disconnect(); |
1957
|
|
|
|
|
|
|
|
1958
|
|
|
|
|
|
|
Then you can invoke this program with all of the command line options |
1959
|
|
|
|
|
|
|
and everything works fine. |
1960
|
|
|
|
|
|
|
|
1961
|
|
|
|
|
|
|
listcust --dbdriver=mysql --dbname=prod --dbuser=scott --dbpass=tiger |
1962
|
|
|
|
|
|
|
|
1963
|
|
|
|
|
|
|
However, if you don't use all of the options, you will get a DBI error. |
1964
|
|
|
|
|
|
|
Furthermore, "listcust --help" doesn't help very much. A system administrator |
1965
|
|
|
|
|
|
|
confronting this problem would put the following lines into |
1966
|
|
|
|
|
|
|
"$PREFIX/etc/app/app.conf" or "$PREFIX/etc/app/listcust.conf". |
1967
|
|
|
|
|
|
|
|
1968
|
|
|
|
|
|
|
dbdriver = mysql |
1969
|
|
|
|
|
|
|
dbname = prod |
1970
|
|
|
|
|
|
|
dbuser = scott |
1971
|
|
|
|
|
|
|
dbpass = tiger |
1972
|
|
|
|
|
|
|
|
1973
|
|
|
|
|
|
|
If, however, your projects were not in the habit of using the |
1974
|
|
|
|
|
|
|
PREFIX environment variable and the program is not installed in |
1975
|
|
|
|
|
|
|
$PREFIX/bin, he would have to put the above lines |
1976
|
|
|
|
|
|
|
in either the "app.conf" file or the "listcust.conf" file |
1977
|
|
|
|
|
|
|
in the same directory as "listcust" or in the global |
1978
|
|
|
|
|
|
|
"/etc/app/app.conf" option file. |
1979
|
|
|
|
|
|
|
|
1980
|
|
|
|
|
|
|
A user (without privileges to the "$PREFIX/etc/app" directory |
1981
|
|
|
|
|
|
|
or the directory in which "listcust" lives) would have to put |
1982
|
|
|
|
|
|
|
the described lines into "$HOME/.app/app.conf" or |
1983
|
|
|
|
|
|
|
"$HOME/.app/listcust.conf". |
1984
|
|
|
|
|
|
|
|
1985
|
|
|
|
|
|
|
Putting the options in any of those files would make "--help" |
1986
|
|
|
|
|
|
|
print something intelligent. |
1987
|
|
|
|
|
|
|
|
1988
|
|
|
|
|
|
|
A developer, however, might decide that the program should |
1989
|
|
|
|
|
|
|
have some defaults. |
1990
|
|
|
|
|
|
|
|
1991
|
|
|
|
|
|
|
use App::Options ( |
1992
|
|
|
|
|
|
|
option => { |
1993
|
|
|
|
|
|
|
dbdriver => "mysql", |
1994
|
|
|
|
|
|
|
dbname => "prod", |
1995
|
|
|
|
|
|
|
dbuser => "scott", |
1996
|
|
|
|
|
|
|
dbpass => "tiger", |
1997
|
|
|
|
|
|
|
}, |
1998
|
|
|
|
|
|
|
); |
1999
|
|
|
|
|
|
|
|
2000
|
|
|
|
|
|
|
(This supplies defaults and also makes "--help" print something |
2001
|
|
|
|
|
|
|
intelligent, regardless of whether there are any configuration |
2002
|
|
|
|
|
|
|
files.) |
2003
|
|
|
|
|
|
|
|
2004
|
|
|
|
|
|
|
If all you wanted to do was provide defaults for options, |
2005
|
|
|
|
|
|
|
this format would be fine. However, there are other useful |
2006
|
|
|
|
|
|
|
attributes of an option besides just the "default". |
2007
|
|
|
|
|
|
|
To use those, you generally would use the more complete form |
2008
|
|
|
|
|
|
|
of the "option" arg. |
2009
|
|
|
|
|
|
|
|
2010
|
|
|
|
|
|
|
use App::Options ( |
2011
|
|
|
|
|
|
|
option => { |
2012
|
|
|
|
|
|
|
dbdriver => { default => "mysql", }, |
2013
|
|
|
|
|
|
|
dbname => { default => "prod", }, |
2014
|
|
|
|
|
|
|
dbuser => { default => "scott", }, |
2015
|
|
|
|
|
|
|
dbpass => { default => "tiger", }, |
2016
|
|
|
|
|
|
|
}, |
2017
|
|
|
|
|
|
|
); |
2018
|
|
|
|
|
|
|
|
2019
|
|
|
|
|
|
|
Then we can indicate that these options are all required. |
2020
|
|
|
|
|
|
|
If they are not provided, the program will not run. |
2021
|
|
|
|
|
|
|
|
2022
|
|
|
|
|
|
|
Meanwhile, it makes no sense to provide a "default" for a |
2023
|
|
|
|
|
|
|
password. We can remove the default, but if we ever tried to run |
2024
|
|
|
|
|
|
|
the program without providing the password, it would not get |
2025
|
|
|
|
|
|
|
past printing a "usage" statement. |
2026
|
|
|
|
|
|
|
|
2027
|
|
|
|
|
|
|
use App::Options ( |
2028
|
|
|
|
|
|
|
option => { |
2029
|
|
|
|
|
|
|
dbdriver => { required => 1, default => "mysql", }, |
2030
|
|
|
|
|
|
|
dbname => { required => 1, default => "prod", }, |
2031
|
|
|
|
|
|
|
dbuser => { required => 1, default => "scott", }, |
2032
|
|
|
|
|
|
|
dbpass => { required => 1, }, |
2033
|
|
|
|
|
|
|
}, |
2034
|
|
|
|
|
|
|
); |
2035
|
|
|
|
|
|
|
|
2036
|
|
|
|
|
|
|
We now might enhance the code in order to list only the |
2037
|
|
|
|
|
|
|
customers which had certain attributes. |
2038
|
|
|
|
|
|
|
|
2039
|
|
|
|
|
|
|
my $sql = "select first_name, last_name, birth_dt, company_id, wholesale_ind, change_dttm from person"; |
2040
|
|
|
|
|
|
|
my (@where); |
2041
|
|
|
|
|
|
|
push(@where, "first_name like '%$App::options{first_name}%'") |
2042
|
|
|
|
|
|
|
if ($App::options{first_name}); |
2043
|
|
|
|
|
|
|
push(@where, "last_name like '%$App::options{last_name}%'") |
2044
|
|
|
|
|
|
|
if ($App::options{last_name}); |
2045
|
|
|
|
|
|
|
push(@where, "birth_dt = '$App::options{birth_dt}'") |
2046
|
|
|
|
|
|
|
if ($App::options{birth_dt}); |
2047
|
|
|
|
|
|
|
push(@where, "company_id = $App::options{company_id}") |
2048
|
|
|
|
|
|
|
if ($App::options{company_id}); |
2049
|
|
|
|
|
|
|
push(@where, "wholesale_ind = '$App::options{wholesale_ind}'") |
2050
|
|
|
|
|
|
|
if ($App::options{wholesale_ind}); |
2051
|
|
|
|
|
|
|
push(@where, "change_dttm >= '$App::options{change_dttm}'") |
2052
|
|
|
|
|
|
|
if ($App::options{change_dttm}); |
2053
|
|
|
|
|
|
|
if ($#where > -1) { |
2054
|
|
|
|
|
|
|
$sql .= "\nwhere " . join("\n and ", @where) . "\n"; |
2055
|
|
|
|
|
|
|
} |
2056
|
|
|
|
|
|
|
my $cust = $dbh->selectall_arrayref($sql); |
2057
|
|
|
|
|
|
|
|
2058
|
|
|
|
|
|
|
The init() method call might be enhanced to look like this. |
2059
|
|
|
|
|
|
|
Also, the order that the options are printed by "--help" can |
2060
|
|
|
|
|
|
|
be set with the "options" argument. (Otherwise, they would |
2061
|
|
|
|
|
|
|
print in alphabetical order.) |
2062
|
|
|
|
|
|
|
|
2063
|
|
|
|
|
|
|
use App::Options ( |
2064
|
|
|
|
|
|
|
options => [ "dbdriver", "dbname", "dbuser", "dbpass", |
2065
|
|
|
|
|
|
|
"first_name", "last_name", "birth_dt", "company_id", |
2066
|
|
|
|
|
|
|
"wholesale_ind", "change_dttm", |
2067
|
|
|
|
|
|
|
], |
2068
|
|
|
|
|
|
|
option => { |
2069
|
|
|
|
|
|
|
dbdriver => { |
2070
|
|
|
|
|
|
|
description => "dbi driver name", |
2071
|
|
|
|
|
|
|
default => "mysql", |
2072
|
|
|
|
|
|
|
env => "DBDRIVER", # use a different env variable |
2073
|
|
|
|
|
|
|
required => 1, |
2074
|
|
|
|
|
|
|
}, |
2075
|
|
|
|
|
|
|
dbname => { |
2076
|
|
|
|
|
|
|
description => "database name", |
2077
|
|
|
|
|
|
|
default => "prod", |
2078
|
|
|
|
|
|
|
env => "DBNAME", # use a different env variable |
2079
|
|
|
|
|
|
|
required => 1, |
2080
|
|
|
|
|
|
|
}, |
2081
|
|
|
|
|
|
|
dbuser => { |
2082
|
|
|
|
|
|
|
description => "database user", |
2083
|
|
|
|
|
|
|
default => "scott", |
2084
|
|
|
|
|
|
|
env => "DBUSER;DBI_USER", # check both |
2085
|
|
|
|
|
|
|
required => 1, |
2086
|
|
|
|
|
|
|
}, |
2087
|
|
|
|
|
|
|
dbpass => { |
2088
|
|
|
|
|
|
|
description => "database password", |
2089
|
|
|
|
|
|
|
env => "", # disable env for password (insecure) |
2090
|
|
|
|
|
|
|
required => 1, |
2091
|
|
|
|
|
|
|
secure => 1, # FYI. This is inferred by the fact that "dbpass" |
2092
|
|
|
|
|
|
|
# ends in "pass", so it is not necessary. |
2093
|
|
|
|
|
|
|
}, |
2094
|
|
|
|
|
|
|
first_name => { |
2095
|
|
|
|
|
|
|
description => "portion of customer's first name", |
2096
|
|
|
|
|
|
|
}, |
2097
|
|
|
|
|
|
|
last_name => { |
2098
|
|
|
|
|
|
|
description => "portion of customer's last name", |
2099
|
|
|
|
|
|
|
}, |
2100
|
|
|
|
|
|
|
birth_dt => { |
2101
|
|
|
|
|
|
|
description => "customer's birth date", |
2102
|
|
|
|
|
|
|
type => "date", |
2103
|
|
|
|
|
|
|
}, |
2104
|
|
|
|
|
|
|
company_id => { |
2105
|
|
|
|
|
|
|
description => "customer's company ID", |
2106
|
|
|
|
|
|
|
type => "integer", |
2107
|
|
|
|
|
|
|
}, |
2108
|
|
|
|
|
|
|
wholesale_ind => { |
2109
|
|
|
|
|
|
|
description => "indicator of wholesale customer", |
2110
|
|
|
|
|
|
|
type => "/^[YN]$/", |
2111
|
|
|
|
|
|
|
}, |
2112
|
|
|
|
|
|
|
change_dttm => { |
2113
|
|
|
|
|
|
|
description => "changed-since date/time", |
2114
|
|
|
|
|
|
|
type => "datetime", |
2115
|
|
|
|
|
|
|
}, |
2116
|
|
|
|
|
|
|
}, |
2117
|
|
|
|
|
|
|
); |
2118
|
|
|
|
|
|
|
|
2119
|
|
|
|
|
|
|
It should be noted in the example above that the default environment |
2120
|
|
|
|
|
|
|
variable name ("APP_${varname}") has been overridden for some of |
2121
|
|
|
|
|
|
|
the options. The "dbname" variable will be set from "DBNAME" |
2122
|
|
|
|
|
|
|
instead of "APP_DBNAME". The "dbuser" variable will be set |
2123
|
|
|
|
|
|
|
from either "DBUSER" or "DBI_USER". |
2124
|
|
|
|
|
|
|
|
2125
|
|
|
|
|
|
|
It should also be noted that if only the order of the options rather |
2126
|
|
|
|
|
|
|
than all of their attributes were desired, the following could |
2127
|
|
|
|
|
|
|
have been used. |
2128
|
|
|
|
|
|
|
|
2129
|
|
|
|
|
|
|
use App::Options ( |
2130
|
|
|
|
|
|
|
options => [ "dbdriver", "dbname", "dbuser", "dbpass", |
2131
|
|
|
|
|
|
|
"first_name", "last_name", "birth_dt", "company_id", |
2132
|
|
|
|
|
|
|
"wholesale_ind", "change_dttm", |
2133
|
|
|
|
|
|
|
], |
2134
|
|
|
|
|
|
|
); |
2135
|
|
|
|
|
|
|
|
2136
|
|
|
|
|
|
|
Using the "options" arg causes the options to |
2137
|
|
|
|
|
|
|
be printed in the order given in the "--help" output. Then the |
2138
|
|
|
|
|
|
|
remaining options defined in the "option" arg are printed in |
2139
|
|
|
|
|
|
|
alphabetical order. All other options which are set |
2140
|
|
|
|
|
|
|
on the command line or in option files are printed if the |
2141
|
|
|
|
|
|
|
"show_all" option is set. This option is off by default if |
2142
|
|
|
|
|
|
|
either the "options" arg or the "option" arg are supplied |
2143
|
|
|
|
|
|
|
and on if neither are supplied. |
2144
|
|
|
|
|
|
|
|
2145
|
|
|
|
|
|
|
If, for some reason, the program needed to put the options |
2146
|
|
|
|
|
|
|
into a different option hash (instead of %App::options) or directly |
2147
|
|
|
|
|
|
|
specify the option file to use (disregarding the standard option |
2148
|
|
|
|
|
|
|
file search path), it may do so using the following syntax. |
2149
|
|
|
|
|
|
|
|
2150
|
|
|
|
|
|
|
use App::Options ( |
2151
|
|
|
|
|
|
|
values => \%Mymodule::opts, |
2152
|
|
|
|
|
|
|
option_file => "/path/to/options.conf", |
2153
|
|
|
|
|
|
|
); |
2154
|
|
|
|
|
|
|
|
2155
|
|
|
|
|
|
|
If, for some reason, the program needs to inhibit one or more |
2156
|
|
|
|
|
|
|
of the sources for options, it can do so with one of the |
2157
|
|
|
|
|
|
|
following arguments. Of course, inhibiting all three would |
2158
|
|
|
|
|
|
|
be a bit silly. |
2159
|
|
|
|
|
|
|
|
2160
|
|
|
|
|
|
|
use App::Options ( |
2161
|
|
|
|
|
|
|
no_cmd_args => 1, |
2162
|
|
|
|
|
|
|
no_option_file => 1, |
2163
|
|
|
|
|
|
|
no_env_vars => 1, |
2164
|
|
|
|
|
|
|
); |
2165
|
|
|
|
|
|
|
|
2166
|
|
|
|
|
|
|
=head2 A Deployment Scenario |
2167
|
|
|
|
|
|
|
|
2168
|
|
|
|
|
|
|
Sometimes a software system gets deployed across many machines. |
2169
|
|
|
|
|
|
|
You may wish to have a single option file set different values |
2170
|
|
|
|
|
|
|
when it is deployed to different machines. |
2171
|
|
|
|
|
|
|
|
2172
|
|
|
|
|
|
|
For this purpose, the automatic "host" and "hostname" values |
2173
|
|
|
|
|
|
|
are useful. Suppose you have four servers named "foo1", "foo2", |
2174
|
|
|
|
|
|
|
"foo3", and "foo4". You may wish the software to use different |
2175
|
|
|
|
|
|
|
databases on each server. So app.conf might look like this. |
2176
|
|
|
|
|
|
|
|
2177
|
|
|
|
|
|
|
[host=foo1] dbname = devel |
2178
|
|
|
|
|
|
|
[host=foo2] |
2179
|
|
|
|
|
|
|
dbname = test |
2180
|
|
|
|
|
|
|
[host=foo3] |
2181
|
|
|
|
|
|
|
dbname = prod |
2182
|
|
|
|
|
|
|
[ALL] |
2183
|
|
|
|
|
|
|
dbname = prod |
2184
|
|
|
|
|
|
|
|
2185
|
|
|
|
|
|
|
Hopefully, that's enough to get you going. |
2186
|
|
|
|
|
|
|
|
2187
|
|
|
|
|
|
|
I welcome all feedback, bug reports, and feature requests. |
2188
|
|
|
|
|
|
|
|
2189
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
2190
|
|
|
|
|
|
|
|
2191
|
|
|
|
|
|
|
* (c) 2010 Stephen Adkins |
2192
|
|
|
|
|
|
|
* Author: Stephen Adkins |
2193
|
|
|
|
|
|
|
* License: This is free software. It is licensed under the same terms as Perl itself. |
2194
|
|
|
|
|
|
|
|
2195
|
|
|
|
|
|
|
=head1 SEE ALSO |
2196
|
|
|
|
|
|
|
|
2197
|
|
|
|
|
|
|
=cut |
2198
|
|
|
|
|
|
|
|
2199
|
|
|
|
|
|
|
1; |
2200
|
|
|
|
|
|
|
|