App-Options
view release on metacpan or search on metacpan
lib/App/Options.pm view on Meta::CPAN
# (anything starting with one or two dashes is an option var
# i.e. --debugmode=record -debugmode=replay
# an option without an "=" (i.e. --help) acts as --help=1
# Put the var/value pairs in %$values
#################################################################
my $debug_options = $values->{debug_options} || 0;
my $show_help = 0;
my $show_version = 0;
my $exit_status = -1;
if (! $init_args->{no_cmd_args}) {
my $options = $self->{options};
while ($#ARGV >= 0 && $ARGV[0] =~ /^--?([^=-][^=]*)(=?)(.*)/) {
$var = $1;
$value = ($2 eq "") ? 1 : $3;
push(@$options, shift @ARGV);
if ($option_defs->{$var} && $option_defs->{$var}{secure} && defined $values->{security_policy_level} && $values->{security_policy_level} >= 2) {
$exit_status = 1;
print "Error: \"$var\" may not be supplied on the command line because it is a secure option.\n";
}
$values->{$var} = $value;
$option_source{$var} = "CMDLINE";
}
if ($#ARGV >= 0 && $ARGV[0] eq "--") {
shift @ARGV;
}
if ($values->{help}) {
$show_help = 1;
delete $values->{help};
}
elsif ($values->{"?"}) {
$show_help = 1;
delete $values->{"?"};
}
elsif ($values->{version}) {
$show_version = $values->{version};
delete $values->{version};
}
$debug_options = $values->{debug_options} || 0;
print STDERR "1. Parsed Command Line Options. [@$options]\n" if ($debug_options);
}
else {
print STDERR "1. Skipped Command Line Option Parsing.\n" if ($debug_options);
}
#################################################################
# 2. find the directory the program was run from.
# we will use this directory to search for the
# option file.
#################################################################
my ($prog_cat, $prog_dir, $prog_file);
# i.e. C:\perl\bin\app, \app
($prog_cat, $prog_dir, $prog_file) = File::Spec->splitpath($0);
$prog_dir =~ s!\\!/!g; # transform to POSIX-compliant (forward slashes)
$prog_dir =~ s!/$!! if ($prog_dir ne "/"); # remove trailing slash
$prog_dir = "." if ($prog_dir eq "");
$prog_dir = $prog_cat . $prog_dir if ($^O =~ /MSWin32/ and $prog_dir =~ m!^/!);
#################################################################
# 3. guess the "prefix" directory for the entire
# software installation. The program is usually in
# $prefix/bin or $prefix/cgi-bin.
#################################################################
my $prefix = $values->{prefix}; # possibly set on command line
my $prefix_origin = "command line";
# it can be set in environment.
if (!$prefix && $ENV{PREFIX}) {
$prefix = $ENV{PREFIX};
$prefix_origin = "environment";
}
# Using "abs_path" gets rid of all symbolic links and gives the real path
# to the directory in which the script runs.
if (!$prefix) {
my $abs_prog_dir = abs_path($prog_dir);
$abs_prog_dir =~ s!\\!/!g; # transform to POSIX-compliant (forward slashes)
$abs_prog_dir =~ s!/$!! if ($abs_prog_dir ne "/"); # remove trailing slash
if ($abs_prog_dir =~ s!/bin$!!) {
$prefix = $abs_prog_dir;
$prefix_origin = "parent of bin dir";
}
elsif ($abs_prog_dir =~ s!/cgi-bin.*$!!) {
$prefix = $abs_prog_dir;
$prefix_origin = "parent of cgi-bin dir";
}
}
if (!$prefix) { # last resort: perl's prefix
$prefix = $Config{prefix};
$prefix =~ s!\\!/!g; # transform to POSIX-compliant
$prefix =~ s!/$!! if ($prefix ne "/"); # remove trailing slash
$prefix_origin = "perl prefix";
}
print STDERR "3. Provisional prefix Set. prefix=[$prefix] origin=[$prefix_origin]\n"
if ($debug_options);
#################################################################
# 4. find the app.
# by default this is the basename of the program
# in a web application, this is overridden by any existing
# first part of the PATH_INFO
#################################################################
my $app = $values->{app};
my $app_origin = "command line";
if (!$app) {
($app, $app_origin) = App::Options->determine_app($prefix, $prog_dir, $prog_file, $ENV{PATH_INFO}, $ENV{HOME});
$values->{app} = $app;
}
print STDERR "4. Set app variable. app=[$app] origin=[$app_origin]\n" if ($debug_options);
#print STDERR "04 option_defs [", join("|", sort keys %$option_defs), "]\n";
my ($env_var, @env_vars, $regexp);
if (! $init_args->{no_option_file}) {
#################################################################
# 5. Define the standard places to look for an option file
#################################################################
my @option_files = ();
push(@option_files, "/etc/app/policy.conf");
push(@option_files, $values->{option_file}) if ($values->{option_file});
lib/App/Options.pm view on Meta::CPAN
#################################################################
# 8. set defaults
#################################################################
if ($option_defs) {
@vars = (defined $init_args->{options}) ? @{$init_args->{options}} : ();
push(@vars, (sort keys %$option_defs));
print STDERR "8. Set Defaults.\n" if ($debug_options);
foreach $var (@vars) {
if (!defined $values->{$var}) {
if (defined $option_defs->{$var} && defined $option_defs->{$var}{default} && $option_defs->{$var}{secure} &&
defined $values->{security_policy_level} && $values->{security_policy_level} >= 2) {
$exit_status = 1;
print "Error: \"$var\" may not be supplied as a program default because it is a secure option.\n";
}
$value = $option_defs->{$var}{default};
# 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 " Default Underwent Substitutions : [$var] = [$value]\n"
if ($debug_options >= 4);
}
$values->{$var} = $value; # save all in %App::options
$option_source{$var} = "DEFAULT";
print STDERR " Default Var [$var] = [$value]\n" if ($debug_options >= 3);
}
}
}
}
else {
print STDERR "8. Skipped Defaults (no option defaults defined)\n" if ($debug_options);
}
#print STDERR "08 option_defs [", join("|", sort keys %$option_defs), "]\n" if ($prefix eq "/usr");
#################################################################
# 9. add "perlinc" directories to @INC, OR
# automatically include (if not already) the directories
# $PREFIX/lib/$^V and $PREFIX/lib/site_perl/$^V
# i.e. /usr/mycompany/lib/5.6.1 and /usr/mycompany/lib/site_perl/5.6.1
#################################################################
if (defined $values->{perlinc}) { # add perlinc entries
if ($values->{perlinc}) {
unshift(@INC, split(/[,; ]+/,$values->{perlinc}));
if ($debug_options >= 2) {
print STDERR "9. perlinc Directories Added to \@INC\n ",
join("\n ", @INC), "\n";
}
}
else {
print STDERR "9. No Directories Added to \@INC\n" if ($debug_options >= 2);
}
}
else {
my $libdir = "$prefix/lib";
my $libdir_found = 0;
# Look to see whether this PREFIX has been included already in @INC.
# If it has, we do *not* want to automagically guess which directories
# should be searched and in which order.
foreach my $incdir (@INC) {
if ($incdir =~ m!^$libdir!) {
$libdir_found = 1;
last;
}
}
# The traditional way to install software from CPAN uses
# ExtUtils::MakeMaker via Makefile.PL with the "make install"
# command. If you are installing this software to non-standard
# places, you would use the "perl Makefile.PL PREFIX=$PREFIX"
# command. This would typically put modules into the
# $PREFIX/lib/perl5/site_perl/$perlversion directory.
# However, a newer way to install software (and recent versions
# of CPAN.pm understand this) uses Module::Build via Build.PL
# with the "Build install" command. If you are installing this
# software to non-standard places, you would use the
# "perl Build.PL install_base=$PREFIX" command. This would
# typically put modules into the $PREFIX/lib directory.
# So if we need to guess about extra directories to add to the
# @INC variable ($PREFIX/lib is nowhere currently represented
# in @INC), we should add directories which work for software
# installed with either Module::Build or ExtUtils::MakeMaker.
if (!$libdir_found) {
unshift(@INC, "$libdir");
if ($^V) {
my $perlversion = sprintf("%vd", $^V);
unshift(@INC, $libdir);
if (-d "$libdir/perl5") {
unshift(@INC, "$libdir/perl5/site_perl/$perlversion"); # site_perl goes first!
unshift(@INC, "$libdir/perl5/$perlversion");
}
elsif (-d "$libdir/perl") {
unshift(@INC, "$libdir/perl/site_perl/$perlversion"); # site_perl goes first!
unshift(@INC, "$libdir/perl/$perlversion");
}
if (-d "$prefix/share/perl") {
unshift(@INC, "$prefix/share/perl/site_perl/$perlversion"); # site_perl goes first!
unshift(@INC, "$prefix/share/perl/$perlversion");
}
}
}
if ($debug_options >= 2) {
print STDERR "9. Standard Directories Added to \@INC (libdir_found=$libdir_found)\n ",
join("\n ", @INC), "\n";
}
}
#print STDERR "09 option_defs [", join("|", sort keys %$option_defs), "]\n" if ($prefix eq "/usr");
#################################################################
# 10. print stuff out for options debugging
#################################################################
if ($debug_options >= 7) {
print STDERR "FINAL VALUES: \%App::options (or other) =\n";
foreach $var (sort keys %$values) {
if (defined $values->{$var}) {
print STDERR " $var = [$values->{$var}]\n";
}
else {
print STDERR " $var = [undef]\n";
}
}
}
#################################################################
# 11. print version information (--version)
#################################################################
if ($show_version) {
&print_version($prog_file, $show_version, $values);
exit(0);
}
#################################################################
# 12. perform validations, print help, and exit
#################################################################
if ($show_help) {
lib/App/Options.pm view on Meta::CPAN
option => {
dbname => {
env => "DBNAME",
default => "devel",
},
dbuser => {
env => "DBUSER;DBI_USER",
},
dbpass => {
env => "", # password in %ENV is security breach
},
},
);
For each option variable known, if the value is not already set,
then the environment is checked, the default is checked, variable
expansion is performed, and the value is entered into the
option hash.
=head2 Special Option prefix
The special option "prefix" is reconciled and finalized next.
Unless it was specified on the command line, the original "prefix"
was autodetected. This may have resulted in a path which was
technically correct but was different than intended due to
symbolic linking on the file system.
Since the "prefix" variable may also be set in an option file,
there may be a difference between the auto-detected "prefix"
and the option file "prefix". If this case occurs, the
option file "prefix" is the one that is accepted as authoritative.
=head2 Special Option perlinc
One of the primary design goals of App::Options was to be able
to support multiple installations of software on a single machine.
Thus, you might have different versions of software installed
under various directories such as
/usr/product1/1.0.0
/usr/product1/1.1.0
/usr/product1/2.1.5
Naturally, slightly different versions of your perl modules will
be installed under each different "prefix" directory.
When a program runs from /usr/product1/1.1.0/bin, the "prefix"
will by "/usr/product1/1.1.0" and we want the @INC variable to
be modified so that the appropriate perl modules are included
from $prefix/lib/*.
This is where the "perlinc" option comes in.
If "perlinc" is set, it is understood to be a list of paths
(separated by /[ ,;]+/) to be prepended to the @INC variable.
If "perlinc" is not set,
"$prefix/lib/perl5/$perlversion" and
"$prefix/lib/perl5/site_perl/$perlversion" are automatically
prepended to the @INC variable as a best guess.
=head2 Special Option debug_options
If the "debug_options" variable is set (often on the command
line), the list of option files that was searched is printed
out, the resulting list of variable values is printed out,
and the resulting list of include directories (@INC) is printed
out.
=head2 Version
After all values have been parsed, various conditions are
checked to see if the program should print diagnostic information
rather than continue running. Two of these examples are --version
and --help.
If the "--version" option is set on the command line,
the version information for all loaded modules is printed,
and the program is exited. (The version of a package/module is
assumed to be the value of the $VERSION variable in that package.
i.e. The version of the XYZ::Foo package is $XYZ::Foo::VERSION.)
prog --version
Of course, this is all done implicitly in the BEGIN block (during
"use App::Options;"). If your program tried to set
$main::VERSION, it may not be set unless it is set explicitly
in the BEGIN block.
#!/usr/bin/perl
BEGIN {
$VERSION = "1.12";
}
use App::Options;
This can be integrated with CVS file versioning using something
like the following.
#!/usr/bin/perl
BEGIN {
$VERSION = do { my @r=(q$Revision: 14478 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r};
}
use App::Options;
Furthermore, the version information about some modules that you
might expect to have seen will not be printed because those modules
have not yet been loaded. To fix this, use the --version_packages
option (or set it in an option file). This option contains a
comma-separated list of modules and/or module regular expressions.
The modules are loaded, and the version information from all
resulting packages that match any of the patterns is printed.
prog --version --version_packages=CGI
prog --version --version_packages=CGI,Template
This also cuts down on the miscellaneous
modules (and pragmas) which might have cluttered up your view
of the version information you were interested in.
If you really wish to see version information for all
modules, use the --version=all option.
( run in 2.457 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )