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