File Coverage

lib/App/Options.pm
Criterion Covered Total %
statement 297 564 52.6
branch 157 442 35.5
condition 43 165 26.0
subroutine 14 17 82.3
pod 0 7 0.0
total 511 1195 42.7


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