view release on metacpan or  search on metacpan

lib/App/Options.pm  view on Meta::CPAN

                    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) {
        $exit_status = 0;
    }
    #print STDERR "12 option_defs [", join("|", sort keys %$option_defs), "]\n" if ($prefix eq "/usr");

    #################################################################
    # These are the actual Perl regular expressions which match
    # numbers.  The regexes we use are approximately correct.
    #################################################################
    # \d(_?\d)*(\.(\d(_?\d)*)?)?[Ee][\+\-]?(\d(_?\d)*)  12 12.34 12.
    # \.\d(_?\d)*[Ee][\+\-]?(\d(_?\d)*)                 .34
    # 0b[01](_?[01])*
    # 0[0-7](_?[0-7])*
    # 0x[0-9A-Fa-f](_?[0-9A-Fa-f])*

    my ($type);
    if ($option_defs) {
        @vars = (sort keys %$option_defs);
        foreach $var (@vars) {
            $type = $option_defs->{$var}{type};
            next if (!$type);  # nothing to validate against
            $value = $values->{$var};
            next if (! defined $value);
            if ($type eq "integer") {
                if ($value !~ /^-?[0-9_]+$/) {
                    $exit_status = 1;
                    print "Error: \"$var\" must be of type \"$type\" (not \"$value\")\n";
                }
            }
            elsif ($type eq "float") {
                if ($value !~ /^-?[0-9_]+\.?[0-9_]*([eE][+-]?[0-9_]+)?$/ &&
                    $value !~ /^-?\.[0-9_]+([eE][+-]?[0-9_]+)?$/) {
                    $exit_status = 1;
                    print "Error: \"$var\" must be of type \"$type\" (not \"$value\")\n";
                }
            }
            elsif ($type eq "string") {
                # anything is OK
            }
            elsif ($type eq "boolean") {
                if ($value !~ /^[01]$/) {
                    $exit_status = 1;
                    print "Error: \"$var\" must be of type \"$type\" (\"0\" or \"1\") (not \"$value\")\n";
                }
            }
            elsif ($type eq "date") {
                if ($value !~ /^[0-9]{4}-[01][0-9]-[0-3][0-9]$/) {
                    $exit_status = 1;
                    print "Error: \"$var\" must be of type \"$type\" (format \"YYYY-MM-DD\") (not \"$value\")\n";
                }
            }
            elsif ($type eq "datetime") {
                if ($value !~ /^[0-9]{4}-[01][0-9]-[0-3][0-9] [0-2][0-9]:[0-5][0-9]:[0-5][0-9]$/) {
                    $exit_status = 1;
                    print "Error: \"$var\" must be of type \"$type\" (format \"YYYY-MM-DD HH:MM:SS\") (not \"$value\")\n";
                }
            }
            elsif ($type eq "time") {
                if ($value !~ /^[0-2][0-9]:[0-5][0-9]:[0-5][0-9]$/) {
                    $exit_status = 1;
                    print "Error: \"$var\" must be of type \"$type\" (format \"HH:MM:SS\") (not \"$value\")\n";
                }
            }
            elsif ($type =~ m!^/(.*)/$!) {
                $regexp = $1;
                if ($value !~ /$regexp/) {
                    $exit_status = 1;
                    print "Error: \"$var\" must match \"$type\" (not \"$value\")\n";
                }
            }
        }
        foreach $var (@vars) {
            next if (!$option_defs->{$var}{required} || defined $values->{$var});
            $exit_status = 1;
            print "Error: \"$var\" is a required option but is not defined\n";
        }
    }

    #print STDERR "13 option_defs [", join("|", sort keys %$option_defs), "]\n" if ($prefix eq "/usr");
    if ($exit_status >= 0) {
        if ($init_args->{print_usage}) {

lib/App/Options.pm  view on Meta::CPAN

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

 prog --version=all --version_packages=CGI,Template

=head2 Help and Validations

If the "-?" or "--help" options were set on the command line,
the usage statement is printed, and the program is exited.

Then each of the options which is defined may be validated.

If an option is designated as "required", its value must be
defined somewhere (although it may be the empty string).
(If it is also required to be a non-empty string, a regex
may be provided for the type, i.e. type => "/./".)

If an option is designated as having a "type", its value
must either be undefined or match a specific regular expression.

    Type       Regular Expression
    =========  =========================================
    string     (any)
    integer    /^-?[0-9_]+$/
    float      /^-?[0-9_]+\.?[0-9_]*([eE][+-]?[0-9_]+)?$/
          (or) /^-?\.[0-9_]+([eE][+-]?[0-9_]+)?$/
    boolean    /^[01]$/
    date       /^[0-9]{4}-[01][0-9]-[0-3][0-9]$/
    datetime   /^[0-9]{4}-[01][0-9]-[0-3][0-9] [0-2][0-9]:[0-5][0-9]:[0-5][0-9]$/
    time       /^[0-2][0-9]:[0-5][0-9]:[0-5][0-9]$/
    /regexp/   /regexp/

Note that an arbitrary regular expression may be designated
as the "type" by enclosing it in slashes (i.e. "/^[YN]$/").

If the options fail any of the "required" or "type" validation
tests, the App::Options::print_usage() function is called
to print out a usage statement and the program is exited.

=head1 USAGE TUTORIAL

=head2 Getting Started

Create a perl program called "demo1".

    #!/usr/bin/perl
    use App::Options;
    print "Wow. Here are the options...\n";
    foreach (sort keys %App::options) {  # options appear here!
        printf("%-20s => %s\n", $_, $App::options{$_});
    }

Run it different kinds of ways to see how it responds.

    demo1
    demo1 -x
    demo1 -x --verbose
    demo1 --x -verbose
    demo1 -x=5 --verbose=10 --foo=bar
    demo1 --help
    demo1 -x=8 --help
    demo1 -?
    demo1 --debug_options -?
    demo1 -x=5 --verbose=10 --foo=bar --debug_options -?

    demo1 --version
    demo1 --version --version_packages=CGI

Now create a copy of the program.

    cp demo1 demo2