Author: spadkins
Date: Tue Oct 30 12:09:10 2007
New Revision: 10140
Modified:
p5ee/trunk/App-Options/lib/App/Options.pm
Log:
add read_option_files(). allows for reuse of the logic in secondary uses.
Modified: p5ee/trunk/App-Options/lib/App/Options.pm
==============================================================================
--- p5ee/trunk/App-Options/lib/App/Options.pm (original)
+++ p5ee/trunk/App-Options/lib/App/Options.pm Tue Oct 30 12:09:10 2007
@[EMAIL PROTECTED]
-14,7 +14,7 @[EMAIL PROTECTED]
use File::Spec;
use Config;
-$VERSION = "1.02";
+$VERSION = "1.03";
=head1 NAME
@[EMAIL PROTECTED]
-319,35 +319,69 @[EMAIL PROTECTED]
=cut
-my (@[EMAIL PROTECTED]
);
+my ($default_option_processor); # a reference to the singleton
App::Options object that parsed the command line
-sub init {
- # can call as a function (&App::Options::init()) or a static method
(App::Options->init())
- ****ft if ($#_ > -1 && $_[0] eq "App::Options");
-
- # can supply initial hashref to use for option values instead of
global %App::options
- my $values = ($#_ > -1 && ref($_[0]) eq "HASH") ? ****ft :
\%App::options;
-
- ($#_ % 2 == 1) || croak "App::Options->init(): must have an even
number of vars/values for named args";
- my %init_args = @[EMAIL PROTECTED]
# "values" in named arg list overrides the one supplied as an initial
hashref
- if (defined $init_args{values}) {
- (ref($init_args{values}) eq "HASH") || croak
"App::Options->init(): 'values' arg must be a hash reference";
- $values = $init_args{values};
- }
- else {
- $init_args{values} = $values;
+# This translates the procedural App::Options::im****t() into the class
method App::Options->_im****t() (for subclassing)
+sub im****t {
+ my ($package, @[EMAIL PROTECTED]
) = @[EMAIL PROTECTED]
$package->_im****t(@[EMAIL PROTECTED]
);
+}
+
+sub _im****t_test {
+ my ($class, @[EMAIL PROTECTED]
) = @[EMAIL PROTECTED]
$default_option_processor = undef;
+ $class->_im****t(@[EMAIL PROTECTED]
);
+}
+
+sub _im****t {
+ my ($class, @[EMAIL PROTECTED]
) = @[EMAIL PROTECTED]
# We only do this once (the default App::Options option processor is
a singleton)
+ if (!$default_option_processor) {
+ # can supply initial hashref to use for option values instead of
global %App::options
+ my $values = ($#args > -1 && ref($args[0]) eq "HASH") ?
****ft(@[EMAIL PROTECTED]
) : \%App::options;
+
+ ($#args % 2 == 1) || croak "App::Options::im****t(): must have an
even number of vars/values for named args";
+ my $init_args = { @[EMAIL PROTECTED]
};
+
+ # "values" in named arg list overrides the one supplied as an
initial hashref
+ if (defined $init_args->{values}) {
+ (ref($init_args->{values}) eq "HASH") || croak
"App::Options->new(): 'values' arg must be a hash reference";
+ $values = $init_args->{values};
+ }
+
+ my $option_processor = $class->new($init_args);
+ $default_option_processor = $option_processor; # save it in the
singleton location
+
+ $option_processor->read_options($values); # read in all
the options from various places
+ $option_processor->{values} = $values; # store it for
future (currently undefined) uses
}
+}
+
+sub new {
+ my ($this, $init_args) = @[EMAIL PROTECTED]
my $class = ref($this) || $this;
+ my $self = {};
+ $self->{init_args} = $init_args;
+ $self->{argv} = [ @[EMAIL PROTECTED]
];
+ $self->{options} = [ ];
+ bless $self, $class;
+ return($self);
+}
+
+sub read_options {
+ my ($self, $values) = @[EMAIL PROTECTED]
#######################################################################
# populate "option" (the information about each option!)
#######################################################################
my ($var, $value, @[EMAIL PROTECTED]
$option);
- $option = $init_args{option};
+ my $init_args = $self->{init_args};
+ $option = $init_args->{option};
if ($option) {
- croak "App::Options->init(): 'option' arg must be a hash
reference"
+ croak "App::Options->read_options(): 'option' arg must be a hash
reference"
if (ref($option) ne "HASH");
my (@[EMAIL PROTECTED]
$hash, $arg);
@[EMAIL PROTECTED]
-399,13 +433,12 @[EMAIL PROTECTED]
my $show_help = 0;
my $show_version = 0;
- @[EMAIL PROTECTED]
= @[EMAIL PROTECTED]
# save the initial @[EMAIL PROTECTED]
if (! $init_args{no_cmd_args}) {
+ if (! $init_args->{no_cmd_args}) {
+ my $options = $self->{options};
while ($#ARGV >= 0 && $ARGV[0] =~ /^--?([^=-][^=]*)(=?)(.*)/) {
$var = $1;
$value = ($2 eq "") ? 1 : $3;
- push(@[EMAIL PROTECTED]
****ft @[EMAIL PROTECTED]
);
+ push(@[EMAIL PROTECTED]
****ft @[EMAIL PROTECTED]
);
$values->{$var} = $value;
}
if ($#ARGV >= 0 && $ARGV[0] eq "--") {
@[EMAIL PROTECTED]
-424,7 +457,7 @[EMAIL PROTECTED]
delete $values->{version};
}
$debug_options = $values->{debug_options} || 0;
- print STDERR "1. Parsed Command Line Options. [@[EMAIL PROTECTED]
" if
($debug_options);
+ print STDERR "1. Parsed Command Line Options. [@[EMAIL PROTECTED]
" if
($debug_options);
}
else {
print STDERR "1. Skipped Command Line Option Parsing.\n" if
($debug_options);
@[EMAIL PROTECTED]
-522,19 +555,19 @[EMAIL PROTECTED]
print STDERR "4. Set app variable. app=[$app] origin=[$app_origin]\n"
if ($debug_options);
my ($env_var, @[EMAIL PROTECTED]
$regexp);
- if (! $init_args{no_option_file}) {
+ if (! $init_args->{no_option_file}) {
#################################################################
# 5. Define the standard places to look for an option file
#################################################################
- my @[EMAIL PROTECTED]
= ();
- push(@[EMAIL PROTECTED]
$values->{option_file}) if
($values->{option_file});
- push(@[EMAIL PROTECTED]
"$ENV{HOME}/.app/$app.conf") if ($ENV{HOME} &&
$app ne "app");
- push(@[EMAIL PROTECTED]
"$ENV{HOME}/.app/app.conf") if ($ENV{HOME});
- push(@[EMAIL PROTECTED]
"$prog_dir/$app.conf") if ($app ne "app");
- push(@[EMAIL PROTECTED]
"$prog_dir/app.conf");
- push(@[EMAIL PROTECTED]
"\${prefix}/etc/app/$app.conf") if ($app ne
"app");
- push(@[EMAIL PROTECTED]
"\${prefix}/etc/app/app.conf");
- push(@[EMAIL PROTECTED]
"/etc/app/app.conf");
+ my @[EMAIL PROTECTED]
= ();
+ push(@[EMAIL PROTECTED]
$values->{option_file}) if
($values->{option_file});
+ push(@[EMAIL PROTECTED]
"$ENV{HOME}/.app/$app.conf") if ($ENV{HOME}
&& $app ne "app");
+ push(@[EMAIL PROTECTED]
"$ENV{HOME}/.app/app.conf") if ($ENV{HOME});
+ push(@[EMAIL PROTECTED]
"$prog_dir/$app.conf") if ($app ne "app");
+ push(@[EMAIL PROTECTED]
"$prog_dir/app.conf");
+ push(@[EMAIL PROTECTED]
"\${prefix}/etc/app/$app.conf") if ($app ne
"app");
+ push(@[EMAIL PROTECTED]
"\${prefix}/etc/app/app.conf");
+ push(@[EMAIL PROTECTED]
"/etc/app/app.conf");
#################################################################
# 5. now actually read in the file(s)
@[EMAIL PROTECTED]
-544,189 +577,8 @[EMAIL PROTECTED]
#################################################################
print STDERR "5. Scanning Option Files\n" if ($debug_options);
- local(*App::Options::FILE);
- my ($option_file, $exclude_section);
- my ($cond, @[EMAIL PROTECTED]
$exclude, $heredoc_end);
- while ($#option_file > -1) {
- $option_file = ****ft(@[EMAIL PROTECTED]
);
- if ($option_file =~ m!\$\{prefix\}!) {
- if ($values->{prefix}) {
- $option_file =~ s!\$\{prefix\}!$values->{prefix}!;
- }
- else {
- $option_file =~ s!\$\{prefix\}!$prefix!;
- }
- }
- $exclude_section = 0;
- print STDERR " Looking for Option File [$option_file]" if
($debug_options);
- if (open(App::Options::FILE, "< $option_file")) {
- print STDERR " : Found\n" if ($debug_options);
- my ($orig_line);
- while (<App::Options::FILE>) {
- chomp;
- $orig_line = $_;
- # for lines that are like "[regexp]" or even
"[regexp] var = value"
- # or "[value;var=value]" or
"[/regexp/;var1=value1;var2=/regexp2/]"
- if (s!^ *\[(.*)\] *!!) {
- print STDERR " Checking Section : [$1]\n"
if ($debug_options >= 6);
- @[EMAIL PROTECTED]
= split(/;/,$1); # separate the
conditions that must be satisfied
- $exclude = 0; # assume the condition
allows inclusion (! $exclude)
- foreach $cond (@[EMAIL PROTECTED]
) { # check each condition
- if ($cond =~ /^([^=]+)=(.*)$/) { # i.e.
[city=ATL] or [name=/[Ss]tephen/]
- $var = $1;
- $value = $2;
- }
- else { # i.e. [go] matches the
program (app) named "go"
- $var = "app";
- $value = $cond;
- }
- if ($value =~ m!^/(.*)/$!) { # variable's
value must match the regexp
- $regexp = $1;
- $exclude = ((defined $values->{$var} ?
$values->{$var} : "") !~ /$regexp/) ? 1 : 0;
- print STDERR " Checking Section
Condition var=[$var] [$value] matches [$regexp] : result=",
- ($exclude ? "[ignore]" : "[use]"),
"\n"
- if ($debug_options >= 6);
- }
- elsif ($var eq "app" && ($value eq "" ||
$value eq "ALL")) {
- $exclude = 0; # "" and "ALL" are
special wildcards for the "app" variable
- print STDERR " Checking Section
Condition var=[$var] [$value] = ALL : result=",
- ($exclude ? "[ignore]" : "[use]"),
"\n"
- if ($debug_options >= 6);
- }
- else { # a variable's value must match
exactly
- $exclude = ((defined $values->{$var} ?
$values->{$var} : "") ne $value) ? 1 : 0;
- print STDERR " Checking Section
Condition var=[$var] [$value] = [",
- (defined $values->{$var} ?
$values->{$var} : ""),
- "] : result=",
- ($exclude ? "[ignore]" : "[use]"),
"\n"
- if ($debug_options >= 6);
- }
- last if ($exclude);
- }
- s/^#.*$//; # delete comments
- print STDERR " ", ($exclude ? "[ignore]" :
"[use] "), " $orig_line\n" if ($debug_options >= 5);
- if ($_) {
- # this is a single-line condition, don't
change the $exclude_section flag
- next if ($exclude);
- }
- else {
- # this condition pertains to all lines after
it
- $exclude_section = $exclude;
- next;
- }
- }
- else {
- print STDERR " ", ($exclude_section ?
"[ignore]" : "[use] "), " $orig_line\n" if ($debug_options >= 5);
- }
- next if ($exclude_section);
-
- s/#.*$//; # delete comments
- s/^ +//; # delete leading spaces
- s/ +$//; # delete trailing spaces
- next if (/^$/); # skip blank lines
-
- # look for "var = value" (ignore other lines)
- if (/^([a-zA-Z0-9_.-{}]+) *= *(.*)/) { # untainting
also happens
- $var = $1;
- $value = $2;
-
- # "here do***ents": var = <<EOF ... EOF
- if ($value =~ /^<<(.*)/) {
- $heredoc_end = $1;
- $value = "";
- while (<App::Options::FILE>) {
- last if ($_ =~ /^$heredoc_end\s*$/);
- $value .= $_;
- }
- $heredoc_end = "";
- }
- # get value from a file
- elsif ($value =~ /^<\s*(.+)/ || $value =~
/^(.+)\s*\|$/) {
- $value =~ s/\$\{([a-zA-Z0-9_\.-]+)\}/(defined
$values->{$1} ? $values->{$1} : "")/eg;
- if (open(App::Options::FILE2, $value)) {
- $value = join("", <App::Options::FILE2>);
- close(App::Options::FILE2);
- }
- else {
- $value = "Can't read file [$value] for
variable [$var]: $!";
- }
- }
- # get additional line(s) due to continuation
chars
- elsif ($value =~ s/\\\s*$//) {
- while (<App::Options::FILE>) {
- if ($_ =~ s/\\\s*[\r\n]*$//) { # remove
trailing newline
- s/^\s+//; # remove leading space
when following a line continuation character
- $value .= $_;
- }
- else {
- chomp; # remove trailing newline
when following a line continuation character
- s/^\s+//; # remove leading space
when following a line continuation character
- $value .= $_;
- last;
- }
- }
- }
- else {
- $value =~ s/^"(.*)"$/$1/; # quoting, var = "
hello world " (enables leading/trailing spaces)
- }
+ $self->read_option_files($values, \@[EMAIL PROTECTED]
$prefix);
- print STDERR " Var Found in File :
var=[$var] value=[$value]\n" if ($debug_options >= 6);
-
- # only add values which have never been defined
before
- if ($var =~ /^ENV\{([^{}]+)\}$/) {
- $env_var = $1;
- $ENV{$env_var} = $value;
- }
- elsif (!defined $values->{$var}) {
- if (!$init_args{no_env_vars}) {
- if ($option && defined $option->{$var} &&
defined $option->{$var}{env}) {
- if ($option->{$var}{env} eq "") {
- @[EMAIL PROTECTED]
= ();
- }
- else {
- @[EMAIL PROTECTED]
= split(/[,;]/,
$option->{$var}{env});
- }
- }
- else {
- @[EMAIL PROTECTED]
= ( "APP_" . uc($var) );
- }
- foreach $env_var (@[EMAIL PROTECTED]
) {
- if ($env_var && defined
$ENV{$env_var}) {
- $value = $ENV{$env_var};
- print STDERR " Override
File Value from Env : var=[$var] value=[$value] from [$env_var] of
[@[EMAIL PROTECTED]
" if ($debug_options >= 4);
- last;
- }
- }
- }
- # do variable substitutions, var =
${prefix}/bin, var = $ENV{PATH}
- if (defined $value) {
- if ($value =~ /\{.*\}/) {
- $value =~
s/\$\{([a-zA-Z0-9_\.-]+)\}/(defined $values->{$1} ? $values->{$1} :
"")/eg;
- $value =~
s/\$ENV\{([a-zA-Z0-9_\.-]+)\}/(defined $ENV{$1} ? $ENV{$1} : "")/eg;
- print STDERR " File Var
Underwent Substitutions : [$var] = [$value]\n"
- if ($debug_options >= 4);
- }
- print STDERR " Var Used :
var=[$var] value=[$value]\n" if ($debug_options >= 3);
- $values->{$var} = $value; # save all
in %App::options
- }
- }
- }
- }
- close(App::Options::FILE);
-
- if ($values->{flush_im****ts}) {
- @[EMAIL PROTECTED]
= (); # throw out other files to look
for
- delete $values->{flush_im****ts};
- }
- if ($values->{im****t}) {
- un****ft(@[EMAIL PROTECTED]
split(/[,; ]+/,
$values->{im****t}));
- delete $values->{im****t};
- }
- }
- else {
- print STDERR "\n" if ($debug_options);
- }
- }
$debug_options = $values->{debug_options} || 0;
}
else {
@[EMAIL PROTECTED]
-734,19 +586,19 @[EMAIL PROTECTED]
}
if ($values->{perl_restart} && !$ENV{PERL_RESTART}) {
$ENV{PERL_RESTART} = 1;
- exec($^X, $0, @[EMAIL PROTECTED]
);
+ exec($^X, $0, @[EMAIL PROTECTED]
>{argv}});
}
#################################################################
# 6. fill in ENV vars
#################################################################
- if (!$init_args{no_env_vars}) {
+ if (!$init_args->{no_env_vars}) {
@[EMAIL PROTECTED]
= ();
- if ($init_args{options}) {
- croak "App::Options->init(): 'options' arg must be an array
reference"
- if (ref($init_args{options}) ne "ARRAY");
- push(@[EMAIL PROTECTED]
@[EMAIL PROTECTED]
);
+ if ($init_args->{options}) {
+ croak "App::Options->read_options(): 'options' arg must be an
array reference"
+ if (ref($init_args->{options}) ne "ARRAY");
+ push(@[EMAIL PROTECTED]
@[EMAIL PROTECTED]
>{options}});
}
if ($option) {
@[EMAIL PROTECTED]
-758,7 +610,7 @[EMAIL PROTECTED]
foreach $var (@[EMAIL PROTECTED]
) {
if (!defined $values->{$var}) {
$value = undef;
- if (!$init_args{no_env_vars}) {
+ if (!$init_args->{no_env_vars}) {
if ($option && defined $option->{$var}{env}) {
if ($option->{$var}{env} eq "") {
@[EMAIL PROTECTED]
= ();
@[EMAIL PROTECTED]
-833,7 +685,7 @[EMAIL PROTECTED]
# 8. set defaults
#################################################################
if ($option) {
- @[EMAIL PROTECTED]
= (defined $init_args{options}) ? @[EMAIL PROTECTED]
:
();
+ @[EMAIL PROTECTED]
= (defined $init_args->{options}) ?
@[EMAIL PROTECTED]
>{options}} : ();
push(@[EMAIL PROTECTED]
(sort keys %$option));
print STDERR "8. Set Defaults.\n" if ($debug_options);
@[EMAIL PROTECTED]
-1033,26 +885,18 @[EMAIL PROTECTED]
}
if ($exit_status >= 0) {
- if ($init_args{print_usage}) {
- &{$init_args{print_usage}}($values, \%init_args);
+ if ($init_args->{print_usage}) {
+ &{$init_args->{print_usage}}($values, $init_args);
}
else {
- App::Options->print_usage($values, \%init_args);
+ App::Options->print_usage($values, $init_args);
}
exit($exit_status);
}
}
-sub im****t {
- my ($self, @[EMAIL PROTECTED]
) = @[EMAIL PROTECTED]
if ($#args % 2 == 1) {
- $self->init(@[EMAIL PROTECTED]
);
- }
-}
-
sub print_usage {
- ****ft if ($#_ > -1 && $_[0] eq "App::Options");
- my ($values, $init_args) = @[EMAIL PROTECTED]
my ($self, $values, $init_args) = @[EMAIL PROTECTED]
$values = {} if (!$values);
$init_args = {} if (!$init_args);
@[EMAIL PROTECTED]
-1099,7 +943,7 @[EMAIL PROTECTED]
}
sub print_version {
- my ($prog_file, $show_version, $values) = @[EMAIL PROTECTED]
my ($self, $prog_file, $show_version, $values) = @[EMAIL PROTECTED]
print "Program: $prog_file\n";
print "(use --version_packages to see version info for specific perl
packages)\n";
my ($module, $package, $version, $full_path);
@[EMAIL PROTECTED]
-1172,6 +1016,195 @[EMAIL PROTECTED]
}
}
+sub read_option_files {
+ my ($self, $values, $option_files, $prefix) = @[EMAIL PROTECTED]
my $init_args = $self->{init_args};
+ local(*App::Options::FILE);
+ my ($option_file, $exclude_section, $option, $var, @[EMAIL PROTECTED]
$value, $regexp);
+ my ($cond, @[EMAIL PROTECTED]
$exclude, $heredoc_end);
+ my $debug_options = $values->{debug_options} || 0;
+ while ($#$option_files > -1) {
+ $option_file = ****ft(@[EMAIL PROTECTED]
);
+ if ($option_file =~ m!\$\{prefix\}!) {
+ if ($values->{prefix}) {
+ $option_file =~ s!\$\{prefix\}!$values->{prefix}!;
+ }
+ else {
+ $option_file =~ s!\$\{prefix\}!$prefix!;
+ }
+ }
+ $exclude_section = 0;
+ print STDERR " Looking for Option File [$option_file]" if
($debug_options);
+ if (open(App::Options::FILE, "< $option_file")) {
+ print STDERR " : Found\n" if ($debug_options);
+ my ($orig_line);
+ while (<App::Options::FILE>) {
+ chomp;
+ $orig_line = $_;
+ # for lines that are like "[regexp]" or even "[regexp]
var = value"
+ # or "[value;var=value]" or
"[/regexp/;var1=value1;var2=/regexp2/]"
+ if (s!^\s*\[(.*)\]\s*!!) {
+ print STDERR " Checking Section : [$1]\n" if
($debug_options >= 6);
+ @[EMAIL PROTECTED]
= split(/;/,$1); # separate the conditions
that must be satisfied
+ $exclude = 0; # assume the condition
allows inclusion (! $exclude)
+ foreach $cond (@[EMAIL PROTECTED]
) { # check each condition
+ if ($cond =~ /^([^=]+)=(.*)$/) { # i.e.
[city=ATL] or [name=/[Ss]tephen/]
+ $var = $1;
+ $value = $2;
+ }
+ else { # i.e. [go] matches the
program (app) named "go"
+ $var = "app";
+ $value = $cond;
+ }
+ if ($value =~ m!^/(.*)/$!) { # variable's value
must match the regexp
+ $regexp = $1;
+ $exclude = ((defined $values->{$var} ?
$values->{$var} : "") !~ /$regexp/) ? 1 : 0;
+ print STDERR " Checking Section
Condition var=[$var] [$value] matches [$regexp] : result=",
+ ($exclude ? "[ignore]" : "[use]"), "\n"
+ if ($debug_options >= 6);
+ }
+ elsif ($var eq "app" && ($value eq "" || $value
eq "ALL")) {
+ $exclude = 0; # "" and "ALL" are special
wildcards for the "app" variable
+ print STDERR " Checking Section
Condition var=[$var] [$value] = ALL : result=",
+ ($exclude ? "[ignore]" : "[use]"), "\n"
+ if ($debug_options >= 6);
+ }
+ else { # a variable's value must match exactly
+ $exclude = ((defined $values->{$var} ?
$values->{$var} : "") ne $value) ? 1 : 0;
+ print STDERR " Checking Section
Condition var=[$var] [$value] = [",
+ (defined $values->{$var} ?
$values->{$var} : ""),
+ "] : result=",
+ ($exclude ? "[ignore]" : "[use]"), "\n"
+ if ($debug_options >= 6);
+ }
+ last if ($exclude);
+ }
+ s/^#.*$//; # delete comments
+ print STDERR " ", ($exclude ? "[ignore]" :
"[use] "), " $orig_line\n" if ($debug_options >= 5);
+ if ($_) {
+ # this is a single-line condition, don't change
the $exclude_section flag
+ next if ($exclude);
+ }
+ else {
+ # this condition pertains to all lines after it
+ $exclude_section = $exclude;
+ next;
+ }
+ }
+ else {
+ print STDERR " ", ($exclude_section ? "[ignore]"
: "[use] "), " $orig_line\n" if ($debug_options >= 5);
+ }
+ next if ($exclude_section);
+
+ s/#.*$//; # delete comments
+ s/^ +//; # delete leading spaces
+ s/ +$//; # delete trailing spaces
+ next if (/^$/); # skip blank lines
+
+ # look for "var = value" (ignore other lines)
+ if (/^([a-zA-Z0-9_.-{}]+)\s*=\s*(.*)/) { # untainting
also happens
+ $var = $1;
+ $value = $2;
+
+ # "here do***ents": var = <<EOF ... EOF
+ if ($value =~ /^<<(.*)/) {
+ $heredoc_end = $1;
+ $value = "";
+ while (<App::Options::FILE>) {
+ last if ($_ =~ /^$heredoc_end\s*$/);
+ $value .= $_;
+ }
+ $heredoc_end = "";
+ }
+ # get value from a file
+ elsif ($value =~ /^<\s*(.+)/ || $value =~
/^(.+)\s*\|$/) {
+ $value =~ s/\$\{([a-zA-Z0-9_\.-]+)\}/(defined
$values->{$1} ? $values->{$1} : "")/eg;
+ if (open(App::Options::FILE2, $value)) {
+ $value = join("", <App::Options::FILE2>);
+ close(App::Options::FILE2);
+ }
+ else {
+ $value = "Can't read file [$value] for
variable [$var]: $!";
+ }
+ }
+ # get additional line(s) due to continuation chars
+ elsif ($value =~ s/\\\s*$//) {
+ while (<App::Options::FILE>) {
+ if ($_ =~ s/\\\s*[\r\n]*$//) { # remove
trailing newline
+ s/^\s+//; # remove leading space when
following a line continuation character
+ $value .= $_;
+ }
+ else {
+ chomp; # remove trailing newline when
following a line continuation character
+ s/^\s+//; # remove leading space when
following a line continuation character
+ $value .= $_;
+ last;
+ }
+ }
+ }
+ else {
+ $value =~ s/^"(.*)"$/$1/; # quoting, var = "
hello world " (enables leading/trailing spaces)
+ }
+
+ print STDERR " Var Found in File : var=[$var]
value=[$value]\n" if ($debug_options >= 6);
+
+ # only add values which have never been defined
before
+ if ($var =~ /^ENV\{([^{}]+)\}$/) {
+ $env_var = $1;
+ $ENV{$env_var} = $value;
+ }
+ elsif (!defined $values->{$var}) {
+ if (!$init_args->{no_env_vars}) {
+ if ($option && defined $option->{$var} &&
defined $option->{$var}{env}) {
+ if ($option->{$var}{env} eq "") {
+ @[EMAIL PROTECTED]
= ();
+ }
+ else {
+ @[EMAIL PROTECTED]
= split(/[,;]/,
$option->{$var}{env});
+ }
+ }
+ else {
+ @[EMAIL PROTECTED]
= ( "APP_" . uc($var) );
+ }
+ foreach $env_var (@[EMAIL PROTECTED]
) {
+ if ($env_var && defined $ENV{$env_var}) {
+ $value = $ENV{$env_var};
+ print STDERR " Override File
Value from Env : var=[$var] value=[$value] from [$env_var] of
[@[EMAIL PROTECTED]
" if ($debug_options >= 4);
+ last;
+ }
+ }
+ }
+ # do variable substitutions, var = ${prefix}/bin,
var = $ENV{PATH}
+ if (defined $value) {
+ if ($value =~ /\{.*\}/) {
+ $value =~
s/\$\{([a-zA-Z0-9_\.-]+)\}/(defined $values->{$1} ? $values->{$1} :
"")/eg;
+ $value =~
s/\$ENV\{([a-zA-Z0-9_\.-]+)\}/(defined $ENV{$1} ? $ENV{$1} : "")/eg;
+ print STDERR " File Var Underwent
Substitutions : [$var] = [$value]\n"
+ if ($debug_options >= 4);
+ }
+ print STDERR " Var Used : var=[$var]
value=[$value]\n" if ($debug_options >= 3);
+ $values->{$var} = $value; # save all in
%App::options
+ }
+ }
+ }
+ }
+ close(App::Options::FILE);
+
+ if ($values->{flush_im****ts}) {
+ @[EMAIL PROTECTED]
= (); # throw out other files to look for
+ delete $values->{flush_im****ts};
+ }
+ if ($values->{im****t}) {
+ un****ft(@[EMAIL PROTECTED]
split(/[,; ]+/,
$values->{im****t}));
+ delete $values->{im****t};
+ }
+ }
+ else {
+ print STDERR "\n" if ($debug_options);
+ }
+ }
+}
+
=head1 LOGIC FLOW: OPTION PROCESSING DETAILS
Basic Concept - By calling App::Options->init(),
|
