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