Getopt-Euclid-0.4.6000755001750001750 014446775743 14114 5ustar00davidpdavidp000000000000README100644001750001750 12470214446775743 15123 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6NAME Getopt::Euclid - Executable Uniform Command-Line Interface Descriptions VERSION This document describes Getopt::Euclid version 0.4.5 SYNOPSIS use Getopt::Euclid; if ($ARGV{-i}) { print "Interactive mode...\n"; } for my $x (0..$ARGV{-size}{h}-1) { for my $y (0..$ARGV{-size}{w}-1) { do_something_with($x, $y); } } __END__ =head1 NAME yourprog - Your program here =head1 VERSION This documentation refers to yourprog version 1.9.4 =head1 USAGE yourprog [options] -s[ize]=x -o[ut][file] =head1 REQUIRED ARGUMENTS =over =item -s[ize]=x Specify size of simulation =for Euclid: h.type: int > 0 h.default: 24 w.type: int >= 10 w.default: 80 =item -o[ut][file] Specify output file =for Euclid: file.type: writable file.default: '-' =back =head1 OPTIONS =over =item -i Specify interactive simulation =item -l[[en][gth]] Length of simulation. The default is l.default =for Euclid: l.type: int > 0 l.default: 99 =item --debug [] Set the log level. Default is log_level.default but if you provide --debug, then it is log_level.opt_default. =for Euclid: log_level.type: int log_level.default: 0 log_level.opt_default: 1 =item --version =item --usage =item --help =item --man Print the usual program information =back Remainder of documentation starts here... =head1 AUTHOR Damian Conway (DCONWAY@CPAN.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2005, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) DESCRIPTION Getopt::Euclid uses your program's own POD documentation to create a powerful command-line argument parser. This ensures that your program's documented interface and its actual interface always agree. The created command-line argument parser includes many features such as argument type checking, required arguments, exclusive arguments, optional arguments with default values, automatic usage message, ... To use the module, simply write the following at the top of your program: use Getopt::Euclid; This will cause Getopt::Euclid to be require'd and its import method will be called. It is important that the import method be allowed to run, so do not invoke Getopt::Euclid in the following manner: # Will not work use Getopt::Euclid (); When the module is loaded within a regular Perl program, it will: 1. locate any POD in the same *.pl file or its associated *.pod file. 2. extract information from that POD, most especially from the =head1 REQUIRED ARGUMENTS and =head1 OPTIONS sections, 3. build a parser that parses the arguments and options the POD specifies, 4. remove the command-line arguments from @ARGV and parse them, and 5. put the results in the global %ARGV variable (or into specifically named optional variables, if you request that -- see "Exporting option variables"). As a special case, if the module is loaded within some other module (i.e. from within a .pm file), it still locates and extracts POD information, but instead of parsing @ARGV immediately, it caches that information and installs an import() subroutine in the caller module. This new import() acts just like Getopt::Euclid's own import, except that it adds the POD from the caller module to the POD of the callee. All of which just means you can put some or all of your CLI specification in a module, rather than in the application's source file. See "Module interface" for more details. INTERFACE Program interface You write: use Getopt::Euclid; and your command-line is parsed automagically. Module interface import() You write: use Getopt::Euclid; and your module will then act just like Getopt::Euclid (i.e. you can use your module instead of Getopt::Euclid>, except that your module's POD will also be prepended to the POD of any module that loads yours. In other words, you can use Getopt::Euclid in a module to create a standard set of CLI arguments, which can then be added to any application simply by loading your module. To accomplish this trick Getopt::Euclid installs an import() subroutine in your module. If your module already has an import() subroutine defined, terrible things happen. So do not do that. You may also short-circuit the import method within your calling program to have the POD from several modules included for argument parsing. use Module1::Getopt (); # No argument parsing use Module2::Getopt (); # No argument parsing use Getopt::Euclid; # Arguments parsed process_args() Alternatively, to parse arguments from a source different from @ARGV, use the process_args() subroutine. use Getopt::Euclid qw(:defer); my @args = ( '-in', 'file.txt', '-out', 'results.txt' ); Getopt::Euclid->process_args(\@args); If you want to use the :minimal or :vars mode in this type of scenario, you can pass extra options to process_args(): use Getopt::Euclid qw(:defer); my @args = ( '-in', 'file.txt', '-out', 'results.txt' ); Getopt::Euclid->process_args(\@args, {-minimal => 1, -vars => 'prefix_'}); This is particularly when you plan on processing POD manually. process_pods() Similarly, to parse argument specifications from a source different than the current script (and its dependencies), use the process_pods() subroutine. use Getopt::Euclid (); my @pods = ( 'script.pl', 'Module.pm' ); $Getopt::Euclid::MAN = Getopt::Euclid->process_pods(\@pods, {-strict => 1}); my @args = ( '-in', 'file.txt', '-out', 'results.txt' ); Getopt::Euclid->process_args(\@args); By default, this method will look for .pod files associated with the given .pl and .pm files and use these .pod files preferentially when available. Set -strict to 1 to only use the given files. POD interface This is where all the action is. POD markup can be placed in a .pod file that has the same prefix as the corresponding Perl file. Alternatively, POD can be inserted anywhere in the Perl code, but is typically added either after an __END__ statement (like in the SYNOPSIS), or interspersed in the code: use Getopt::Euclid; =head1 NAME yourprog - Your program here =head1 REQUIRED ARGUMENTS =over =item -s[ize]=x Specify size of simulation =for Euclid: h.type: int > 0 h.default: 24 w.type: int >= 10 w.default: 80 =back =head1 OPTIONS =over =item -i Specify interactive simulation =back =cut # Getopt::Euclid has parsed commandline parameters and stored them in %ARGV if ($ARGV{-i}) { print "Interactive mode...\n"; } for my $x (0..$ARGV{-size}{h}-1) { for my $y (0..$ARGV{-size}{w}-1) { do_something_with($x, $y); } } When Getopt::Euclid is loaded in a non-.pm file, it searches that file for the following POD documentation: =head1 NAME Getopt::Euclid ignores the name specified here. In fact, if you use the standard --help, --usage, --man, --podfile, or --version arguments (see "Standard arguments"), the module replaces the name specified in this POD section with the actual name by which the program was invoked (i.e. with $0). =head1 USAGE Getopt::Euclid ignores the usage line specified here. If you use the standard --help, --usage, --man or --podfile arguments, the module replaces the usage line specified in this POD section with a usage line that reflects the actual interface that the module has constructed. =head1 VERSION Getopt::Euclid extracts the current version number from this POD section. To do that it simply takes the first substring that matches . or _. It also accepts one or more additional trailing . or _, allowing for multi-level and "alpha" version numbers such as: =head1 VERSION This is version 1.2.3 or: =head1 VERSION This is alpha release 1.2_34 You may also specify the version number in your code. However, in order for Getopt::Euclid to properly read it, it must be in a BEGIN block: BEGIN { use version; our $VERSION = qv('1.2.3') } use Getopt::Euclid; Euclid stores the version as $Getopt::Euclid::SCRIPT_VERSION. =head1 REQUIRED ARGUMENTS Getopt::Euclid uses the specifications in this POD section to build a parser for command-line arguments. That parser requires that every one of the specified arguments is present in any command-line invocation. See "Specifying arguments" for details of the specification syntax. The actual headings that Getopt::Euclid can recognize here are: =head1 [STANDARD|STD|PROGRAM|SCRIPT|CLI|COMMAND[-| ]LINE] [REQUIRED|MANDATORY] [PARAM|PARAMETER|ARG|ARGUMENT][S] Caveat: Do not put additional subheadings (=headX) inside the REQUIRED ARGUMENTS section. =head1 OPTIONS Getopt::Euclid uses the specifications in this POD section to build a parser for command-line arguments. That parser does not require that any of the specified arguments is actually present in a command-line invocation. Again, see "Specifying arguments" for details of the specification syntax. Typically a program will specify both REQUIRED ARGUMENTS and OPTIONS, but there is no requirement that it supply both, or either. The actual headings that Getopt::Euclid recognizes here are: =head1 [STANDARD|STD|PROGRAM|SCRIPT|CLI|COMMAND[-| ]LINE] OPTION[AL|S] [PARAM|PARAMETER|ARG|ARGUMENT][S] Caveat: Do not put additional subheadings (=headX) inside the REQUIRED ARGUMENTS section. =head1 COPYRIGHT Getopt::Euclid prints this section whenever the standard --version option is specified on the command-line. The actual heading that Getopt::Euclid recognizes here is any heading containing any of the words "COPYRIGHT", "LICENCE", or "LICENSE". Specifying arguments Each required or optional argument is specified in the POD in the following format: =item ARGUMENT_STRUCTURE ARGUMENT_DESCRIPTION =for Euclid: ARGUMENT_OPTIONS PLACEHOLDER_CONSTRAINTS Argument structure * Each argument is specified as an =item. * Any part(s) of the specification that appear in square brackets are treated as optional. * Any parts that appear in angle brackets are placeholders for actual values that must be specified on the command-line. * Any placeholder that is immediately followed by ... may be repeated as many times as desired. * Any whitespace in the structure specifies that any amount of whitespace (including none) is allowed at the same position on the command-line. * A vertical bar indicates the start of an alternative variant of the argument. For example, the argument specification: =item -i[n] [=] | --from indicates that any of the following may appear on the command-line: -idata.txt -i data.txt -i=data.txt -i = data.txt -indata.txt -in data.txt -in=data.txt -in = data.txt --from data.text as well as any other combination of whitespacing. Any of the above variations would cause all three of: $ARGV{'-i'} $ARGV{'-in'} $ARGV{'--from'} to be set to the string 'data.txt'. You could allow the optional = to also be an optional colon by specifying: =item -i[n] [=|:] Optional components may also be nested, so you could write: =item -i[n[put]] [=] which would allow -i, -in, and -input as synonyms for this argument and would set all three of $ARGV{'-i'}, $ARGV{'-in'}, and $ARGV{'-input'} to the supplied file name. The point of setting every possible variant within %ARGV is that this allows you to use a single key (say $ARGV{'-input'}, regardless of how the argument is actually specified on the command-line. Repeatable arguments Normally Getopt::Euclid only accepts each specified argument once, the first time it appears in @ARGV. However, you can specify that an argument may appear more than once, using the repeatable option: =item file= =for Euclid: repeatable When an argument is marked repeatable the corresponding entry of %ARGV will not contain a single value, but rather an array reference. If the argument also has "Multiple placeholders", then the corresponding entry in %ARGV will be an array reference with each array entry being a hash reference. Boolean arguments If an argument has no placeholders it is treated as a boolean switch and its entry in %ARGV will be true if the argument appeared in @ARGV. For a boolean argument, you can also specify variations that are false, if they appear. For example, a common idiom is: =item --print Print results =item --noprint Do not print results These two arguments are effectively the same argument, just with opposite boolean values. However, as specified above, only one of $ARGV{'--print'} and $ARGV{'--noprint'} will be set. As an alternative you can specify a single argument that accepts either value and sets both appropriately: =item --[no]print [Do not] print results =for Euclid: false: --noprint With this specification, if --print appears in @ARGV, then $ARGV{'--print'} will be true and $ARGV{'--noprint'} will be false. On the other hand, if --noprint appears in @ARGV, then $ARGV{'--print'} will be false and $ARGV{'--noprint'} will be true. The specified false values can follow any convention you wish: =item [+|-]print =for Euclid: false: -print or: =item -report[_no[t]] =for Euclid: false: -report_no[t] et cetera. Multiple placeholders An argument can have two or more placeholders: =item -size The corresponding command line argument would then have to provide two values: -size 24 80 Multiple placeholders can optionally be separated by literal characters (which must then appear on the command-line). For example: =item -size x would then require a command-line of the form: -size 24x80 If an argument has two or more placeholders, the corresponding entry in %ARGV becomes a hash reference, with each of the placeholder names as one key. That is, the above command-line would set both $ARGV{'-size'}{'h'} and $ARGV{'-size'}{'w'}. Optional placeholders Placeholders can be specified as optional as well: =item -size [] This specification then allows either: -size 24 or: -size 24 80 on the command-line. If the second placeholder value is not provided, the corresponding $ARGV{'-size'}{'w'} entry is set to undef. See also "Placeholder defaults". Unflagged placeholders If an argument consists of a single placeholder with no "flag" marking it: =item then the corresponding entry in %ARG will have a key the same as the placeholder (including the surrounding angle brackets): if ($ARGV{''} eq '-') { $fh = \*STDIN; } The same is true for any more-complicated arguments that begin with a placeholder: =item [x ] The only difference in the more-complex cases is that, if the argument has any additional placeholders, the entire entry in %ARGV becomes a hash: my $total_size = $ARGV{''}{'h'} * $ARGV{''}{'w'} Note that, as in earlier multi-placeholder examples, the individual second- level placeholder keys do not retain their angle-brackets. Repeated placeholders Any placeholder that is immediately followed by ..., like so: =item -lib ... =for Euclid: file.type: readable will match at least once, but as many times as possible before encountering the next argument on the command-line. This allows one to specify multiple values for an argument, for example: -lib file1.txt file2.txt An unconstrained repeated unflagged placeholder (see "Placeholder constraints" and "Unflagged placeholders") will consume the rest of the command-line, and so should be specified last in the POD =item -n =item ... =for Euclid: offset.type: 0+int and on the command-line: -n foobar 1 5 0 23 If a placeholder is repeated, the corresponding entry in %ARGV will then be an array reference, with each individual placeholder match in a separate element. For example: for my $lib (@{ $ARGV{'-lib'} }) { add_lib($lib); } warn "First offset is: $ARGV{''}[0]"; my $first_offset = shift @{ $ARGV{''} }; Placeholder constraints You can specify that the value provided for a particular placeholder must satisfy a particular set of restrictions by using a =for Euclid block. For example: =item -size x =for Euclid: h.type: integer w.type: integer specifies that both the and must be given integers. You can also specify an operator expression after the type name: =for Euclid: h.type: integer > 0 w.type: number <= 100 specifies that has to be given an integer that is greater than zero, and that has to be given a number (not necessarily an integer) that is no more than 100. These type constraints have two alternative syntaxes: PLACEHOLDER.type: TYPE BINARY_OPERATOR EXPRESSION as shown above, and the more general: PLACEHOLDER.type: TYPE [, EXPRESSION_INVOLVING(PLACEHOLDER)] Using the second syntax, you could write the previous constraints as: =for Euclid: h.type: integer, h > 0 w.type: number, w <= 100 In other words, the first syntax is just sugar for the most common case of the second syntax. The expression can be as complex as you wish and can refer to the placeholder as many times as necessary: =for Euclid: h.type: integer, h > 0 && h < 100 w.type: number, Math::is_prime(w) || w % 2 == 0 Note that the expressions are evaluated in the package main namespace, so it is important to qualify any subroutines that are not in that namespace. Furthermore, any subroutines used must be defined (or loaded from a module) before the use Getopt::Euclid statement. You can also use constraints that involve variables. You must use the :defer mode and the variables must be globally accessible: use Getopt::Euclid qw(:defer); our $MIN_VAL = 100; Getopt::Euclid->process_args(\@ARGV); __END__ =head1 OPTIONS =over =item --magnitude =for Euclid magnitude.type: number, magnitude > $MIN_VAL =back Standard placeholder types Getopt::Euclid recognizes the following standard placeholder types: Name Placeholder value... Synonyms ============ ==================== ================ integer ...must be an integer int i +integer ...must be a positive +int +i integer (same as: integer > 0) 0+integer ...must be a positive 0+int 0+i integer or zero (same as: integer >= 0) number ...must be an number num n +number ...must be a positive +num +n number (same as: number > 0) 0+number ...must be a positive 0+num 0+n number or zero (same as: number >= 0) string ...may be any string str s (default type) readable ...must be the name input in of a readable file writeable ...must be the name writable output out of a writeable file (or of a non-existent file in a writeable directory) // ...must be a string matching the specified pattern Since regular expressions are supported, you can easily match many more type of strings for placeholders by using the regular expressions available in Regexp::Common. If you do that, you may want to also use custom placeholder error messages (see "Placeholder type errors") since the messages would otherwise not be very informative to users. use Regexp::Common qw /zip/; use Getopt::Euclid; ... =item -p Enter your postcode here =for Euclid: postcode.type: /$RE{zip}{France}/ postcode.type.error: must be a valid ZIP code Placeholder type errors If a command-line argument's placeholder value does not satisify the specified type, an error message is automatically generated. However, you can provide your own message instead, using the .type.error specifier: =for Euclid: h.type: integer, h > 0 && h < 100 h.type.error: must be between 0 and 100 (not h) w.type: number, Math::is_prime(w) || w % 2 == 0 w.type.error: Cannot use w for (must be an even prime number) Whenever an explicit error message is provided, any occurrence within the message of the placeholder's unbracketed name is replaced by the placeholder's value (just as in the type test itself). Placeholder defaults You can also specify a default value for any placeholders that are not given values on the command-line (either because their argument is not provided at all, or because the placeholder is optional within the argument). For example: =item -size [x] Set the size of the simulation =for Euclid: h.default: 24 w.default: 80 This ensures that if no value is supplied: -size 20 then $ARGV{'-size'}{'w'} is set to 80. Likewise, of the -size argument is omitted entirely, both $ARGV{'-size'}{'h'} and $ARGV{'-size'}{'w'} are set to their respective default values However, Getopt::Euclid also supports a second type of default, optional defaults, that apply only to flagged, optional placeholders. For example: =item --debug [] Set the log level =for Euclid: log_level.type: int log_level.default: 0 log_level.opt_default: 1 This ensures that if the option --debug is not specified, then $ARGV{'--debug'} is set to 0, the regular default. But if no value is supplied: --debug then $ARGV{'--debug'} is set to 1, the optional default. The default value can be any valid Perl compile-time expression: =item -pi= =for Euclid: pi value.default: atan2(0,-1) You can refer to an argument default or optional default value in its POD entry as shown below: =item -size [x] Set the size of the simulation [default: h.default x w.default] =for Euclid: h.default: 24 w.default: 80 =item --debug Set the debug level. The default is level.default if you supply --debug but omit a value. =for Euclid: level.opt_default: 3 Just like for "Placeholder constraints", you can also use variables to define default values. You must use the :defer mode and the variables must be globally accessible: use Getopt::Euclid qw(:defer); Getopt::Euclid->process_args(\@ARGV); __END__ =head1 OPTIONS =over =item --home Your project home. When omitted, this defaults to the location stored in the HOME environment variable. =for Euclid home.default: $ENV{'HOME'} =back Exclusive placeholders Some arguments can be mutually exclusive. In this case, it is possible to specify that a placeholder excludes a list of other placeholders, for example: =item -height Set the desired height =item -width Set the desired width =item -volume Set the desired volume =for Euclid: v.excludes: h, w v.excludes.error: Either set the volume or the height and weight Specifying both placeholders at the same time on the command-line will generate an error. Note that the error message can be customized, as illustrated above. When using exclusive arguments that have default values, the default value of the placeholder with the .excludes statement has precedence over any other placeholders. Argument cuddling Getopt::Euclid allows any "flag" argument to be "cuddled". A flag argument consists of a single non- alphanumeric character, followed by a single alpha-numeric character: =item -v =item -x =item +1 =item =z Cuddling means that two or more such arguments can be concatenated after a single common non-alphanumeric. For example: -vx Note, however, that only flags with the same leading non-alphanumeric can be cuddled together. Getopt::Euclid would not allow: -vxz This is because cuddling is recognized by progressively removing the second character of the cuddle. In other words: -vxz becomes: -v -xz which becomes: -v -x z which will fail, unless a z argument has also been specified. On the other hand, if the argument: =item -e had been specified, the module would accept: -vxe'print time' as a cuddled version of: -v -x -e'print time' Exporting option variables By default, the module only stores arguments into the global %ARGV hash. You can request that options are exported as variables into the calling package using the special ':vars' specifier: use Getopt::Euclid qw( :vars ); That is, if your program accepts the following arguments: -v --mode --auto-fudge (repeatable) --also ... --size x --multiply x (repeatable) Then these variables will be exported $ARGV_v $ARGV_mode $ARGV_infile $ARGV_outfile @ARGV_auto_fudge @ARGV_also %ARGV_size # With entries $ARGV_size{w} and $ARGV_size{h} @ARGV_multiply # With entries that are hashref similar to \%ARGV_size For options that have multiple variants, only the longest variant is exported. The type of variable exported (scalar, hash, or array) is determined by the type of the corresponding value in %ARGV. Command-line flags and arguments that take single values will produce scalars, arguments that take multiple values will produce hashes, and repeatable arguments will produce arrays. If you do not like the default prefix of "ARGV_", you can specify your own, such as "opt_", like this: use Getopt::Euclid qw( :vars ); The major advantage of using exported variables is that any misspelling of argument variables in your code will be caught at compile-time by use strict. Standard arguments Getopt::Euclid automatically provides four standard arguments to any program that uses the module. The behaviours of these arguments are "hard- wired" and cannot be changed, not even by defining your own arguments of the same name. The standard arguments are: --usage usage() The --usage argument causes the program to print a short usage summary and exit. The Getopt::Euclid-usage()> subroutine provides access to the string of this message. --help help() The --help argument causes the program to take a longer usage summary (with a full list of required and optional arguments) provided in POD format by help(), convert it to plaintext, display it and exit. The message is paged using IO::Pager::Page (or IO::Page) if possible. --man man() The --man argument causes the program to take the POD documentation for the program, provided by man(), convert it to plaintext, display it and exit. The message is paged using IO::Pager::Page (or IO::Page) if possible. --podfile podfile() The --podfile argument is provided for authors. It causes the program to take the POD manual from man(), write it in a .pod file with the same base name as the program, display the name of the output file and exit. These actions can also be executed by calling the podfile() subroutine.This argument is not really a standard argument, but it is useful if the program's POD is to be passed to a POD converter because, among other things, any default value specified is interpolated and replaced by its value in the .pod file, contrary to in the program's .pl file. If you want to automate the creation of a POD file during the build process, you can edit you Makefile.PL or Build.PL file and add these lines: my @args = ($^X, '-Ilib', '/path/to/script', '--podfile'); system(@args) == 0 or die "System call to '@args' failed:\n$?\n"; If you use Module::Install to bundle your script, you might be interested in using Module::Install::PodFromEuclid to include the --podfile step into the installation process. --version version() The --version argument causes the program to print the version number of the program (as specified in the =head1 VERSION section of the POD) and any copyright information (as specified in the =head1 COPYRIGHT POD section) and then exit. The Getopt::Euclid-version()> subroutine provides access to the string of this message. Minimalist keys By default, the keys of %ARGV will match the program's interface exactly. That is, if your program accepts the following arguments: -v --mode --auto-fudge Then the keys that appear in %ARGV will be: '-v' '--mode' '' '' '--auto-fudge' In some cases, however, it may be preferable to have Getopt::Euclid set up those hash keys without "decorations". That is, to have the keys of %ARGV be simply: 'v' 'mode' 'infile' 'outfile' 'auto_fudge' You can arrange this by loading the module with the special ':minimal_keys' specifier: use Getopt::Euclid qw( :minimal_keys ); Note that, in rare cases, using this mode may cause you to lose data (for example, if the interface specifies both a --step and a option). The module throws an exception if this happens. Deferring argument parsing In some instances, you may want to avoid the parsing of arguments to take place as soon as your program is executed and Getopt::Euclid is loaded. For example, you may need to examine @ARGV before it is processed (and emptied) by Getopt::Euclid. Or you may intend to pass your own arguments manually only using process_args(). To defer the parsing of arguments, use the specifier ':defer': use Getopt::Euclid qw( :defer ); # Do something... Getopt::Euclid->process_args(\@ARGV); DIAGNOSTICS Compile-time diagnostics The following diagnostics are mainly caused by problems in the POD specification of the command-line interface: Getopt::Euclid was unable to access POD Something is horribly wrong. Getopt::Euclid was unable to read your program to extract the POD from it. Check your program's permissions, though it is a mystery how perl was able to run the program in the first place, if it is not readable. .pm file cannot define an explicit import() when using Getopt::Euclid You tried to define an import() subroutine in a module that was also using Getopt::Euclid. Since the whole point of using Getopt::Euclid in a module is to have it build an import() for you, supplying your own import() as well defeats the purpose. Unknown specification: %s You specified something in a =for Euclid section that Getopt::Euclid did not understand. This is often caused by typos, or by reversing a placeholder.type or placeholder.default specification (that is, writing type.placeholder or default.placeholder instead). Unknown type (%s) in specification: %s Unknown .type constraint: %s Both these errors mean that you specified a type constraint that Getopt::Euclid did not recognize. This may have been a typo: =for Euclid count.type: inetger or else the module simply does not know about the type you specified: =for Euclid count.type: complex See "Standard placeholder types" for a list of types that Getopt::Euclid does recognize. Invalid .type constraint: %s You specified a type constraint that is not valid Perl. For example: =for Euclid max.type: integer not equals 0 instead of: =for Euclid max.type: integer != 0 Invalid .default value: %s You specified a default value that is not valid Perl. For example: =for Euclid curse.default: *$@!& instead of: =for Euclid curse.default: '*$@!&' Invalid .opt_default value: %s Same as previous diagnostic, but for optional defaults. Invalid reference to field %s.default in argument description: %s You referred to a default value in the description of an argument, but there is no such default. It may be a typo, or you may be referring to the default value for a different argument, e.g.: =item -a An optional age. Default: years.default =for Euclid age.default: 21 instead of: =item -a An optional age. Default: age.default =for Euclid age.default: 21 Invalid reference to field %s.opt_default in argument description: %s Same as previous diagnostic, but for optional defaults. Invalid .opt_default constraint: Placeholder <%s> must be optional You specified an optional default but the placeholder that it affects is not an optional placeholder. For example: =item -l[[en][gth]] =for Euclid: l.opt_default: 123 instead of: =item -l[[en][gth]] [] =for Euclid: l.opt_default: 123 Invalid .opt_default constraint: Parameter %s must have a flag You specified an optional default but the parameter that it affects is unflagged. For example: =item =for Euclid: l.opt_default: 123 instead of: =item -l [] =for Euclid: l.opt_default: 123 Invalid .excludes value for variable %s: <%s> does not exist You specified to exclude a variable that was not seen in the POD. Make sure that this is not a typo. Invalid constraint: %s (No <%s> placeholder in argument: %s) You attempted to define a .type constraint for a placeholder that did not exist. Typically this is the result of the misspelling of a placeholder name: =item -foo =for Euclid: baz.type: integer or a =for Euclid: that has drifted away from its argument: =item -foo =item -verbose =for Euclid: bar.type: integer Getopt::Euclid loaded a second time You tried to load the module twice in the same program. Getopt::Euclid does not work that way. Load it only once. Unknown mode ('%s') The only argument that a use Getopt::Euclid command accepts is ':minimal_keys' (see "Minimalist keys"). You specified something else instead (or possibly forgot to put a semicolon after use Getopt::Euclid). Internal error: minimalist mode caused arguments '%s' and '%s' to clash Minimalist mode removes certain characters from the keys hat are returned in %ARGV. This can mean that two command-line options (such as --step and ) map to the same key (i.e. 'step'). This in turn means that one of the two options has overwritten the other within the %ARGV hash. The program developer should either turn off ':minimal_keys' mode within the program, or else change the name of one of the options so that the two no longer clash. Run-time diagnostics The following diagnostics are caused by problems in parsing the command-line Missing required argument(s): %s At least one argument specified in the REQUIRED ARGUMENTS POD section was not present on the command-line. Invalid %s argument. %s must be %s but the supplied value (%s) is not. Getopt::Euclid recognized the argument you were trying to specify on the command-line, but the value you gave to one of that argument's placeholders was of the wrong type. Unknown argument: %s Getopt::Euclid did not recognize an argument you were trying to specify on the command-line. This is often caused by command-line typos or an incomplete interface specification. CONFIGURATION AND ENVIRONMENT Getopt::Euclid requires no configuration files or environment variables. DEPENDENCIES * version * Pod::Select * Pod::PlainText * File::Basename * File::Spec::Functions * List::Util * Text::Balanced * IO::Pager::Page (recommended) INCOMPATIBILITIES Getopt::Euclid may not work properly with POD in Perl files that have been converted into an executable with PerlApp or similar software. A possible workaround may be to move the POD to a __DATA__ section or a separate .pod file. BUGS AND LIMITATIONS Please report any bugs or feature requests via GitHub issues Pull requests to fix bugs / add features welcome! GitHub repo git clone git@github.com:bigpresh/Getopt-Euclid.git The RT queue still exists but GitHub issues are preferred due to their integration with pull requests etc. AUTHOR Damian Conway Florent Angly David Precious (BIGPRESH) LICENCE AND COPYRIGHT Copyright (c) 2005, Damian Conway . All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. Changes100644001750001750 2176014446775743 15516 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6Revision history for Getopt-Euclid 0.4.6 2023-06-28 - David Precious (BIGPRESH) taking on maintainership - Avoid test failures on perls without '.' in @INC (reported by TODDR in RT#127234) - Minor wording change (reported by Debian team in RT #95412) 0.4.5 2014-03-21 - Fixed bug when parsing arguments with missing variable (reported by Torbjørn Lindahl) 0.4.4 2013-08-21 - Fixed bug with Bleadperl v5.19.2-257-gc30fc27 (bug #87804, reported by Andreas Koenig, patch by Dave Mitchell) - New process_pod() method to specify arbitrary list of POD files to parse (bug #87592, requested by zdm) - More optional default checks 0.4.3 2013-07-22 - Added a check for .default and .opt_default references in argument description - Speed optimizations 0.4.2 2013-07-17 - Ignore POD from .pod files generated by earlier versions of Getopt::Euclid 0.4.1 2013-07-17 - Support for default values defined based on variables 0.4.0 2013-02-08 - Fixed issue with option values that are substrings of others (bug #76728, reported by Igor Kleshchevich, patch by James F Hester) - Update of META.yml (bug #83221) 0.3.9 2012-12-12 - Fixed issues in mutually exclusive arguments that have default values (RT bug #81630 again) 0.3.8 2012-12-03 - Messages respect order of user options (fixes RT bug #81630) - Show --man and --usage in help message - Prevent a trailing whitespace in --help usage string 0.3.7 2012-08-08 - Fixed too enthusiastic variable interpolation in Euclid specs (RT bug #78854) - Fixed bug tracker URL (credits to Kent Fredric) 0.3.6 2012-07-31 - Fixed occasional non-minimized entry when using :minimal_keys specifier 0.3.5 2012-02-20 - Removed extraneous \E (patch by Todd Rinaldo) - Better handling of quoted arguments (RT bug #49525, reported by Ken Galinsky) 0.3.4 2012-02-12 - New standard argument --podfile to write the manual in a .pod file - Fixed issue where the NAME and VERSION sections appeared as a verbatim section (which podchecker complains about) - Always convert POD to text when calling help() and man() - help() is now paged if IO::Pager::Page is installed - Dependency changes: Pod::Simple::Text replaces Pod::Text Pod::Simple::Text is required instead of recommended, IO::Pager::Page is recommended 0.3.3 2012-01-06 - Attempt to extract POD even from files that look binary (might be packaged with pp, perlapp or similar program) 0.3.2 2011-10-28 - Another attempt to make the CPAN indexer happy 0.3.1 2011-10-27 - Changed $VERSION to make the CPAN indexer happy - Export repeatable options with multiple placeholders as an empty arrayref, not as an empty hashref (RT bug #71165, reported by Bill Levering) 0.3.0 2011-09-13 - Reverted feature to match POD head section =head2, =head3 and =head4 because of backward compatibility issue (RT bug #70942) 0.2.9 2011-09-03 - This command does not generate warnings anymore: perl -e 'use Getopt::Euclid; print $Getopt::Euclid::VERSION;' - Required and optional arguments can now be put in a POD head section =head2, =head3 and =head4 for more flexibility 0.2.8 2011-09-02 - Support for optional defaults (RT bug #61438, patch from Paolo Medeo) - Extended the grammar of recognized POD headers for required and optional arguments: [STANDARD|STD|PROGRAM|SCRIPT|CLI|COMMAND[-| ]LINE] [REQUIRED|MANDATORY] [PARAM|PARAMETER|ARG|ARGUMENT][S] [STANDARD|STD|PROGRAM|SCRIPT|CLI|COMMAND[-| ]LINE] OPTION[AL|S] [PARAM|PARAMETER|ARG|ARGUMENT][S] - Usage error message now mentions the --man option in addition to --help 0.2.7 2011-07-12 - Updated dependencies in Build.PL module 0.2.6 2011-07-11 - Bugfix: corrected a .pod file finding issue 0.2.5 2011-07-10 - Bugfix for #69324: more efficient and accurate POD extraction using Perl::Tidy - Bugfix for #29301: automatically looking for POD located into .pod files - Bugfix for #69105: file META.yml states which license the module uses - Bugfix for #34200: variables in constraint specifications are read as originating from the 'main' package namespace - Little internal modification to prevent identical placeholders that are present multiple times in the specification to be processed multiple times. - Error messages for arguments that do not validate against the constraints now display the value of variables instead of their name. 0.2.4 2011-06-23 - Default values can now be specified in the POD and displayed in the program documentation - Support for more integer arguments, e.g. scientific notation like 1E8 - Support for arguments that cannot coexist using the 'exclude' keyword - New specifier to defer processing of @ARGV arguments: :defer - New method to pass an arbitrary array of arguments to parsing: process_args - New methods to access the program usage, version, manual and help messages - When a version number is missing from the POD or $main::VERSION, the file time and date are used as version number - The help message now includes --version and is more consistent with the usage message - Bugfix: the options in the help message are no longer randomly sorted - Bugfix: the man page is now properly formed when .pm files that have no POD are use'd - Bugfix: when the --man flag was passed and the script name was, e.g. 'myprog' instead of 'myprog - short description', an undef warning was issued - Bugfix: when the --help flag was passed and either no required arguments or no optional arguments were specified in the POD, an undef warning was issued - Bugfix: the POD parsing mechanism now removes rogue PODs hidden inside variables and other Perl-quoted strings - Bugfix for #34195: addresses compatibility with Perl compiling (syntax check) - Bugfix for #34207: .type.error is now taken into account properly - Bugfix for #38461: file path that uses the volume and dir - Bugfix for #34199: new subroutine _check_name() verifies that argument name specifications are well-balanced with <> brackets 0.2.3 Tue Sep 14 2010 - #61321 - made tests that require writeable files set own properties to 644 0.2.2 Thu Sep 9 19:30:55 2010 - #28474 - fixed the way name was being parsed - #35895 - line delimiters converted to newlines - #49524 - fixed way POD parsed so that headers after a =cut get parsed properly - #55259 - created $SCRIPT_VERSION variable containing parsed version - #61039 - don't insert default value for options with optional placeholders where the flag is given but a value for the placeholder is not 0.2.1 Sun May 31 12:57:07 2009 - Removed BEGIN blocks and simply brought the defined variables to the top of the module (thanks Todd) - Update POD to make sure people don't "use Getopt::Euclid ();" - Removed debugger break point (thanks Diab) - Removed no bugs claim in POD 0.2.0 Sat Aug 4 17:22:31 2007 - Added fallback to $main::VERSION if version not specified in Pod (thanks Todd and Thomas) - Added non-zero exit value on bad arg list (thanks Toby) - Changed module behaviour: now removes identified arguments from @ARGV. on successful match (thanks Aran and Tim) - Allowed alternations everywhere (i.e. outside optionals too) - Allowed E and E in option specifiers (thanks Wes) 0.1.0 Thu Nov 2 19:47:05 2006 - Fixed failure to recognize +integer and 0+integer type specification (thanks Ron) - Added quotemeta'ing of regexically special characters (thanks Ron) - Repatched :vars mode to really export all args (thanks again Tim!) 0.0.9 Thu Oct 26 21:18:46 2006 - Patched :vars mode to export all args (thanks Tim!) 0.0.8 Sun Oct 8 12:45:17 2006 - Remove spurious smart comments - Added missing documentation for placeholder misspecification diagnostic - Made contents of validator subs fallback to main:: - Allowed false: flags to be regexes - Fixed readable/writable test for '-' (thanks Thomas) - Added regexes as valid placeholder type constraints 0.0.7 Tue Oct 3 03:54:01 2006 - Added :vars mode (thanks Tim!) - Fixed option names containing dashes. (thanks Tim!) - Fixed minimal matching mode to more accurately detect clashes (thanks Thomas) - Added user-specified type.error messages (thanks Thomas) - Tightened up checking of placeholder type constraints (thanks Tim) 0.0.6 Sun Sep 17 02:48:04 2006 - Removed spurious "compilation failed message" for interface errors (thanks David!) - Added 'repeatable' option (thanks Thomas) 0.0.5 Fri Feb 17 15:52:20 2006 - Changed POD::Text to Pod::Text (curse you, case-independent MacOS X!! ;-) - Fixed erroneous bug report when only syntax checking with perl -c - Fixed bug in license defaults (thanks clpoda!) - Added :minimal_keys mode (thanks Thomas) 0.0.4 Thu Aug 4 18:03:28 2005 - Fixed embarrassing encoding bug (thanks dakkar!) 0.0.3 Sun Jul 24 20:16:17 2005 - Removed need for Smart::Comments 0.0.2 Sat Jul 23 04:37:18 2005 No changes logged 0.0.1 Sun Jan 30 20:42:36 2005 Initial release. t000755001750001750 014446775743 14300 5ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6pod.t100644001750001750 21414446775743 15364 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/t#!perl -T use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); LICENSE100644001750001750 4365614446775743 15240 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6This software is copyright (c) 2023 by David Precious. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2023 by David Precious. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2023 by David Precious. This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End dist.ini100644001750001750 105414446775743 15641 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6name = Getopt-Euclid author = David Precious license = Perl_5 copyright_holder = David Precious copyright_year = 2023 version = 0.4.6 [@Basic] [AutoPrereqs] [ReadmeFromPod] [NextRelease] format = %-6v %{yyyy-MM-dd}d%{ (TRIAL RELEASE)}T [MetaResources] homepage = https://github.com/bigpresh/Getopt-Euclid bugtracker.web = https://github.com/bigpresh/Getopt-Euclid/issues repository.url = git://github.com/bigpresh/Getopt-Euclid.git repository.web = https://github.com/bigpresh/Getopt-Euclid repository.type = git hier.t100644001750001750 722314446775743 15560 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/t#! /usr/bin/env perl # The shebang line above is part of the test BEGIN { $INFILE = $0; $OUTFILE = $0; $LEN = 42; $H = 2; $W = -10; $TIMEOUT = 7; @ARGV = ( '-i', $INFILE, "-out=$OUTFILE", '-lgth', $LEN, 'size', "${H}x${W}", '-v', '--timeout', $TIMEOUT, ); chmod 0644, $0; } use lib '.'; use t::lib::HierDemo; use Test::More 'no_plan'; sub got_arg { my ($key, $val) = @_; is $ARGV{$key}, $val, "Got expected value for $key"; } is keys %ARGV, 14 => 'Right number of args returned'; got_arg -i => $INFILE; got_arg -infile => $INFILE; got_arg -l => $LEN; got_arg -len => $LEN; got_arg -length => $LEN; got_arg -lgth => $LEN; got_arg -o => $OUTFILE; got_arg -ofile => $OUTFILE; got_arg -out => $OUTFILE; got_arg -outfile => $OUTFILE; got_arg -v => 1, got_arg -verbose => 1, is ref $ARGV{'--timeout'}, 'HASH' => 'Hash reference returned for timeout'; is $ARGV{'--timeout'}{min}, $TIMEOUT => 'Got expected value for timeout '; ok !defined $ARGV{'--timeout'}{max} => 'Got expected value for timeout '; is ref $ARGV{size}, 'HASH' => 'Hash reference returned for size'; is $ARGV{size}{h}, $H => 'Got expected value for size '; is $ARGV{size}{w}, $W => 'Got expected value for size '; # Manual should contain POD from .pl and .pm files my $man = < -o= [options] \=head1 OPTIONS \=over \=item size x Specify height and width \=item -l[[en][gth]] Display length [default: 24 ] \=item -v[erbose] Print all warnings \=item --timeout [] [] \=item --version \=item --usage \=item --help \=item --man Print the usual program information \=back \=head1 AUTHOR Damian Conway (damian\@conway.org) \=head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. \=head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) \=head1 REQUIRED ARGUMENTS \=over \=item -i[nfile] [=] Specify input file \=item -o[ut][file]= Specify output file \=back EOS my $man_test = Getopt::Euclid->man(); is $man_test, $man, 'Man page is as expected'; __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 OPTIONS =over =item size x Specify height and width =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: l.type: int > 0 l.default: 24 =item -v[erbose] Print all warnings =item --timeout [] [] =for Euclid: min.type: int max.type: int =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) eval.t100644001750001750 51614446775743 15536 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tBEGIN { $0 = '-e'; } use Test::More 'no_plan'; use_ok Getopt::Euclid; # When running into eval mode, e.g. perl -e 'use Getopt::Euclid', @ARG is empty # but $0 is '-e'. This leads to the warnings: # skipping file: '-e': no matches found # Use of uninitialized value in localtime at lib/Getopt/Euclid.pm line 370. ok 1; META.yml100644001750001750 213714446775743 15451 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6--- abstract: 'Executable Uniform Command-Line Interface Descriptions' author: - 'David Precious ' build_requires: Data::Dumper: '0' Pod::Checker: '0' Test::More: '0' lib: '0' perl: 5.006_001 configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'Dist::Zilla version 6.025, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Getopt-Euclid requires: Carp: '0' File::Basename: '0' File::Spec::Functions: '0' IO::Page: '0' IO::Pager::Page: '0' List::Util: '0' Pod::PlainText: '0' Pod::Select: '0' Symbol: '0' Text::Balanced: '0' perl: 5.006_001 re: '0' strict: '0' version: '0' warnings: '0' resources: bugtracker: https://github.com/bigpresh/Getopt-Euclid/issues homepage: https://github.com/bigpresh/Getopt-Euclid repository: git://github.com/bigpresh/Getopt-Euclid.git version: 0.4.6 x_generated_by_perl: v5.32.1 x_serialization_backend: 'YAML::Tiny version 1.73' x_spdx_expression: 'Artistic-1.0-Perl OR GPL-1.0-or-later' MANIFEST100644001750001750 272214446775743 15331 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.025. Changes Getopt-Euclid/lib/Getopt/Euclid.pm LICENSE MANIFEST META.yml Makefile.PL README dist.ini lib/Getopt/Euclid.pm t/00.load.t t/any_array.t t/bundle.t t/compile.t t/defer.t t/defer_all.t t/empty_ARGV_array.t t/entity_angles.t t/eval.t t/excludes.t t/fail_bad_constraint.t t/fail_bad_default.t t/fail_bad_default_ref.t t/fail_bad_excludes.t t/fail_bad_excludes_2.t t/fail_bad_name.t t/fail_bad_name_2.t t/fail_bad_opt_default.t t/fail_bad_opt_default_2.t t/fail_excludes_msg.t t/fail_minimal_clash.t t/fail_misplaced_type.t t/fail_missing_required.t t/fail_missing_var.t t/fail_missing_var_2.t t/fail_no_spec.t t/fail_quoted_args.t t/fail_type.t t/fail_type_msg.t t/fail_type_msg_2.t t/fail_unknown_arg.t t/fail_unknown_mode.t t/fail_unknown_spec.t t/fail_unknown_spec_2.t t/fail_unknown_type.t t/fail_user_constraint.t t/fail_user_constraint_comma.t t/fail_user_constraint_type.t t/false.t t/hier.t t/hier_2.t t/hier_export.t t/hier_no_pod.t t/ignore_decorations.t t/insert_defaults.t t/lib/HierDemo.pm t/lib/HierDemo.pod t/lib/HierDemo2.pm t/lib/HierDemo2.pod t/minimal.t t/minimal_2.t t/opt_default.t t/pod.t t/pod_cmd_after_cut.t t/pod_coverage.t t/pod_file.pod t/pod_file.t t/quoted_args.t t/quoted_args_2.t t/repeatable.t t/repeated.t t/repeated_2.t t/simple.t t/simple_alternate.t t/simple_shuffle.t t/std_arguments.t t/substr.t t/substr_2.t t/types.t t/types_regex.t t/types_vars.t t/vars_export.t types.t100644001750001750 1421514446775743 16014 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tBEGIN { $INT1 = '123456'; $INT2 = '1e8'; $INT3 = '10E+10'; $INT4 = '0'; $INT5 = '-987654'; $NUM1 = '3'; $NUM2 = '0.1'; $NUM3 = '.1'; $NUM4 = '1.456e156'; $NUM5 = '+1E-01'; $NUM6 = '999.9e-1'; $NUM7 = '0.00'; $NUM8 = '-0.1'; $NUM9 = '-1E-6'; $STR1 = 'asdf'; $STR2 = '"Test me!"'; $IN1 = $0; $IN2 = '.'; $OUT1 = $0; $OUT2 = '.'; @ARGV = ( '-integer' , $INT1, $INT2, $INT3, $INT4, $INT5, '-int' , $INT1, $INT2, $INT3, $INT4, $INT5, '-i' , $INT1, $INT2, $INT3, $INT4, $INT5, '-pos_integer' , $INT1, $INT2, $INT3, '-pos_int' , $INT1, $INT2, $INT3, '-pos_i' , $INT1, $INT2, $INT3, '-zero_integer', $INT1, $INT2, $INT3, $INT4, '-zero_int' , $INT1, $INT2, $INT3, $INT4, '-zero_i' , $INT1, $INT2, $INT3, $INT4, '-number' , $NUM1, $NUM2, $NUM3, $NUM4, $NUM5, $NUM6, $NUM7, $NUM8, $NUM9, '-num' , $NUM1, $NUM2, $NUM3, $NUM4, $NUM5, $NUM6, $NUM7, $NUM8, $NUM9, '-n' , $NUM1, $NUM2, $NUM3, $NUM4, $NUM5, $NUM6, $NUM7, $NUM8, $NUM9, '-zero_number' , $NUM1, $NUM2, $NUM3, $NUM4, $NUM5, $NUM6, $NUM7, '-zero_num' , $NUM1, $NUM2, $NUM3, $NUM4, $NUM5, $NUM6, $NUM7, '-zero_n' , $NUM1, $NUM2, $NUM3, $NUM4, $NUM5, $NUM6, $NUM7, '-pos_number' , $NUM1, $NUM2, $NUM3, $NUM4, $NUM5, $NUM6, '-pos_num' , $NUM1, $NUM2, $NUM3, $NUM4, $NUM5, $NUM6, '-pos_n' , $NUM1, $NUM2, $NUM3, $NUM4, $NUM5, $NUM6, '-string' , $STR1, $STR2, '-str' , $STR1, $STR2, '-s' , $STR1, $STR2, '-readable' , $IN1 , $IN2 , '-input' , $IN1 , $IN2 , '-in' , $IN1 , $IN2 , '-writable' , $OUT1, $OUT2, '-writeable' , $OUT1, $OUT2, '-output' , $OUT1, $OUT2, '-out' , $OUT1, $OUT2, ); chmod 0644, $0; } use Getopt::Euclid; use Test::More 'no_plan'; sub got_args { my ($arr1, $arr2) = @_; for my $i (0 .. $#$arr1) { is $arr1->[$i], $arr2->[$i]; } } is ref $ARGV{'-integer'}, 'ARRAY' => 'Testing integers'; got_args $ARGV{'-integer'}, [$INT1, $INT2, $INT3, $INT4, $INT5]; got_args $ARGV{'-int' }, [$INT1, $INT2, $INT3, $INT4, $INT5]; got_args $ARGV{'-i' }, [$INT1, $INT2, $INT3, $INT4, $INT5]; got_args $ARGV{'-zero_integer'}, [$INT1, $INT2, $INT3, $INT4]; got_args $ARGV{'-zero_int' }, [$INT1, $INT2, $INT3, $INT4]; got_args $ARGV{'-zero_i' }, [$INT1, $INT2, $INT3, $INT4]; got_args $ARGV{'-pos_integer'}, [$INT1, $INT2, $INT3]; got_args $ARGV{'-pos_int' }, [$INT1, $INT2, $INT3]; got_args $ARGV{'-pos_i' }, [$INT1, $INT2, $INT3]; is ref $ARGV{'-number'}, 'ARRAY' => 'Testing numbers'; got_args $ARGV{'-number'}, [$NUM1, $NUM2, $NUM3, $NUM4, $NUM5, $NUM6, $NUM7, $NUM8, $NUM9]; got_args $ARGV{'-num' }, [$NUM1, $NUM2, $NUM3, $NUM4, $NUM5, $NUM6, $NUM7, $NUM8, $NUM9]; got_args $ARGV{'-n' }, [$NUM1, $NUM2, $NUM3, $NUM4, $NUM5, $NUM6, $NUM7, $NUM8, $NUM9]; got_args $ARGV{'-zero_number'}, [$NUM1, $NUM2, $NUM3, $NUM4, $NUM5, $NUM6, $NUM7]; got_args $ARGV{'-zero_num' }, [$NUM1, $NUM2, $NUM3, $NUM4, $NUM5, $NUM6, $NUM7]; got_args $ARGV{'-zero_n' }, [$NUM1, $NUM2, $NUM3, $NUM4, $NUM5, $NUM6, $NUM7]; got_args $ARGV{'-pos_number'}, [$NUM1, $NUM2, $NUM3, $NUM4, $NUM5, $NUM6]; got_args $ARGV{'-pos_num' }, [$NUM1, $NUM2, $NUM3, $NUM4, $NUM5, $NUM6]; got_args $ARGV{'-pos_n' }, [$NUM1, $NUM2, $NUM3, $NUM4, $NUM5, $NUM6]; is ref $ARGV{'-string'}, 'ARRAY' => 'Testing strings'; got_args $ARGV{'-string'}, [$STR1, $STR2]; got_args $ARGV{'-str' }, [$STR1, $STR2]; got_args $ARGV{'-s' }, [$STR1, $STR2]; is ref $ARGV{'-readable'}, 'ARRAY' => 'Testing input/output files'; got_args $ARGV{'-readable'}, [$IN1 , $IN2 ]; got_args $ARGV{'-input'}, [$IN1 , $IN2 ]; got_args $ARGV{'-in'}, [$IN1 , $IN2 ]; got_args $ARGV{'-writable'}, [$OUT1, $OUT2]; got_args $ARGV{'-writeable'}, [$OUT1, $OUT2]; got_args $ARGV{'-output'}, [$OUT1, $OUT2]; got_args $ARGV{'-out'}, [$OUT1, $OUT2]; # type 'regex' tested in file ./t/types_regex.t # comparison to $variables are tested in file ./t/types_vars.t __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 REQUIRED ARGUMENTS =over =item -integer ... =for Euclid: integer.type: integer =item -int ... =for Euclid: int.type: int =item -i ... =for Euclid: i.type: i =item -zero_integer ... =for Euclid: zero_integer.type: 0+integer =item -zero_int ... =for Euclid: zero_int.type: 0+int =item -zero_i ... =for Euclid: zero_i.type: 0+i =item -pos_integer ... =for Euclid: pos_integer.type: +integer =item -pos_int ... =for Euclid: pos_int.type: +int =item -pos_i ... =for Euclid: pos_i.type: +i =item -number ... =for Euclid: number.type: number =item -num ... =for Euclid: num.type: num =item -n ... =for Euclid: n.type: n =item -pos_number ... =for Euclid: pos_number.type: +number =item -pos_num ... =for Euclid: pos_num.type: +num =item -pos_n ... =for Euclid: pos_n.type: +n =item -zero_number ... =for Euclid: zero_number.type: 0+number =item -zero_num ... =for Euclid: zero_num.type: 0+num =item -zero_n ... =for Euclid: zero_n.type: 0+n =item -string ... =for Euclid: string.type: string =item -str ... =for Euclid: str.type: str =item -s ... =for Euclid: s.type: s =item -readable ... =for Euclid: readable.type: readable =item -input ... =for Euclid: input.type: input =item -in ... =for Euclid: in.type: in =item -writable ... =for Euclid: writable.type: writable =item -writeable ... =for Euclid: writeable.type: writeable =item -output ... =for Euclid: output.type: output =item -out ... =for Euclid: out.type: out =back false.t100644001750001750 361714446775743 15726 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tBEGIN { @ARGV = ( "-norequired", "-optionalless", "--unabbr", "-necessary", "--opt", ); } use Getopt::Euclid; use Test::More 'no_plan'; sub got_arg { my ($key, $val) = @_; is $ARGV{$key}, $val, "Got expected value for $key"; } got_arg -norequired => 1; got_arg -required => 0; got_arg -necessary => 1; got_arg -unnecessary => 0; got_arg -optional => 0; got_arg -optionalless => 1; got_arg '--abbr' => 0; got_arg '--abbrev' => 0; got_arg '--abbreviated' => 0; got_arg '--unabbr' => 1; got_arg '--unabbrev' => 1; got_arg '--unabbreviated' => 1; got_arg '--opt' => 1; got_arg '--optout' => undef; __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -[no]required Specify verbosity =for Euclid: false: -norequired =item -[un]necessary Specify verbosity =for Euclid: false: -unnecessary =item --[un]abbr[ev[iated]] Specify verbosity =for Euclid: false: --unabbr false: --unabbrev false: --unabbreviated =back =head1 OPTIONS =over =item -optional[less] Test optionality =for Euclid: false: -optionalless =item --opt Test optionality =for Euclid: false: --optout =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) defer.t100644001750001750 1403614446775743 15736 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tBEGIN { $INFILE = $0; $OUTFILE = $0; $LEN = 42; $H = 2; $W = -10; $TIMEOUT = 7; @ARGV = ( '-i', $INFILE, "-out=$OUTFILE", '-lgth', $LEN, 'size', "${H}x${W}", '-no-fudge', '-v', '--timeout', $TIMEOUT, '-w', 's p a c e s', ); chmod 0644, $0; } use Getopt::Euclid qw( :defer ); use Test::More 'no_plan'; our $STEP1 = 4; our $STEP2 = 3; our $STEPS = { 'extra' => 0.1 }; sub got_arg { my ($key, $val) = @_; is $ARGV{$key}, $val, "Got expected value for $key"; } sub got_arg_exp { my ($key, $val) = @_; my $var_name = "opt_$key"; no strict 'refs'; is ${$var_name}, $val, "Got expected value for $var_name"; } sub not_arg_exp { my ($key, $val) = @_; my $var_name = "opt_$key"; no strict 'refs'; is ${$var_name}, undef, "$var_name should be undefined"; } my @args = @ARGV; my @args2 = @ARGV; # Process arguments, no options is scalar @ARGV, 13 => 'Argument processing was deferred'; is keys %ARGV, 0 => 'Argument processing was deferred'; Getopt::Euclid->process_args(\@ARGV); is scalar @ARGV, 0 => 'Arguments were processed'; is keys %ARGV, 19 => 'Arguments were processed'; got_arg -i => $INFILE; got_arg -infile => $INFILE; got_arg -l => $LEN; got_arg -len => $LEN; got_arg -length => $LEN; got_arg -lgth => $LEN; got_arg -girth => 42; got_arg -o => $OUTFILE; got_arg -ofile => $OUTFILE; got_arg -out => $OUTFILE; got_arg -outfile => $OUTFILE; got_arg '--no-fudge' => 1; got_arg -v => 1, got_arg -verbose => 1, got_arg -w => 's p a c e s'; got_arg '' => 7.3; is ref $ARGV{'--timeout'}, 'HASH' => 'Hash reference returned for timeout'; is $ARGV{'--timeout'}{min}, $TIMEOUT => 'Got expected value for timeout '; is $ARGV{'--timeout'}{max}, -1 => 'Got default value for timeout '; is ref $ARGV{size}, 'HASH' => 'Hash reference returned for size'; is $ARGV{size}{h}, $H => 'Got expected value for size '; is $ARGV{size}{w}, $W => 'Got expected value for size '; %ARGV = (); # Process arguments with minimal keys is scalar @args, 13 => 'Argument processing was deferred'; is keys %ARGV, 0 => 'Argument processing was deferred'; Getopt::Euclid->process_args(\@args, {-minimal_keys => 1}); is scalar @args, 0 => 'Arguments were processed'; is keys %ARGV, 19 => 'Arguments were processed'; got_arg i => $INFILE; got_arg infile => $INFILE; got_arg l => $LEN; got_arg len => $LEN; got_arg length => $LEN; got_arg lgth => $LEN; got_arg girth => 42; got_arg o => $OUTFILE; got_arg ofile => $OUTFILE; got_arg out => $OUTFILE; got_arg outfile => $OUTFILE; got_arg no_fudge => 1; got_arg v => 1, got_arg verbose => 1, got_arg w => 's p a c e s'; got_arg step => 7.3; is ref $ARGV{'timeout'}, 'HASH' => 'Hash reference returned for timeout'; is $ARGV{'timeout'}{min}, $TIMEOUT => 'Got expected value for timeout '; is $ARGV{'timeout'}{max}, -1 => 'Got default value for timeout '; is ref $ARGV{size}, 'HASH' => 'Hash reference returned for size'; is $ARGV{size}{h}, $H => 'Got expected value for size '; is $ARGV{size}{w}, $W => 'Got expected value for size '; %ARGV = (); # Process arguments with variable export is scalar @args2, 13 => 'Argument processing was deferred'; Getopt::Euclid->process_args(\@args2, {-vars => 'opt_'}); is scalar @args2, 0 => 'Arguments were processed'; not_arg_exp i => $INFILE; got_arg_exp infile => $INFILE; not_arg_exp l => $LEN; not_arg_exp len => $LEN; got_arg_exp length => $LEN; not_arg_exp lgth => $LEN; got_arg_exp girth => 42; not_arg_exp o => $OUTFILE; not_arg_exp ofile => $OUTFILE; not_arg_exp out => $OUTFILE; got_arg_exp outfile => $OUTFILE; not_arg_exp v => 1, got_arg_exp verbose => 1, got_arg_exp w => 's p a c e s'; got_arg_exp step => 7.3; is $opt_timeout{min}, $TIMEOUT => 'Got expected value for timeout '; is $opt_timeout{max}, -1 => 'Got default value for timeout '; is $opt_size{h}, $H => 'Got expected value for size '; is $opt_size{w}, $W => 'Got expected value for size '; __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file =for Euclid: file.type: readable file.default: '-' =item -o[ut][file]= Specify output file =for Euclid: out_file.type: writable out_file.default: '-' =back =head1 OPTIONS =over =item size x Specify height and width =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: l.type: int > 0 l.default: 24 =item -girth Display girth [default: 42 ] =for Euclid: g.default: 42 =item -v[erbose] Print all warnings =item [-]-timeout [] [] =for Euclid: min.type: int max.type: int max.default: -1 =item -w Test something spaced =item [-]-no[-fudge] Automaticaly fudge the factors. =for Euclid: false: [-]-no[-fudge] =item Step size. =for Euclid: step.default: $STEP1 + $STEPS->{extra} + $$STEPS{extra} + ${$STEPS}{extra} + $main'STEP2 =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) simple.t100644001750001750 627714446775743 16132 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tBEGIN { $INFILE = $0; $OUTFILE = $0; $LEN = 42; $H = 2; $W = -10; $TIMEOUT = 7; @ARGV = ( '-i', $INFILE, "-out=$OUTFILE", '-lgth', $LEN, 'size', "${H}x${W}", '-v', '--timeout', $TIMEOUT, '--with', 's p a c e s', 7, ); chmod 0644, $0; } sub lucky { my ($num) = @_; return $num == 7; } use Getopt::Euclid; use Test::More 'no_plan'; sub got_arg { my ($key, $val) = @_; is $ARGV{$key}, $val, "Got expected value for $key"; } is keys %ARGV, 18 => 'Right number of args returned'; got_arg -i => $INFILE; got_arg -infile => $INFILE; got_arg -l => $LEN; got_arg -len => $LEN; got_arg -length => $LEN; got_arg -lgth => $LEN; got_arg -girth => 42; got_arg -o => $OUTFILE; got_arg -ofile => $OUTFILE; got_arg -out => $OUTFILE; got_arg -outfile => $OUTFILE; got_arg -v => 1, got_arg -verbose => 1, is ref $ARGV{'--timeout'}, 'HASH' => 'Hash reference returned for timeout'; is $ARGV{'--timeout'}{min}, $TIMEOUT => 'Got expected value for timeout '; is $ARGV{'--timeout'}{max}, -1 => 'Got default value for timeout '; is ref $ARGV{size}, 'HASH' => 'Hash reference returned for size'; is $ARGV{size}{h}, $H => 'Got expected value for size '; is $ARGV{size}{w}, $W => 'Got expected value for size '; is $ARGV{'--with'}, 's p a c e s' => 'Handled spaces correctly'; is $ARGV{-w}, 's p a c e s' => 'Handled alternation correctly'; is $ARGV{''}, 7 => 'Handled step size correctly'; __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file =for Euclid: file.type: readable file.default: '-' =item -o[ut][file]= Specify output file =for Euclid: out_file.type: writable out_file.default: '-' =back =head1 OPTIONS =over =item size x Specify height and width =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: l.type: int > 0 l.default: 24 =item -girth Display girth [default: 42 ] =for Euclid: g.default: 42 =item -v[erbose] Print all warnings =item --timeout [] [] =for Euclid: min.type: int max.type: int max.default: -1 =item -w | --with Test something spaced =item Step size =for Euclid: step.type: int, lucky(step) =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) bundle.t100644001750001750 464614446775743 16110 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tBEGIN { $INFILE = 1; $OUTFILE = 1; $LEN = 42; $H = 2; $W = -10; $TIMEOUT = 7; @ARGV = ( "-io", 'size', "${H}x${W}", '-vl', $LEN, '--timeout', $TIMEOUT, ); } use Getopt::Euclid; use Test::More 'no_plan'; sub got_arg { my ($key, $val) = @_; is $ARGV{$key}, $val, "Got expected value for $key"; } is keys %ARGV, 14 => 'Right number of args returned'; got_arg -i => $INFILE; got_arg -infile => $INFILE; got_arg -l => $LEN; got_arg -len => $LEN; got_arg -length => $LEN; got_arg -lgth => $LEN; got_arg -o => $OUTFILE; got_arg -ofile => $OUTFILE; got_arg -out => $OUTFILE; got_arg -outfile => $OUTFILE; got_arg -v => 1, got_arg -verbose => 1, is ref $ARGV{'--timeout'}, 'HASH' => 'Hash reference returned for timeout'; is $ARGV{'--timeout'}{min}, $TIMEOUT => 'Got expected value for timeout '; ok !defined $ARGV{'--timeout'}{max} => 'Got expected value for timeout '; is ref $ARGV{size}, 'HASH' => 'Hash reference returned for size'; is $ARGV{size}{h}, $H => 'Got expected value for size '; is $ARGV{size}{w}, $W => 'Got expected value for size '; __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -i[nfile] Specify input file =item -o[ut][file] Specify output file =back =head1 OPTIONS =over =item size x Specify height and width =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: l.type: int > 0 l.default: 24 =item -v[erbose] Print all warnings =item --timeout [] [] =for Euclid: min.type: int max.type: int =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) hier_2.t100644001750001750 721614446775743 16003 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/t#! /usr/bin/env perl # The shebang line above is part of the test BEGIN { $INFILE = $0; $OUTFILE = $0; $LEN = 42; $H = 2; $W = -10; $TIMEOUT = 7; @ARGV = ( '-i', $INFILE, "-out=$OUTFILE", '-lgth', $LEN, 'size', "${H}x${W}", '-v', '--timeout', $TIMEOUT, ); chmod 0644, $0; } use t::lib::HierDemo2; use Test::More 'no_plan'; sub got_arg { my ($key, $val) = @_; is $ARGV{$key}, $val, "Got expected value for $key"; } is keys %ARGV, 14 => 'Right number of args returned'; got_arg -i => $INFILE; got_arg -infile => $INFILE; got_arg -l => $LEN; got_arg -len => $LEN; got_arg -length => $LEN; got_arg -lgth => $LEN; got_arg -o => $OUTFILE; got_arg -ofile => $OUTFILE; got_arg -out => $OUTFILE; got_arg -outfile => $OUTFILE; got_arg -v => 1, got_arg -verbose => 1, is ref $ARGV{'--timeout'}, 'HASH' => 'Hash reference returned for timeout'; is $ARGV{'--timeout'}{min}, $TIMEOUT => 'Got expected value for timeout '; ok !defined $ARGV{'--timeout'}{max} => 'Got expected value for timeout '; is ref $ARGV{size}, 'HASH' => 'Hash reference returned for size'; is $ARGV{size}{h}, $H => 'Got expected value for size '; is $ARGV{size}{w}, $W => 'Got expected value for size '; # Manual should contain POD from .pl and .pm files my $man = < -o= [options] \=head1 OPTIONS \=over \=item size x Specify height and width \=item -l[[en][gth]] Display length [default: 24 ] \=item -v[erbose] Print all warnings \=item --timeout [] [] \=item --version \=item --usage \=item --help \=item --man Print the usual program information \=back \=head1 AUTHOR Damian Conway (damian\@conway.org) \=head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. \=head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) \=head1 REQUIRED ARGUMENTS \=over \=item -i[nfile] [=] Specify input file \=item -o[ut][file]= Specify output file \=back EOS my $man_test = Getopt::Euclid->man(); is $man_test, $man, 'Man page is as expected'; __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 OPTIONS =over =item size x Specify height and width =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: l.type: int > 0 l.default: 24 =item -v[erbose] Print all warnings =item --timeout [] [] =for Euclid: min.type: int max.type: int =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) substr.t100644001750001750 55214446775743 16131 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tBEGIN { @ARGV = ( '-i', 'test', '-o', 'test2', ); } use Getopt::Euclid; use Test::More 'no_plan'; is $ARGV{'-i'}, 'test' => 'Got expected value for -i'; is $ARGV{'-o'}, 'test2' => 'Got expected value for -o'; __END__ =head1 NAME substr.pl - short description =head1 REQUIRED ARGUMENTS =head1 OPTIONS =item -o =item -i minimal.t100644001750001750 626014446775743 16257 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tBEGIN { $INFILE = $0; $OUTFILE = $0; $LEN = 42; $H = 2; $W = -10; $TIMEOUT = 7; @ARGV = ( '-i', $INFILE, "-out=$OUTFILE", '-lgth', $LEN, 'size', "${H}x${W}", '-no-fudge', '-v', '--timeout', $TIMEOUT, '-w', 's p a c e s', 7, ); chmod 0644, $0; } use Getopt::Euclid qw( :minimal_keys ); use Test::More 'no_plan'; sub got_arg { my ($key, $val) = @_; is $ARGV{$key}, $val, "Got expected value for $key"; } is keys %ARGV, 19 => 'Right number of args returned'; got_arg 'i' => $INFILE; got_arg 'infile' => $INFILE; got_arg 'l' => $LEN; got_arg 'len' => $LEN; got_arg 'length' => $LEN; got_arg 'lgth' => $LEN; got_arg 'girth' => 42; got_arg 'o' => $OUTFILE; got_arg 'ofile' => $OUTFILE; got_arg 'out' => $OUTFILE; got_arg 'outfile' => $OUTFILE; got_arg 'v' => 1, got_arg 'verbose' => 1, got_arg 'no' => 1; got_arg 'no_fudge' => 1; is ref $ARGV{'timeout'}, 'HASH' => 'Hash reference returned for timeout'; is $ARGV{'timeout'}{min}, $TIMEOUT => 'Got expected value for timeout '; is $ARGV{'timeout'}{max}, -1 => 'Got default value for timeout '; is ref $ARGV{size}, 'HASH' => 'Hash reference returned for size'; is $ARGV{size}{h}, $H => 'Got expected value for size '; is $ARGV{size}{w}, $W => 'Got expected value for size '; is $ARGV{w}, 's p a c e s' => 'Handled spaces correctly'; is $ARGV{step}, 7 => 'Handled step size correctly'; __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file =for Euclid: file.type: readable file.default: '-' =item -o[ut][file]= Specify output file =for Euclid: out_file.type: writable out_file.default: '-' =back =head1 OPTIONS =over =item size x Specify height and width =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: l.type: int > 0 l.default: 24 =item -girth Display girth [default: 42 ] =for Euclid: g.default: 42 =item -v[erbose] Print all warnings =item [-]-timeout [] [] =for Euclid: min.type: int max.type: int max.default: -1 =item -w Test something spaced =item [-]-no[-fudge] Automaticaly fudge the factors. =for Euclid: false: [-]-no[-fudge] =item Step size =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) compile.t100644001750001750 100514446775743 16251 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tuse Test::More 'no_plan'; BEGIN { require 5.006_001 or plan 'skip_all'; close *STDERR; open *STDERR, '>', \my $stderr; *CORE::GLOBAL::exit = sub { die $stderr }; } # Load Getopt::Euclid in compiling (syntax check) mode eval { local $^C = 1; require Getopt::Euclid and Getopt::Euclid->import(); 1; }; is $@, '' => 'Compile test'; __END__ =head1 REQUIRED ARGUMENTS =over =item The string used to prefix the output file name(s). =for Euclid: prefix.type: string =back 00.load.t100644001750001750 17614446775743 15746 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tuse Test::More tests => 1; BEGIN { use_ok( 'Getopt::Euclid' ); } diag( "Testing Getopt::Euclid $Getopt::Euclid::VERSION" ); Makefile.PL100644001750001750 335014446775743 16150 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.025. use strict; use warnings; use 5.006001; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( "ABSTRACT" => "Executable Uniform Command-Line Interface Descriptions", "AUTHOR" => "David Precious ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0 }, "DISTNAME" => "Getopt-Euclid", "LICENSE" => "perl", "MIN_PERL_VERSION" => "5.006001", "NAME" => "Getopt::Euclid", "PREREQ_PM" => { "Carp" => 0, "File::Basename" => 0, "File::Spec::Functions" => 0, "IO::Page" => 0, "IO::Pager::Page" => 0, "List::Util" => 0, "Pod::PlainText" => 0, "Pod::Select" => 0, "Symbol" => 0, "Text::Balanced" => 0, "re" => 0, "strict" => 0, "version" => 0, "warnings" => 0 }, "TEST_REQUIRES" => { "Data::Dumper" => 0, "Pod::Checker" => 0, "Test::More" => 0, "lib" => 0 }, "VERSION" => "0.4.6", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "Carp" => 0, "Data::Dumper" => 0, "File::Basename" => 0, "File::Spec::Functions" => 0, "IO::Page" => 0, "IO::Pager::Page" => 0, "List::Util" => 0, "Pod::Checker" => 0, "Pod::PlainText" => 0, "Pod::Select" => 0, "Symbol" => 0, "Test::More" => 0, "Text::Balanced" => 0, "lib" => 0, "re" => 0, "strict" => 0, "version" => 0, "warnings" => 0 ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); repeated.t100644001750001750 521314446775743 16417 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tBEGIN { @ARGV = ( '-a', 1, 2, 3, '-d', 'string', '-c', 'test1', 'test2', '-b', 4, 5, 6, 'Why not', 'eat at', 'Joes', ); } use Getopt::Euclid; use Test::More 'no_plan'; is ref $ARGV{'-a'}, 'ARRAY' => 'Array reference returned for -a'; is $ARGV{'-a'}[0], 1 => 'Got expected value for -a[0]'; is $ARGV{'-a'}[1], 2 => 'Got expected value for -a[1]'; is $ARGV{'-a'}[2], 3 => 'Got expected value for -a[2]'; is ref $ARGV{'-b'}, 'HASH' => 'Hash reference returned for -b'; is $ARGV{'-b'}{first}, 4 => 'Got expected value for -b{first}'; is ref $ARGV{'-b'}{rest}, 'ARRAY' => 'Array reference returned for -b{rest}'; is $ARGV{'-b'}{rest}[0], 5 => 'Got expected value for -b{rest}[0]'; is $ARGV{'-b'}{rest}[1], 6 => 'Got expected value for -b{rest}[1]'; is ref $ARGV{'-c'}, 'ARRAY' => 'Array reference returned for -c'; is $ARGV{'-c'}[0], 'test1' => 'Got expected value for -c[0]'; is $ARGV{'-c'}[1], 'test2' => 'Got expected value for -c[1]'; is ref $ARGV{'-d'}, 'ARRAY' => 'Array reference returned for -d'; is $ARGV{'-d'}[0], 'string' => 'Got expected value for -d[0]'; isnt ref $ARGV{''}, 'ARRAY' => 'Array reference not returned for '; is $ARGV{''}, 'Why not' => 'Got expected value for '; is ref $ARGV{''}, 'ARRAY' => 'Array reference returned for '; is $ARGV{''}[0], 'eat at' => 'Got expected value for [0]'; is $ARGV{''}[1], 'Joes' => 'Got expected value for [1]'; __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 OPTIONS =over =item -a ... =for Euclid: data.type: int > 0 =item -b ... =for Euclid: first.type: int > 0 rest.type: int > 0 =item -c ... =for Euclid: more.type: string =item -d ... =for Euclid: even_more.type: string =item =item ... =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) substr_2.t100644001750001750 55214446775743 16352 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tBEGIN { @ARGV = ( '-o', 'test', '-i', 'test2', ); } use Getopt::Euclid; use Test::More 'no_plan'; is $ARGV{'-i'}, 'test2' => 'Got expected value for -i'; is $ARGV{'-o'}, 'test' => 'Got expected value for -o'; __END__ =head1 NAME substr.pl - short description =head1 REQUIRED ARGUMENTS =head1 OPTIONS =item -o =item -i excludes.t100644001750001750 1076214446775743 16467 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tuse Test::More 'no_plan'; BEGIN { require 5.006_001 or plan 'skip_all'; close *STDERR; open *STDERR, '>', \my $stderr; *CORE::GLOBAL::exit = sub { die $stderr }; } sub got_arg { my ($key, $val) = @_; is $ARGV{$key}, $val, "Got expected value for $key"; } sub got_no_arg { my ($key) = @_; my $res = exists $ARGV{$key} ? 1 : 0; is $res, 0, "Got expected absence of $key"; } sub lucky { my ($num) = @_; return $num == 7; } # Parse argument specs use Getopt::Euclid qw(:defer); chmod 0644, $0; $INFILE = $0; $OUTFILE = $0; $LEN = 42; $H = 2; $W = -10; $TIMEOUT = 7; # Validate first set of args (exclusive params): # excludes and @argv = ( '-i', $INFILE, "-out=$OUTFILE", '-lgth', $LEN, # 'size', "${H}x${W}", # and '--timeout', $TIMEOUT, '-v', 7, ); if (eval { Getopt::Euclid->process_args(\@argv); 1 }) { ok 0 => 'Unexpectedly succeeded'; } else { like $@, qr/excludes/ => 'Failed as expected'; } # Validate second set of args (other exclusive params): # excludes @argv = ( '-i', $INFILE, "-out=$OUTFILE", '-lgth', $LEN, '--timeout', $TIMEOUT, '-v', '--with', 's p a c e s', # 7, # ); if (eval { Getopt::Euclid->process_args(\@argv); 1 }) { ok 0 => 'Unexpectedly succeeded'; } else { like $@, qr/excludes/ => 'Failed as expected'; } # Validate third set of args (exclusive default values) # and (not specified, have defaults) excluded by (not specified, # has default) -> 's default prevails # (not specified, has default) excluded by (not specified, has # no default) -> 's default prevails @argv = ( '-i', $INFILE, "-out=$OUTFILE", '--timeout', $TIMEOUT, '-v', 7, ); Getopt::Euclid->process_args(\@argv); got_arg '-length' => 24; got_no_arg 'size'; got_arg '--color' => 'red'; got_no_arg '--other'; got_arg '' => 7; got_no_arg '-w'; # Validate fourth set of args (more exclusive default values) # (specified, has default) excluded by (not specified, has default) # and (specified, have defaults) excluded by (not specified, has default) @argv = ( '-i', $INFILE, '-out=$OUTFILE', 'size', "${H}x${W}", '--timeout', $TIMEOUT, '-v', 7, ); Getopt::Euclid->process_args(\@argv); got_arg '--color' => 'red'; got_no_arg '--other'; is_deeply $ARGV{size}, { h => $H, w => $W } => 'Got expected value for size'; got_no_arg '-l'; got_arg '' => 7; got_no_arg '-w'; __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file =for Euclid: file.type: readable file.default: '-' =item -o[ut][file]= Specify output file =for Euclid: out_file.type: writable out_file.default: '-' =back =head1 OPTIONS =over =item size x Specify height and width =for Euclid: h.default: 0.345 w.default: 1.09 =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: l.type: int > 0 l.default: 24 l.excludes: h,w =item -girth Display girth [default: 42 ] =for Euclid: g.default: 42 =item -v[erbose] Print all warnings =item --timeout [] [] =for Euclid: min.type: int max.type: int max.default: -1 =item -w | --with Test something spaced =for Euclid: space.excludes: step space.default: 's p a c e' =item --color Pick a color =for Euclid: color.default: 'red' =item --other Override color (no default). =for Euclid: other.excludes: color =item Step size =for Euclid: step.type: int, lucky(step) step.default: 123 =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) pod_file.t100644001750001750 317514446775743 16414 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tBEGIN { $INFILE = $0; $OUTFILE = $0; $LEN = 42; $H = 2; $W = -10; $TIMEOUT = 7; @ARGV = ( '-i', $INFILE, "-out=$OUTFILE", '-lgth', $LEN, 'size', "${H}x${W}", '-v', '--timeout', $TIMEOUT, '--with', 's p a c e s', 7, ); chmod 0644, $0; } sub lucky { my ($num) = @_; return $num == 7; } # Read POD from .pod file use Getopt::Euclid; use Test::More 'no_plan'; sub got_arg { my ($key, $val) = @_; is $ARGV{$key}, $val, "Got expected value for $key"; } is keys %ARGV, 18 => 'Right number of args returned'; got_arg -i => $INFILE; got_arg -infile => $INFILE; got_arg -l => $LEN; got_arg -len => $LEN; got_arg -length => $LEN; got_arg -lgth => $LEN; got_arg -girth => 42; got_arg -o => $OUTFILE; got_arg -ofile => $OUTFILE; got_arg -out => $OUTFILE; got_arg -outfile => $OUTFILE; got_arg -v => 1, got_arg -verbose => 1, is ref $ARGV{'--timeout'}, 'HASH' => 'Hash reference returned for timeout'; is $ARGV{'--timeout'}{min}, $TIMEOUT => 'Got expected value for timeout '; is $ARGV{'--timeout'}{max}, -1 => 'Got default value for timeout '; is ref $ARGV{size}, 'HASH' => 'Hash reference returned for size'; is $ARGV{size}{h}, $H => 'Got expected value for size '; is $ARGV{size}{w}, $W => 'Got expected value for size '; is $ARGV{'--with'}, 's p a c e s' => 'Handled spaces correctly'; is $ARGV{-w}, 's p a c e s' => 'Handled alternation correctly'; is $ARGV{''}, 7 => 'Handled step size correctly'; defer_all.t100644001750001750 144614446775743 16547 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tBEGIN { $INFILE = $0; $OUTFILE = $0; @ARGV = ( '-i', $INFILE, "-out=$OUTFILE", ); chmod 0644, $0; } use Getopt::Euclid ( ); use Test::More 'no_plan'; sub got_arg { my ($key, $val) = @_; is $ARGV{$key}, $val, "Got expected value for $key"; } is scalar @ARGV, 3 => '@ARGV processing was defered'; is keys %ARGV, 0 => '%ARGV processing was defered'; my @pods = ( './t/lib/HierDemo2.pm' ); Getopt::Euclid->process_pods(\@pods); is scalar @ARGV, 3 => '@ARGV processing was defered'; is keys %ARGV, 0 => '%ARGV processing was defered'; Getopt::Euclid->process_args(\@ARGV); got_arg -i => $INFILE; got_arg -infile => $INFILE; got_arg -o => $OUTFILE; got_arg -ofile => $OUTFILE; got_arg -out => $OUTFILE; got_arg -outfile => $OUTFILE; fail_type.t100644001750001750 400614446775743 16601 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tuse Test::More 'no_plan'; BEGIN { require 5.006_001 or plan 'skip_all'; close *STDERR; open *STDERR, '>', \my $stderr; *CORE::GLOBAL::exit = sub { die $stderr }; } BEGIN { $INFILE = $0; $OUTFILE = $0; $LEN = 'forty-two'; $H = 2; $W = -10; $TIMEOUT = 7; @ARGV = ( '-v', "-out=$OUTFILE", 'size', "${H}x${W}", '-i', $INFILE, '-lgth', $LEN, '--timeout', $TIMEOUT, ); } if (eval { require Getopt::Euclid and Getopt::Euclid->import(); 1 }) { ok 0 => 'Unexpectedly succeeded'; } else { like $@, qr/ must be int but/ => 'Failed as expected'; } __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file =for Euclid: file.type: readable file.default: '-' =item -o[ut][file]= Specify output file =for Euclid: file.type: writable file.default: '-' =back =head1 OPTIONS =over =item size x Specify height and width =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: l.type: int > 0 l.default: 24 =item -v[erbose] Print all warnings =item --timeout [] [] =for Euclid: min.type: int max.type: int =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) minimal_2.t100644001750001750 251514446775743 16477 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tBEGIN { $INFILE = 'test.generic'; @ARGV = ( '-input_files', $INFILE, ); chmod 0644, $0; } use Getopt::Euclid qw( :minimal_keys ); use Test::More 'no_plan'; sub got_arg { my ($key, $val) = @_; is $ARGV{$key}, $val, "Got expected value for $key"; } is keys %ARGV, 8 => 'Right number of args returned'; is ref $ARGV{'input_files'}, 'ARRAY' => 'Array reference returned for input_files'; is $ARGV{'input_files'}->[0], $INFILE => 'Got expected value for input_files'; is ref $ARGV{'if'}, 'ARRAY' => 'Array reference returned for input_files'; is $ARGV{'if'}->[0], $INFILE => 'Got expected value for input_files'; got_arg 'dist_type' => 'euclidean'; got_arg 'dt' => 'euclidean'; got_arg 'weight_assign' => 'ancestor'; got_arg 'wa' => 'ancestor'; got_arg 'output_prefix' => 'bc_distance'; got_arg 'op' => 'bc_distance'; __END__ =head1 OPTIONAL ARGUMENTS =over =item -if ... | -input_files ... =item -wa | -weight_assign =for Euclid: weight_assign.default: 'ancestor' =item -op | -output_prefix =for Euclid: output_prefix.type: string output_prefix.default: 'bc_distance' =item -dt | -dist_type =for Euclid: dist_type.default: 'euclidean' =back any_array.t100644001750001750 464014446775743 16616 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tBEGIN { $LEN = 42; $H = 2; $W = -10; $TIMEOUT = 7; @ARGV = ( '-lgth', $LEN, 'size', "${H}x${W}", '-v', '--timeout', $TIMEOUT, ); @args = @ARGV; chmod 0644, $0; } use Test::More 'no_plan'; use Getopt::Euclid; sub got_arg { my ($key, $val) = @_; is $ARGV{$key}, $val, "Got expected value for $key"; } # Let's parse an array of arguments instead of @ARGV and repeat the same tests Getopt::Euclid->process_args(\@args); is keys %ARGV, 8 => 'Right number of args returned'; got_arg -i => $INFILE; got_arg -infile => $INFILE; got_arg -l => $LEN; got_arg -len => $LEN; got_arg -length => $LEN; got_arg -lgth => $LEN; got_arg -o => $OUTFILE; got_arg -ofile => $OUTFILE; got_arg -out => $OUTFILE; got_arg -outfile => $OUTFILE; got_arg -v => 1, got_arg -verbose => 1, is ref $ARGV{'--timeout'}, 'HASH' => 'Hash reference returned for timeout'; is $ARGV{'--timeout'}{min}, $TIMEOUT => 'Got expected value for timeout '; ok !defined $ARGV{'--timeout'}{max} => 'Got expected value for timeout '; is ref $ARGV{size}, 'HASH' => 'Hash reference returned for size'; is $ARGV{size}{h}, $H => 'Got expected value for size '; is $ARGV{size}{w}, $W => 'Got expected value for size '; __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 OPTIONS =over =item size x Specify height and width =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: l.type: int > 0 l.default: 24 =item -v[erbose] Print all warnings =item --timeout [] [] =for Euclid: min.type: int max.type: int =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) pod_file.pod100644001750001750 312314446775743 16724 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/t=head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file =for Euclid: file.type: readable file.default: '-' =item -o[ut][file]= Specify output file =for Euclid: out_file.type: writable out_file.default: '-' =back =head1 OPTIONS =over =item size x Specify height and width =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: l.type: int > 0 l.default: 24 =item -girth Display girth [default: 42 ] =for Euclid: g.default: 42 =item -v[erbose] Print all warnings =item --timeout [] [] =for Euclid: min.type: int max.type: int max.default: -1 =item -w | --with Test something spaced =item Step size =for Euclid: step.type: int, lucky(step) =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) types_vars.t100644001750001750 276414446775743 17035 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tBEGIN { @ARGV = ( '--alpha' , 'aaa', '--beta' , '0.8', '--gamma' , '123', '--delta' , 'asdf', '--epsilon' , 'abcdef', '--mu' , '256', '--price' , '$10', '--distance', 'km', ); } use Getopt::Euclid qw(:defer); use Test::More 'no_plan'; no warnings('once'); our $TEST = 'aaa'; our @THRESH; $THRESH[0] = 0; $THRESH[1] = 1; our $VAL = 123; our %RE; $RE{letters} = '[a-z]+'; $::STRING = 'abcdefghij'; $Package::EXIT_STATUS = 0; Getopt::Euclid->process_args(\@ARGV); is $ARGV{'--alpha'}, 'aaa' ; is $ARGV{'--beta'} , 0.8 ; is $ARGV{'--gamma'}, 123 ; is $ARGV{'--delta'}, 'asdf' ; is $ARGV{'--epsilon'}, 'abcdef'; is $ARGV{'--mu'}, 256 ; is $ARGV{'--price'}, '$10' ; is $ARGV{'--distance'}, 'km' ; __END__ =head1 OPTIONS =over =item --alpha =for Euclid alpha.type: string, alpha eq $TEST =item --beta =for Euclid beta.type: number, beta > $THRESH[0] && beta < $THRESH[1] =item --gamma =for Euclid gamma.type: number, gamma == $VAL =item --delta =for Euclid delta.type: string, delta =~ /$RE{letters}/ =item --epsilon =for Euclid epsilon.type: string, length(epsilon) < length($::STRING) =item --mu =for Euclid mu.type: number, mu != $Package::EXIT_STATUS =item --price =for Euclid price.type: string, price eq '$10' =item --distance =for Euclid distance.type: /km$/ =back repeatable.t100644001750001750 655714446775743 16746 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tBEGIN { $INFILE = $0; $OUTFILE = $0; $LEN = 42; $H = 2; $W = -10; $TIMEOUT = 7; @ARGV = ( '-i', $INFILE, "-out=$OUTFILE", '-lgth', $LEN, '-lgth', ($LEN+1), '-lgth', $LEN*2, 'size', "${H}x${W}", '-v', '-v', '-v', '-v', '-v', '--timeout', $TIMEOUT, '-w', 's p a c e s', 7, ); chmod 0644, $0; } use Getopt::Euclid; use Test::More 'no_plan'; sub got_arg { my ($key, $val) = @_; is $ARGV{$key}, $val, "Got expected value for $key"; } is keys %ARGV, 17 => 'Right number of args returned'; got_arg -i => $INFILE; got_arg -infile => $INFILE; is_deeply $ARGV{-l}, [42,43,84], => 'Repeated length'; is_deeply $ARGV{-len}, [42,43,84], => 'Repeated length'; is_deeply $ARGV{-length}, [42,43,84], => 'Repeated length'; is_deeply $ARGV{-lgth}, [42,43,84], => 'Repeated length'; got_arg -girth => 42; got_arg -o => $OUTFILE; got_arg -ofile => $OUTFILE; got_arg -out => $OUTFILE; got_arg -outfile => $OUTFILE; is_deeply $ARGV{-v}, [1,1,1,1,1], => 'Repeated verbosity'; is_deeply $ARGV{-verbose}, [1,1,1,1,1], => 'Repeated verbose verbosity'; is ref $ARGV{'--timeout'}, 'HASH' => 'Hash reference returned for timeout'; is $ARGV{'--timeout'}{min}, $TIMEOUT => 'Got expected value for timeout '; is $ARGV{'--timeout'}{max}, -1 => 'Got default value for timeout '; is ref $ARGV{size}, 'HASH' => 'Hash reference returned for size'; is $ARGV{size}{h}, $H => 'Got expected value for size '; is $ARGV{size}{w}, $W => 'Got expected value for size '; is $ARGV{-w}, 's p a c e s' => 'Handled spaces correctly'; is $ARGV{''}, 7 => 'Handled step size correctly'; __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file =for Euclid: file.type: readable file.default: '-' =item -o[ut][file]= Specify output file =for Euclid: file.type: writable file.default: '-' =back =head1 OPTIONS =over =item size x Specify height and width =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: repeatable l.type: int > 0 l.default: 24 =item -girth Display girth [default: 42 ] =for Euclid: g.default: 42 =item -v[erbose] Print all warnings =for Euclid: repeatable =item --timeout [] [] =for Euclid: min.type: int max.type: int max.default: -1 =item -w Test something spaced =item Step size =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) repeated_2.t100644001750001750 225414446775743 16642 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tBEGIN { @ARGV = ( '-compare', 'aaa', 'aaaa', ); } use Getopt::Euclid; use Test::More 'no_plan'; is ref $ARGV{'-compare'}, 'HASH' => 'Hash reference returned for -b'; is $ARGV{'-compare'}{old_dir}, 'aaa' => 'Got expected value for -b{first}'; is $ARGV{'-compare'}{new_dir}, 'aaaa' => 'Got expected value for -b{rest}[0]'; __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 OPTIONS =over =item -compare =for Euclid: old_dir.type: string new_dir.type: string =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) opt_default.t100644001750001750 633314446775743 17140 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tBEGIN { $INFILE = $0; $OUTFILE = $0; $H = 2; $W = -10; $TIMEOUT = 7; @ARGV = ( '-i', $INFILE, "-out=$OUTFILE", '-lgth', 'size', "${H}x${W}", '-v', '--timeout', $TIMEOUT, '--with', 's p a c e s', 7, ); chmod 0644, $0; } sub lucky { my ($num) = @_; return $num == 7; } use Getopt::Euclid; use Test::More 'no_plan'; sub got_arg { my ($key, $val) = @_; is $ARGV{$key}, $val, "Got expected value for $key"; } is keys %ARGV, 18 => 'Right number of args returned'; got_arg -i => $INFILE; got_arg -infile => $INFILE; got_arg -l => 123; got_arg -len => 123; got_arg -length => 123; got_arg -lgth => 123; got_arg -girth => 42; got_arg -o => $OUTFILE; got_arg -ofile => $OUTFILE; got_arg -out => $OUTFILE; got_arg -outfile => $OUTFILE; got_arg -v => 1, got_arg -verbose => 1, is ref $ARGV{'--timeout'}, 'HASH' => 'Hash reference returned for timeout'; is $ARGV{'--timeout'}{min}, $TIMEOUT => 'Got expected value for timeout '; is $ARGV{'--timeout'}{max}, -3 => 'Got default value for timeout '; is ref $ARGV{size}, 'HASH' => 'Hash reference returned for size'; is $ARGV{size}{h}, $H => 'Got expected value for size '; is $ARGV{size}{w}, $W => 'Got expected value for size '; is $ARGV{'--with'}, 's p a c e s' => 'Handled spaces correctly'; is $ARGV{-w}, 's p a c e s' => 'Handled alternation correctly'; is $ARGV{''}, 7 => 'Handled step size correctly'; __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file =for Euclid: file.type: readable file.default: '-' =item -o[ut][file]= Specify output file =for Euclid: out_file.type: writable out_file.default: '-' =back =head1 OPTIONS =over =item size x Specify height and width =item -l[[en][gth]] [] Display length [opt_default: 123] =for Euclid: l.type: int > 0 l.opt_default: 123 =item -girth Display girth [default: 42 ] =for Euclid: g.default: 42 =item -v[erbose] Print all warnings =item --timeout [] [] =for Euclid: min.type: int max.type: int max.default: -1 max.opt_default: -3 =item -w | --with Test something spaced =item Step size =for Euclid: step.type: int, lucky(step) =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) hier_export.t100644001750001750 473414446775743 17165 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tBEGIN { $INFILE = $0; $OUTFILE = $0; $LEN = 42; $H = 2; $W = -10; $TIMEOUT = 7; @ARGV = ( '-i', $INFILE, "-out=$OUTFILE", '-lgth', $LEN, 'size', "${H}x${W}", '-v', '--timeout', $TIMEOUT, ); chmod 0644, $0; } # test that args to import are passed through to Getopt::Euclid use t::lib::HierDemo qw( :vars ); use Test::More 'no_plan'; sub got_arg { my ($key, $val) = @_; is $ARGV{$key}, $val, "Got expected value for $key"; } is keys %ARGV, 14 => 'Right number of args returned'; got_arg -i => $INFILE; got_arg -infile => $INFILE; got_arg -l => $LEN; got_arg -len => $LEN; got_arg -length => $LEN; got_arg -lgth => $LEN; got_arg -o => $OUTFILE; got_arg -ofile => $OUTFILE; got_arg -out => $OUTFILE; got_arg -outfile => $OUTFILE; is $ARGV_outfile => $OUTFILE; got_arg -v => 1, got_arg -verbose => 1, is ref $ARGV{'--timeout'}, 'HASH' => 'Hash reference returned for timeout'; is $ARGV{'--timeout'}{min}, $TIMEOUT => 'Got expected value for timeout '; ok !defined $ARGV{'--timeout'}{max} => 'Got expected value for timeout '; is ref $ARGV{size}, 'HASH' => 'Hash reference returned for size'; is $ARGV{size}{h}, $H => 'Got expected value for size '; is $ARGV{size}{w}, $W => 'Got expected value for size '; __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 OPTIONS =over =item size x Specify height and width =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: l.type: int > 0 l.default: 24 =item -v[erbose] Print all warnings =item --timeout [] [] =for Euclid: min.type: int max.type: int =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) types_regex.t100644001750001750 244414446775743 17167 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tBEGIN { @ARGV = ( "-h=hostname1234", "-dim=3,4", ); } use Getopt::Euclid; use Test::More 'no_plan'; sub got_arg { my ($key, $val) = @_; is $ARGV{$key}, $val, "Got expected value for $key"; } is $ARGV{'-h'}{dev}, 'hostname' => 'Got expected value for -h '; is $ARGV{'-h'}{port}, 1234 => 'Got expected value for -h '; is $ARGV{'-dim'}, '3,4' => 'Got expected value for -dim'; __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -h = [] Specify device/port =for Euclid: dev.type: /[^:\s\d]+\D/ port.type: /\d+/ =item -dim= =for Euclid: dim.type: /\d+,\d+/ =back =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) quoted_args.t100644001750001750 265314446775743 17150 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tBEGIN { @ARGV = ( '-e1with space1', '-e2', 'with space2', '-e3', 'with', 'space3', ); # This is equivalent to running: # quoted_args.t -e1"with space1" -e2 "with space2" -e3 with space3 # or: # quoted_args.t -e1with\ space1 -e2 with\ space2 -e3 with space3 } use Getopt::Euclid; use Test::More 'no_plan'; sub got_arg { my ($key, $val) = @_; is $ARGV{$key}, $val, "Got expected value for $key"; } is keys %ARGV, 4 => 'Right number of args returned'; got_arg -e1 => 'with space1'; got_arg -e2 => 'with space2'; got_arg -e3 => 'with'; got_arg '' => 'space3'; __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 OPTIONS =over =item -e1 =item -e2 =item -e3 =item =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) hier_no_pod.t100644001750001750 104314446775743 17110 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tBEGIN { $INFILE = $0; $OUTFILE = $0; @ARGV = ( '-i', $INFILE, "-out=$OUTFILE", ); chmod 0644, $0; } use t::lib::HierDemo; use Test::More 'no_plan'; is keys %ARGV, 6 => 'Right number of args returned'; # Manual should contain POD from .pl and .pm files my $man = < Specify input file \=item -o[ut][file]= Specify output file \=back EOS my $man_test = Getopt::Euclid->man(); is $man_test, $man, 'Man page is as expected'; vars_export.t100644001750001750 1145514446775743 17227 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tour ( $INFILE, $OUTFILE, $LEN, $H, $W, $TIMEOUT ); BEGIN { $INFILE = $0; $OUTFILE = $0; $LEN = 42; $H = 2; $W = -10; $TIMEOUT = 7; @ARGV = ( # doesn't include the --missing-* options in order to test that the # corresponding variable is still exported even if not present in @ARGV. # "--missing-bool", # "--missing-repopt foo", "--missing-repopt bar", # "--missing-repval foo bar", # "--missing-repoptmultpholds a:1", "--missing-repoptmultpholds b:2" # "--missing-hash ping,pong", '-i', $INFILE, "-out=$OUTFILE", '-lgth', $LEN, 'size', "${H}x${W}", '-v', '--skip-some', '--also', 42, '--also', 43, '--timeout', $TIMEOUT, '-w', 's p a c e s', 7, ); chmod 0644, $0 } use Getopt::Euclid qw( :vars ); use Test::More 'no_plan'; use strict; sub got_arg { my ($key, $val) = @_; my $var_name = "opt_$key"; no strict 'refs'; is ${$var_name}, $val, "Got expected value for $var_name"; } sub not_arg { my ($key, $val) = @_; my $var_name = "opt_$key"; no strict 'refs'; is ${$var_name}, undef, "$var_name should be undefined"; } not_arg 'i' => $INFILE; got_arg 'infile' => $INFILE; not_arg 'l' => $LEN; not_arg 'len' => $LEN; got_arg 'length' => $LEN; not_arg 'lgth' => $LEN; got_arg 'girth' => 42; not_arg 'o' => $OUTFILE; not_arg 'ofile' => $OUTFILE; not_arg 'out' => $OUTFILE; got_arg 'outfile' => $OUTFILE; not_arg 'v' => 1, got_arg 'verbose' => 1, not_arg 'skip_some' => 1, got_arg 'skip_something' => 1, is $opt_timeout{min}, $TIMEOUT => 'Got expected value for timeout '; is $opt_timeout{max}, -1 => 'Got default value for timeout '; is $opt_size{h}, $H => 'Got expected value for size '; is $opt_size{w}, $W => 'Got expected value for size '; is_deeply \@opt_also, [ 42, 43 ] => 'Got repeated options as array'; is_deeply \@opt_w, ['s p a c e s'] => 'Handled spaces correctly'; is $opt_step, 7 => 'Handled step size correctly'; # test options that aren't given in @ARGV are still exported is $opt_missing_bool, undef, 'Got $opt_missing_bool as undef and use strict was happy'; is_deeply \%opt_missing_hash, { }, 'Got %opt_missing_hash with 0 keys and use strict was happy'; is_deeply \@opt_missing_repval, [ ], 'Got @opt_missing_repval with 0 elements and use strict was happy'; is_deeply \@opt_missing_repopt, [ ], 'Got @opt_missing_repopt with 0 elements and use strict was happy'; is_deeply \@opt_missing_repoptmultpholds, [ ], 'Got @opt_missing_repoptmultpholds with 0 elements and use strict was happy'; __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file =for Euclid: file.type: readable file.default: '-' =item -o[ut][file]= Specify output file =for Euclid: file.type: writable file.default: '-' =back =head1 OPTIONS =over =item size x Specify height and width =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: l.type: int > 0 l.default: 24 =item -girth Display girth [default: 42 ] =for Euclid: g.default: 42 =item -v[erbose] Print all warnings =item --skip-some[thing] Don't do something that would normally be done. =item --also Also do these things =for Euclid: repeatable =item --timeout [] [] =for Euclid: min.type: int max.type: int max.default: -1 =item -w Test something spaced =for Euclid: repeatable =item Step size =item --missing-bool A missing option (boolean) =item --missing-hash , A missing option (hash) =item --missing-repval ... A missing option (repeatable value) =item --missing-repopt A missing option (repeatable option) =for Euclid: repeatable =item --missing-repoptmultpholds : A missing option (repeatable option with multiple placeholders) =for Euclid: repeatable =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) fail_no_spec.t100644001750001750 123214446775743 17244 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tuse Test::More 'no_plan'; BEGIN { require 5.006_001 or plan 'skip_all'; close *STDERR; open *STDERR, '>', \my $stderr; *CORE::GLOBAL::exit = sub { die $stderr }; } BEGIN { $INFILE = $0; $OUTFILE = 'nexistpas'; $LEN = 42; $H = 2; $W = -10; $TIMEOUT = 7; @ARGV = ( '-v', "-out=", $OUTFILE, "size", "${H}x${W}", "-i", $INFILE, "-lgth", $LEN, "--timeout", $TIMEOUT, ); } if (eval { require Getopt::Euclid and Getopt::Euclid->import(); 1 }) { ok 0 => 'Unexpectedly succeeded'; } else { like $@, qr/Unknown argument/ => 'Failed as expected'; } pod_coverage.t100644001750001750 34714446775743 17246 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/t#!perl -T use Test::More; eval 'use Test::Pod::Coverage 1.04 tests => 1'; plan skip_all => 'Test::Pod::Coverage 1.04 required for testing POD coverage' if $@; pod_coverage_ok('Getopt::Euclid', 'Getopt::Euclid\'s POD is covered'); fail_type_msg.t100644001750001750 411314446775743 17446 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tuse Test::More 'no_plan'; BEGIN { require 5.006_001 or plan 'skip_all'; close *STDERR; open *STDERR, '>', \my $stderr; *CORE::GLOBAL::exit = sub { die $stderr }; } BEGIN { $INFILE = $0; $OUTFILE = $0; $LEN = 'forty-two'; $H = 2; $W = -10; $TIMEOUT = 7; @ARGV = ( '-v', "-out=$OUTFILE", 'size', "${H}x${W}", '-i', $INFILE, '-lgth', $LEN, '--timeout', $TIMEOUT, ); } if (eval { require Getopt::Euclid and Getopt::Euclid->import(); 1 }) { ok 0 => 'Unexpectedly succeeded'; } else { like $@, qr/Length \(forty-two\) is too small/ => 'Failed as expected'; } __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file =for Euclid: file.type: readable file.default: '-' =item -o[ut][file]= Specify output file =for Euclid: file.type: writable file.default: '-' =back =head1 OPTIONS =over =item size x Specify height and width =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: l.type: int > 0 l.type.error: Length (l) is too small! l.default: 24 =item -v[erbose] Print all warnings =item --timeout [] [] =for Euclid: min.type: int max.type: int =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) entity_angles.t100644001750001750 642714446775743 17503 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tBEGIN { $INFILE = $0; $OUTFILE = $0; $LEN = 42; $H = 2; $W = -10; $TIMEOUT = 7; @ARGV = ( '-i', $INFILE, "-out=$OUTFILE", '-lgth', $LEN, 'size', "${H}x${W}", '-v', '--timeout', $TIMEOUT, '--with', 's p a c e s', 7, ); chmod 0644, $0; } sub lucky { my ($num) = @_; return $num == 7; } use Getopt::Euclid; use Test::More 'no_plan'; sub got_arg { my ($key, $val) = @_; is $ARGV{$key}, $val, "Got expected value for $key"; } is keys %ARGV, 18 => 'Right number of args returned'; got_arg -i => $INFILE; got_arg -infile => $INFILE; got_arg -l => $LEN; got_arg -len => $LEN; got_arg -length => $LEN; got_arg -lgth => $LEN; got_arg -girth => 42; got_arg -o => $OUTFILE; got_arg -ofile => $OUTFILE; got_arg -out => $OUTFILE; got_arg -outfile => $OUTFILE; got_arg -v => 1, got_arg -verbose => 1, is ref $ARGV{'--timeout'}, 'HASH' => 'Hash reference returned for timeout'; is $ARGV{'--timeout'}{min}, $TIMEOUT => 'Got expected value for timeout '; is $ARGV{'--timeout'}{max}, -1 => 'Got default value for timeout '; is ref $ARGV{size}, 'HASH' => 'Hash reference returned for size'; is $ARGV{size}{h}, $H => 'Got expected value for size '; is $ARGV{size}{w}, $W => 'Got expected value for size '; is $ARGV{'--with'}, 's p a c e s' => 'Handled spaces correctly'; is $ARGV{-w}, 's p a c e s' => 'Handled alternation correctly'; is $ARGV{''}, 7 => 'Handled step size correctly'; __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=]EfileE Specify input file =for Euclid: file.type: readable file.default: '-' =item -o[ut][file]= Eout_fileE Specify output file =for Euclid: out_file.type: writable out_file.default: '-' =back =head1 OPTIONS =over =item size EhExEwE Specify height and width =item -l[[en][gth]] ElE Display length [default: 24 ] =for Euclid: l.type: int > 0 l.default: 24 =item -girth EgE Display girth [default: 42 ] =for Euclid: g.default: 42 =item -v[erbose] Print all warnings =item --timeout [EminE] [EmaxE] =for Euclid: min.type: int max.type: int max.default: -1 =item -w EspaceE | --with EspaceE Test something spaced =item EstepE Step size =for Euclid: step.type: int, lucky(step) =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) fail_bad_name.t100644001750001750 226414446775743 17352 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tuse Test::More 'no_plan'; BEGIN { require 5.006_001 or plan 'skip_all'; close *STDERR; open *STDERR, '>', \my $stderr; *CORE::GLOBAL::exit = sub { die $stderr }; } if (eval { require Getopt::Euclid and Getopt::Euclid->import(); 1 }) { ok 0 => 'Unexpectedly succeeded'; } else { like $@, qr/Getopt::Euclid: Invalid argument specification: --delta / => 'Failed as expected'; } __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 OPTIONS =over =item --delta =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) std_arguments.t100644001750001750 1347214446775743 17533 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tBEGIN { $INFILE = $0; $OUTFILE = $0; @ARGV = ( '-i', $INFILE, "-out=$OUTFILE", ); chmod 0644, $0; } use Getopt::Euclid qw( :minimal_keys ); use Test::More 'no_plan'; my $man = < -o= [options] \=head1 REQUIRED ARGUMENTS \=over \=item -i[nfile] [=] Specify input file \=item -o[ut][file]= Specify output file \=back \=head1 OPTIONS \=over \=item size x Specify height and width \=item -l[[en][gth]] Display length [default: 24 ] \=item -girth Display girth [default: 42 ] \=item -v[erbose] Print all warnings \=item [-]-timeout [] [] \=item -w Test something spaced \=item [-]-no[-fudge] Automaticaly fudge the factors. \=item Step size \=item --version \=item --usage \=item --help \=item --man Print the usual program information \=back \=head1 AUTHOR Damian Conway (damian\@conway.org) \=head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. \=head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) EOS my $podfile = "# This file was generated dynamically by Getopt::Euclid. Do not edit it.\n\n$man"; my $help = < -o= [options] std_arguments.t --help std_arguments.t --man std_arguments.t --usage std_arguments.t --version \=head1 Required arguments: \=over \=item -i[nfile] [=] Specify input file \=item -o[ut][file]= Specify output file \=back \=head1 Options: \=over \=item size x Specify height and width \=item -l[[en][gth]] Display length [default: 24 ] \=item -girth Display girth [default: 42 ] \=item -v[erbose] Print all warnings \=item [-]-timeout [] [] \=item -w Test something spaced \=item [-]-no[-fudge] Automaticaly fudge the factors. \=item Step size \=item --version \=item --usage \=item --help \=item --man Print the usual program information \=back EOS my $usage = < -o= [options] std_arguments.t --help std_arguments.t --man std_arguments.t --usage std_arguments.t --version EOS my $version = <man(); is $man_test, $man => 'Correct man message'; my $file = Getopt::Euclid->podfile(); ok -e $file => 'Podfile was created'; my $podfile_test = ''; open my $in, '<', $file or die "Could not open file $file\n$!\n"; while (<$in>) { $podfile_test .= $_; } close $in; is $podfile_test, $podfile => 'Correct podfile content'; unlink $file; my $help_test = Getopt::Euclid->help(); is $help_test, $help => 'Correct help message'; my $usage_test = Getopt::Euclid->usage(); is $usage_test, $usage => 'Correct usage message'; my $version_test = Getopt::Euclid->version(); is $version_test, $version => 'Correct version message'; SKIP: { skip 'Need Pod::Checker for this tests', 3 unless eval { require Pod::Checker }; require Pod::Checker; open my $pod_fh, '<', \$man; my $nof_errors = Pod::Checker::podchecker( $pod_fh ); is $nof_errors, 0; close $pod_fh; open $pod_fh, '<', \$podfile_test; $nof_errors = Pod::Checker::podchecker( $pod_fh ); is $nof_errors, 0; close $pod_fh; open $pod_fh, '<', \$help_test; $nof_errors = Pod::Checker::podchecker( $pod_fh ); is $nof_errors, 0; close $pod_fh; } __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 SYNOPSIS my $var = 'asdf'; =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file =for Euclid: file.type: readable file.default: '-' =item -o[ut][file]= Specify output file =for Euclid: out_file.type: writable out_file.default: '-' =back =head1 OPTIONS =over =item size x Specify height and width =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: l.type: int > 0 l.default: 24 =item -girth Display girth [default: 42 ] =for Euclid: g.default: 42 =item -v[erbose] Print all warnings =item [-]-timeout [] [] =for Euclid: min.type: int max.type: int max.default: -1 =item -w Test something spaced =item [-]-no[-fudge] Automaticaly fudge the factors. =for Euclid: false: [-]-no[-fudge] =item Step size =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) quoted_args_2.t100644001750001750 130714446775743 17364 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tBEGIN { @ARGV = ( '-a', 1, '-b 2', ); # This is equivalent to running: # quoted_args_2.t -a 1 '-b 2' # or: # quoted_args_2.t -a 1 -b\ 2 } use Getopt::Euclid; use Test::More 'no_plan'; use Data::Dumper; print Dumper(\%ARGV); is keys %ARGV, 1 => 'Right number of args returned'; is ref $ARGV{'-a'}, 'ARRAY' => 'Array reference returned for -a'; is $ARGV{'-a'}[0], 1 => 'Got expected value for -a[0]'; is $ARGV{'-a'}[1], '-b 2' => 'Got expected value for -a[1]'; ok not( exists $ARGV{'-b'} ) => 'Nothing returned for -b'; =head1 REQUIRED ARGUMENTS =over =item -a ... =back =head1 OPTIONS =over =item -b =back =cut lib000755001750001750 014446775743 15046 5ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tHierDemo.pm100644001750001750 6314446775743 17177 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/t/libpackage t::lib::HierDemo; use Getopt::Euclid; 1; simple_shuffle.t100644001750001750 515414446775743 17637 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tBEGIN { $INFILE = $0; $OUTFILE = '-'; $LEN = 42; $H = 2; $W = -10; $TIMEOUT = 7; @ARGV = ( '-v', "-out=$OUTFILE", 'size', "${H}x${W}", '-i', $INFILE, '--timeout', $TIMEOUT, '-lgth', $LEN, ); } use Getopt::Euclid; use Test::More 'no_plan'; sub got_arg { my ($key, $val) = @_; is $ARGV{$key}, $val, "Got expected value for $key"; } is keys %ARGV, 14 => 'Right number of args returned'; got_arg -i => $INFILE; got_arg -infile => $INFILE; got_arg -l => $LEN; got_arg -len => $LEN; got_arg -length => $LEN; got_arg -lgth => $LEN; got_arg -o => $OUTFILE; got_arg -ofile => $OUTFILE; got_arg -out => $OUTFILE; got_arg -outfile => $OUTFILE; got_arg -v => 1, got_arg -verbose => 1, is ref $ARGV{'--timeout'}, 'HASH' => 'Hash reference returned for timeout'; is $ARGV{'--timeout'}{min}, $TIMEOUT => 'Got expected value for timeout '; ok !defined $ARGV{'--timeout'}{max} => 'Got expected value for timeout '; is ref $ARGV{size}, 'HASH' => 'Hash reference returned for size'; is $ARGV{size}{h}, $H => 'Got expected value for size '; is $ARGV{size}{w}, $W => 'Got expected value for size '; __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file =for Euclid: file.type: readable file.default: '-' =item -o[ut][file]= Specify output file =for Euclid: file.type: writable file.default: '-' =back =head1 OPTIONS =over =item size x Specify height and width =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: l.type: int > 0 l.default: 24 =item -v[erbose] Print all warnings =item --timeout [] [] =for Euclid: min.type: int max.type: int =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) HierDemo.pod100644001750001750 42114446775743 17363 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/t/lib=head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file =for Euclid: file.type: readable file.default: '-' =item -o[ut][file]= Specify output file =for Euclid: file.type: writable file.default: '-' =back HierDemo2.pm100644001750001750 51414446775743 17302 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/t/libpackage t::lib::HierDemo2; use Getopt::Euclid; =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file =for Euclid: file.type: readable file.default: '-' =item -o[ut][file]= Specify output file =for Euclid: file.type: writable file.default: '-' =back =cut 1; fail_type_msg_2.t100644001750001750 412714446775743 17674 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tuse Test::More 'no_plan'; BEGIN { require 5.006_001 or plan 'skip_all'; close *STDERR; open *STDERR, '>', \my $stderr; *CORE::GLOBAL::exit = sub { die $stderr }; } BEGIN { $INFILE = $0; $OUTFILE = $0; $LEN = 123; $H = 2; $W = -10; $TIMEOUT = 7; @ARGV = ( '-v', "-out=$OUTFILE", 'size', "${H}x${W}", '-i', $INFILE, '-lgth', $LEN, '--timeout', $TIMEOUT, ); } if (eval { require Getopt::Euclid and Getopt::Euclid->import(); 1 }) { ok 0 => 'Unexpectedly succeeded'; } else { like $@, qr/Length \(123\) is out of bounds/ => 'Failed as expected'; } __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file =for Euclid: file.type: readable file.default: '-' =item -o[ut][file]= Specify output file =for Euclid: file.type: writable file.default: '-' =back =head1 OPTIONS =over =item size x Specify height and width =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: l.type: integer, l > 0 && l < 100 l.type.error: Length (l) is out of bounds! l.default: 24 =item -v[erbose] Print all warnings =item --timeout [] [] =for Euclid: min.type: int max.type: int =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) fail_bad_name_2.t100644001750001750 223214446775743 17566 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tuse Test::More 'no_plan'; BEGIN { require 5.006_001 or plan 'skip_all'; close *STDERR; open *STDERR, '>', \my $stderr; *CORE::GLOBAL::exit = sub { die $stderr }; } if (eval { require Getopt::Euclid and Getopt::Euclid->import(); 1 }) { ok 0 => 'Unexpectedly succeeded'; } else { like $@, qr/Getopt::Euclid: Invalid argument specification: --delta delta>/ => 'Failed as expected'; } __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 OPTIONS =over =item --delta delta> =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) insert_defaults.t100644001750001750 1151614446775743 20044 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tBEGIN { $INFILE = $0; $OUTFILE = $0; @ARGV = ( '-i', $INFILE, "-out=$OUTFILE", ); chmod 0644, $0; } sub lucky { my ($num) = @_; return $num == 7; } use Getopt::Euclid; use Test::More 'no_plan'; my $help = < -o= [options] insert_defaults.t --help insert_defaults.t --man insert_defaults.t --usage insert_defaults.t --version \=head1 Required arguments: \=over \=item -i[nfile] [=] Specify input file [default: -] \=item -o[ut][file]= Specify output file [default: -] \=back \=head1 Options: \=over \=item size []x[] Specify height and width [optional default: 1.8 x 0.2] \=item -l[[en][gths]] ... Display lengths [default: 24 36.3 10] \=item -girth Display girth [default: 42] \=item -v[erbose] Print all warnings \=item --timeout [] [] [default: min=none and max=-1] [optional default: min=none and max=-3] \=item -w | --with Test something spaced \=item Step size [default: none] \=item --version \=item --usage \=item --help \=item --man Print the usual program information \=back EOS my $help_test = Getopt::Euclid->help(); is $help_test, $help => 'Help has correct default values displayed'; my $man = < -o= [options] \=head1 REQUIRED ARGUMENTS \=over \=item -i[nfile] [=] Specify input file [default: -] \=item -o[ut][file]= Specify output file [default: -] \=back \=head1 OPTIONS \=over \=item size []x[] Specify height and width [optional default: 1.8 x 0.2] \=item -l[[en][gths]] ... Display lengths [default: 24 36.3 10] \=item -girth Display girth [default: 42] \=item -v[erbose] Print all warnings \=item --timeout [] [] [default: min=none and max=-1] [optional default: min=none and max=-3] \=item -w | --with Test something spaced \=item Step size [default: none] \=item --version \=item --usage \=item --help \=item --man Print the usual program information \=back \=head1 AUTHOR Damian Conway (damian\@conway.org) \=head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. \=head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) EOS my $man_test = Getopt::Euclid->man(); is $man_test, $man => 'Man has correct default values displayed'; __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file [default: file.default] =for Euclid: file.type: readable file.default: '-' =item -o[ut][file]= Specify output file [default: out_file.default] =for Euclid: out_file.type: writable out_file.default: '-' =back =head1 OPTIONS =over =item size []x[] Specify height and width [optional default: h.opt_default x w.opt_default] =for Euclid: h.type: number > 0 h.opt_default: 1.8 w.type: number > 0 w.opt_default: 0.2 =item -l[[en][gths]] ... Display lengths [default: l.default] =for Euclid: l.type: int > 0 l.default: [ 24, 36.3, 10 ] =item -girth Display girth [default: g value.default] =for Euclid: g value.default: 42 =item -v[erbose] Print all warnings =item --timeout [] [] [default: min=min.default and max=max.default] [optional default: min=min.opt_default and max=max.opt_default] =for Euclid: min.type: int max.type: int max.default: -1 max.opt_default: -3 =item -w | --with Test something spaced =item Step size [default: step.default] =for Euclid: step.type: int, lucky(step) =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) HierDemo2.pod100644001750001750 31414446775743 17446 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/t/lib# Getopt::Euclid-generated file. Skip me =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file =for Euclid: file.type: readable file.default: '-' =back =cut fail_bad_default.t100644001750001750 420014446775743 20046 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tuse Test::More 'no_plan'; BEGIN { require 5.006_001 or plan 'skip_all'; close *STDERR; open *STDERR, '>', \my $stderr; *CORE::GLOBAL::exit = sub { die $stderr }; } BEGIN { $INFILE = $0; $OUTFILE = $0; $LEN = 42; $H = 2; $W = -10; $TIMEOUT = 7; @ARGV = ( '-v', "-out=", $OUTFILE, "size", "${H}x${W}", "-i", $INFILE, "-lgth", $LEN, "--timeout", $TIMEOUT, ); } if (eval { require Getopt::Euclid and Getopt::Euclid->import(); 1 }) { ok 0 => 'Unexpectedly succeeded'; } else { like $@, qr/Getopt::Euclid: Invalid .default value: file.default: '-/ => 'Failed as expected'; like $@, qr/Can't find string terminator "'"/ => 'With expected message'; } __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file =for Euclid: file.type: readable file.default: '- =item -o[ut][file]= Specify output file =for Euclid: file.type: writable file.default: '-' =back =head1 OPTIONS =over =item size x Specify height and width =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: l.type: int > 0 l.default: 24 =item -v[erbose] Print all warnings =item --timeout [] [] =for Euclid: min.type: int max.type: int =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) empty_ARGV_array.t100644001750001750 426214446775743 20004 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tBEGIN { $INFILE = $0; $OUTFILE = $0; $LEN = 42; $H = 2; $W = -10; $TIMEOUT = 7; @ARGV = ( '-i', $INFILE, "-out=$OUTFILE", '-lgth', $LEN, 'size', "${H}x${W}", '-v', '--timeout', $TIMEOUT, '-w', 's p a c e s', 7, ); chmod 0644, $0; } sub lucky { my ($num) = @_; return $num == 7; } use Getopt::Euclid; use Test::More 'no_plan'; sub got_arg { my ($key, $val) = @_; is $ARGV{$key}, $val, "Got expected value for $key"; } is_deeply \@ARGV, [] => '@ARGV emptied on success'; __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file =for Euclid: file.type: readable file.default: '-' =item -o[ut][file]= Specify output file =for Euclid: out_file.type: writable out_file.default: '-' =back =head1 OPTIONS =over =item size x Specify height and width =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: l.type: int > 0 l.default: 24 =item -girth Display girth [default: 42 ] =for Euclid: g.default: 42 =item -v[erbose] Print all warnings =item --timeout [] [] =for Euclid: min.type: int max.type: int max.default: -1 =item -w Test something spaced =item Step size =for Euclid: step.type: int, lucky(step) =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) fail_unknown_arg.t100644001750001750 377614446775743 20165 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tuse Test::More 'no_plan'; BEGIN { require 5.006_001 or plan 'skip_all'; close *STDERR; open *STDERR, '>', \my $stderr; *CORE::GLOBAL::exit = sub { die $stderr }; } BEGIN { $INFILE = $0; $OUTFILE = $0; $LEN = 42; $H = 2; $W = -10; $TIMEOUT = 7; @ARGV = ( '-b', "-out=", $OUTFILE, "size", "${H}x${W}", "-i", $INFILE, "-lgth", $LEN, "--timeout", $TIMEOUT, ); } if (eval { require Getopt::Euclid and Getopt::Euclid->import(); 1 }) { ok 0 => 'Unexpectedly succeeded'; } else { like $@, qr/Unknown argument: -b/ => 'Failed as expected'; } __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file =for Euclid: file.type: readable file.default: '-' =item -o[ut][file]= Specify output file =for Euclid: file.type: writable file.default: '-' =back =head1 OPTIONS =over =item size x Specify height and width =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: l.type: int > 0 l.default: 24 =item -v[erbose] Print all warnings =item --timeout [] [] =for Euclid: min.type: int max.type: int =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) simple_alternate.t100644001750001750 626614446775743 20167 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tBEGIN { $INFILE = $0; $OUTFILE = $0; $LEN = 42; $H = 2; $W = -10; $TIMEOUT = 7; @ARGV = ( '-i', $INFILE, "-out=$OUTFILE", '-lgth', $LEN, 'size', "${H}x${W}", '-v', '--timeout', $TIMEOUT, '--with', 's p a c e s', 7, ); chmod 0644, $0; } sub lucky { my ($num) = @_; return $num == 7; } use Getopt::Euclid; use Test::More 'no_plan'; sub got_arg { my ($key, $val) = @_; is $ARGV{$key}, $val, "Got expected value for $key"; } is keys %ARGV, 18 => 'Right number of args returned'; got_arg -i => $INFILE; got_arg -infile => $INFILE; got_arg -l => $LEN; got_arg -len => $LEN; got_arg -length => $LEN; got_arg -lgth => $LEN; got_arg -girth => 42; got_arg -o => $OUTFILE; got_arg -ofile => $OUTFILE; got_arg -out => $OUTFILE; got_arg -outfile => $OUTFILE; got_arg -v => 1, got_arg -verbose => 1, is ref $ARGV{'--timeout'}, 'HASH' => 'Hash reference returned for timeout'; is $ARGV{'--timeout'}{min}, $TIMEOUT => 'Got expected value for timeout '; is $ARGV{'--timeout'}{max}, -1 => 'Got default value for timeout '; is ref $ARGV{size}, 'HASH' => 'Hash reference returned for size'; is $ARGV{size}{h}, $H => 'Got expected value for size '; is $ARGV{size}{w}, $W => 'Got expected value for size '; is $ARGV{'--with'}, 's p a c e s' => 'Handled spaces correctly'; is $ARGV{-w}, 's p a c e s' => 'Handled alternation correctly'; is $ARGV{''}, 7 => 'Handled step size correctly'; __END__ =head1 NAME orchestrate =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 COMMANDLINE MANDATORY ARGUMENTS =over =item -i[nfile] [=] Specify input file =for Euclid: file.type: readable file.default: '-' =item -o[ut][file]= Specify output file =for Euclid: out_file.type: writable out_file.default: '-' =back =head1 SCRIPT OPTIONAL PARAMETERS =over =item size x Specify height and width =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: l.type: int > 0 l.default: 24 =item -girth Display girth [default: 42 ] =for Euclid: g.default: 42 =item -v[erbose] Print all warnings =item --timeout [] [] =for Euclid: min.type: int max.type: int max.default: -1 =item -w | --with Test something spaced =item Step size =for Euclid: step.type: int, lucky(step) =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) fail_quoted_args.t100644001750001750 113114446775743 20131 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tuse Test::More 'no_plan'; BEGIN { require 5.006_001 or plan 'skip_all'; close *STDERR; open *STDERR, '>', \my $stderr; *CORE::GLOBAL::exit = sub { die $stderr }; } BEGIN { @ARGV = ( '-foo bar', ); # This is equivalent to running: # quoted_args_3.t '-foo bar' # or: # quoted_args_2.t -foo\ bar } if (eval { require Getopt::Euclid and Getopt::Euclid->import(); 1 }) { ok 0 => 'Unexpectedly succeeded'; } else { like $@, qr/Unknown argument/ => 'Failed as expected'; } =head1 REQUIRED ARGUMENTS =over =item -foo =back =cut fail_missing_var.t100644001750001750 367714446775743 20156 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tuse Test::More 'no_plan'; BEGIN { require 5.006_001 or plan 'skip_all'; close *STDERR; open *STDERR, '>', \my $stderr; *CORE::GLOBAL::exit = sub { die $stderr }; } BEGIN { $INFILE = $0; $OUTFILE = $0; $LEN = 42; $TIMEOUT = 7; @ARGV = ( "-out=", $OUTFILE, "size", "-i", $INFILE, "-lgth", $LEN, "--timeout", $TIMEOUT, ); } if (eval { require Getopt::Euclid and Getopt::Euclid->import(); 1 }) { ok 0 => 'Unexpectedly succeeded'; } else { like $@, qr/Unknown argument: size/ => 'Failed as expected'; } __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file =for Euclid: file.type: readable file.default: '-' =item -o[ut][file]= Specify output file =for Euclid: file.type: writable file.default: '-' =back =head1 OPTIONS =over =item size x Specify height and width =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: l.type: int > 0 l.default: 24 =item -v[erbose] Print all warnings =item --timeout [] [] =for Euclid: min.type: int max.type: int =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) Getopt000755001750001750 014446775743 16045 5ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/libEuclid.pm100644001750001750 24426714446775743 20027 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/lib/Getoptpackage Getopt::Euclid; use version; our $VERSION = version->declare('0.4.5'); use warnings; use strict; use 5.005000; # perl 5.5.0 use Carp; use Symbol (); use re 'eval'; # for matcher regex use Pod::Select; use Pod::PlainText; use File::Basename; use File::Spec::Functions qw(splitpath catpath catfile); use List::Util qw( first ); use Text::Balanced qw(extract_multiple extract_bracketed extract_variable extract_delimited); # Set some module variables my $skip_keyword = 'Getopt::Euclid'; # Ignore files with a first line containing this keyword. my $pod_file_msg = "# This file was generated dynamically by $skip_keyword. Do not edit it."; my $has_run = 0; my $has_processed_pod = 0; my $export_lvl = 1; my @pod_names; my $minimal_keys; my $vars_prefix; my $defer = 0; my $matcher; my %requireds; my %options; my %longnames; our $man; # --man message my $help; # --help message my $usage; # --usage message my $version; # --version message my $optional_re; $optional_re = qr{ \[ [^[]* (?: (??{$optional_re}) [^[]* )* \] }xms; # Global variables our $SCRIPT_NAME; our $SCRIPT_VERSION; # for ticket # 55259 # Convert arg specification syntax to Perl regex syntax my %std_matcher_for = ( integer => '[+-]?\\d+(?:[eE][+]?\d+)?', number => '[+-]?(?:\\d+\\.?\\d*|\\.\\d+)(?:[eE][+-]?\d+)?', input => '\S+', output => '\S+', string => '\S+', q{} => '\S+', ); _make_equivalent( \%std_matcher_for, integer => [qw( int i +int +i 0+int 0+i +integer 0+integer )], number => [qw( num n +num +n 0+num 0+n +number 0+number )], input => [qw( readable in )], output => [qw( writable writeable out )], string => [qw( str s )], ); my %std_constraint_for = ( 'string' => sub { 1 }, # Always okay (matcher ensures this) 'integer' => sub { 1 }, # Always okay (matcher ensures this) '+integer' => sub { $_[0] > 0 }, '0+integer' => sub { $_[0] >= 0 }, 'number' => sub { 1 }, # Always okay (matcher ensures this) '+number' => sub { $_[0] > 0 }, '0+number' => sub { $_[0] >= 0 }, 'input' => sub { $_[0] eq '-' || -r $_[0] }, 'output' => sub { my ( $vol, $dir ) = splitpath( $_[0] ); $dir = ($vol && $dir) ? catpath($vol, $dir) : '.'; $_[0] eq '-' ? 1 : -e $_[0] ? -w $_[0] : -w $dir; }, ); _make_equivalent( \%std_constraint_for, 'integer' => [qw( int i )], '+integer' => [qw( +int +i )], '0+integer' => [qw( 0+int 0+i )], 'number' => [qw( num n )], '+number' => [qw( +num +n )], '0+number' => [qw( 0+num 0+n )], 'string' => [qw( str s )], 'input' => [qw( in readable )], 'output' => [qw( out writable writeable )], ); sub Getopt::Euclid::Importer::DESTROY { return if $has_run || $^C; # No errors when only compiling croak '.pm file cannot define an explicit import() when using Getopt::Euclid'; } sub import { shift @_; @_ = grep { !( /:minimal_keys/ and $minimal_keys = 1 ) } @_; @_ = grep { !( /:vars(?:<(\w+)>)?/ and $vars_prefix = $1 || 'ARGV_' ) } @_; @_ = grep { !( /:defer/ and $defer = 1 ) } @_; croak "Unknown mode ('$_')" for @_; $export_lvl++ if not $defer; # No POD parsing and argument processing in Perl compile mode (ticket 34195) return if $^C; # Get name of caller program and its modules in @pod_names return unless _get_pod_names(); # Extract POD of given files __PACKAGE__->process_pods( [reverse @pod_names] ); undef @pod_names; $has_run = 1; # Parse POD + parse and export arguments ###### #use Data::Dumper; print "ARGV: ".Dumper(\@ARGV); ###### __PACKAGE__->process_args( \@ARGV ) unless $defer; return 1; } sub process_pods { # Extract POD content from list of Perl scripts (.pl) and modules (.pm) and # their corresponding .pod file if available. When given the argument # {-strict => 1}, do not look for .pod files. my ($self, $perl_files, $args) = @_; my $pod_string = ''; open my $pod_fh, '>', \$pod_string or croak "Could not open filehandle to variable because $!"; for my $perl_file (@$perl_files) { my $got_pod_file = 0; if ( not $args->{-strict} ) { # Find corresponding .pod file my ($name_re, $path, $suffix) = fileparse($perl_file, qr/\.[^.]*/); my $pod_file = catfile( $path, $name_re.'.pod' ); # Get POD either from .pod file (preferably) or from Perl file if ( -e $pod_file ) { # Get .pod file content open my $in, '<', $pod_file or croak "Could not open file $pod_file because $!"; my $first_line = <$in>; chomp $first_line; if ( not ($first_line =~ m/$skip_keyword/) ) { # Skip G::E auto-generated files since they lack important data print $pod_fh "$first_line\n"; print $pod_fh $_ while <$in>; $got_pod_file = 1; } close $in; } } if (not $got_pod_file) { # Parse POD content of Perl file podselect( {-output => $pod_fh}, $perl_file ); } print $pod_fh "\n" if $pod_string; } close $pod_fh; $man = $pod_string; return 1; } sub process_args { # First, parse the POD specifications. Then, parse the given array of # arguments (\@ARGV or other) and populate %ARGV (or export specific # variable names). my ($self, $args, $options) = @_; # Parse POD if (not $has_processed_pod) { _parse_pod(); $has_processed_pod = 1; } # Set options for argument parsing if (defined $options) { if (exists $options->{-minimal_keys}) { $minimal_keys = 1; } if (exists $options->{-vars}) { $vars_prefix = $options->{-vars}; } } %ARGV = (); # Handle standard args... if ( first { $_ eq '--man' } @$args ) { _print_pod( __PACKAGE__->man(), 'paged' ); exit; } elsif ( first { $_ eq '--usage' } @$args ) { print __PACKAGE__->usage(); exit; } elsif ( first { $_ eq '--help' } @$args ) { _print_pod( __PACKAGE__->help(), 'paged' ); exit; } elsif ( first { $_ eq '--version' } @$args ) { print __PACKAGE__->version(); exit; } elsif ( first { $_ eq '--podfile' } @$args ) { # Option meant for authors my $podfile = podfile( ); print "Wrote POD manual in file $podfile\n"; exit; } # Subroutine to report problems during parsing... *_bad_arglist = sub { my (@msg) = @_; my $msg = join q{}, @msg; $msg = _rectify_arg($msg); $msg =~ s/\n?\z/\n/xms; warn "$msg\nTry this for usage help: $SCRIPT_NAME --help\n". "Or this for full manual: $SCRIPT_NAME --man\n\n"; exit 2; # Traditional "bad arg list" value }; # Run matcher... my $argv = join( q{ }, map { $_ = _escape_arg($_) } @$args ); my $all_args_ref = { %options, %requireds }; if ( my $error = _doesnt_match( $matcher, $argv, $all_args_ref ) ) { _bad_arglist($error); } # Check that all requireds have been found... my @missing; while ( my ($req) = each %requireds ) { push @missing, "\t$req\n" if !exists $ARGV{$req}; } _bad_arglist( 'Missing required argument', ( @missing == 1 ? q{} : q{s} ), ":\n", @missing ) if @missing; # Back-translate \0-quoted spaces and \1-quoted tabs... _rectify_all_args(); # Check exclusive variables, variable constraints and fill in defaults... _verify_args($all_args_ref); # Clean up @$args since everything must have been parsed @$args = (); # Clean up %ARGV for my $arg_name ( keys %ARGV ) { # Flatten non-repeatables... my $vals = delete $ARGV{$arg_name}; my $repeatable = $all_args_ref->{$arg_name}{is_repeatable}; if ($repeatable) { pop @{$vals}; } for my $val ( @{$vals} ) { my $var_count = keys %{$val}; $val = $var_count == 0 ? 1 # Boolean -> true : $var_count == 1 ? ( values %{$val} )[0] # Single var -> var's val : $val # Otherwise keep hash ; my $false_vals = $all_args_ref->{$arg_name}{false_vals}; my %vars_opt_vals; for my $arg_flag ( _get_variants($arg_name) ) { my $variant_val = $val; if ( $false_vals && $arg_flag =~ m{\A $false_vals \z}xms ) { $variant_val = $variant_val ? 0 : 1; } if ($repeatable) { push @{ $ARGV{$arg_flag} }, $variant_val; } else { $ARGV{$arg_flag} = $variant_val; } $vars_opt_vals{$arg_flag} = $ARGV{$arg_flag} if $vars_prefix; } if ($vars_prefix) { _minimize_entries_of( \%vars_opt_vals ); my $maximal = _longestname( keys %vars_opt_vals ); _export_var( $vars_prefix, $maximal, $vars_opt_vals{$maximal} ); delete $longnames{$maximal}; } } } if ($vars_prefix) { # Export any unspecified options to keep use strict happy while ( my ($opt_name, $arg_name) = each %longnames ) { my $arg_info = $all_args_ref->{$arg_name}; my $val; if ( $arg_info->{is_repeatable} or $arg_name =~ />\.\.\./ ) { # Empty arrayref for repeatable options $val = []; } else { if (keys %{ $arg_info->{var} } > 1) { # Empty hashref for non-repeatable options with multiple placeholders $val = {}; } } _export_var( $vars_prefix, $opt_name, $val ); } } if ($minimal_keys) { _minimize_entries_of( \%ARGV ); } return 1; } sub podfile { # Write the given POD doc into a .pod file, overwriting any existing .pod file return if not -e $0; my ($name_re, $path, $suffix) = fileparse($0, qr/\.[^.]*/); my $pod_file = catfile( $path, $name_re.'.pod' ); open my $out_fh, '>', $pod_file or croak "Could not write file $pod_file because $!"; print $out_fh $pod_file_msg."\n\n".__PACKAGE__->man(); close $out_fh; return $pod_file; } sub man { return $man; } sub usage { return $usage; } sub help { return $help; } sub version { return $version; } # # # # # # # # Utility subs # # # # # # # # # Recursively remove decorations on %ARGV keys sub AUTOLOAD { our $AUTOLOAD; $AUTOLOAD =~ s{.*::}{main::}xms; no strict 'refs'; goto &$AUTOLOAD; } sub _parse_pod { # Set up parsing rules... my $space_re = qr{ [^\S\n]* }xms; my $head_start_re = qr{ ^=head1 }xms; my $head_end_re = qr{ (?= $head_start_re | \z) }xms; my $pod_cmd_re = qr{ = [^\W\d]\w+ [^\n]* (?= \n\n )}xms; my $pod_cut_re = qr{ (?! \n\n ) = cut $space_re (?= \n\n )}xms; my $name_re = qr{ $space_re NAME $space_re \n }xms; my $vers_re = qr{ $space_re VERSION $space_re \n }xms; my $usage_re = qr{ $space_re USAGE $space_re \n }xms; my $std_re = qr{ STANDARD | STD | PROGRAM | SCRIPT | CLI | COMMAND(?:-|\s)?LINE }xms; my $arg_re = qr{ $space_re (?:PARAM(?:ETER)?|ARG(?:UMENT)?)S? }xms; my $options_re = qr{ $space_re $std_re? $space_re OPTION(?:AL|S)? $arg_re? $space_re \n }xms; my $required_re = qr{ $space_re $std_re? $space_re (?:REQUIRED|MANDATORY) $arg_re? $space_re \n }xms; my $euclid_arg = qr{ ^=item \s* ([^\n]*?) \s* \n\s*\n ( .*? (?: ^=for \s* (?i: Euclid) .*? \n\s*\n | (?= ^=[^\W\d]\w* | \z) ) ) }xms; # Clean up line delimiters $man =~ s{ [\n\r] }{\n}gx; # Clean up significant entities... $man =~ s{ E }{<}gxms; $man =~ s{ E }{>}gxms; # Put program name in man $SCRIPT_NAME = (-e $0) ? (splitpath $0)[-1] : 'one-liner'; $man =~ s{ ($head_start_re $name_re \s*) .*? (- .*)? $head_end_re } {$1.$SCRIPT_NAME.($2 ? " $2" : "\n\n")}xems; # Put version number in man ($SCRIPT_VERSION) = $man =~ m/$head_start_re $vers_re .*? (\d+(?:[._]\d+)+) .*? $head_end_re /xms; if ( !defined $SCRIPT_VERSION ) { $SCRIPT_VERSION = $main::VERSION; } if ( !defined $SCRIPT_VERSION ) { $SCRIPT_VERSION = (-e $0) ? localtime((stat $0)[9]) : 'one-liner'; } $man =~ s{ ($head_start_re $vers_re \s*) .*? (\s*) $head_end_re } {$1This document refers to $SCRIPT_NAME version $SCRIPT_VERSION $2}xms; # Extra info from PODs my ($options, $opt_name, $required, $req_name, $licence); while ($man =~ m/$head_start_re ($required_re) (.*?) $head_end_re /gxms) { # Required arguments my ( $more_req_name, $more_required ) = ($1, $2); $req_name = $more_req_name if not defined $req_name; $required = ( $more_required || q{} ) . ( $required || q{} ); } while ($man =~ m/$head_start_re ($options_re) (.*?) $head_end_re /gxms) { # Optional arguments my ( $more_opt_name, $more_options ) = ($1, $2); $opt_name = $more_opt_name if not defined $opt_name; $options = ( $more_options || q{} ) . ( $options || q{} ); } while ($man =~ m/$head_start_re [^\n]+ (?i: licen[sc]e | copyright ) .*? \n \s* (.*?) \s* $head_end_re /gxms) { # License information my ($more_licence) = ($1, $2); $licence = ( $more_licence || q{} ) . ( $licence || q{} ); } # Clean up interface titles... for my $name_re ( $opt_name, $req_name ) { next if !defined $name_re; $name_re =~ s{\A \s+ | \s+ \z}{}gxms; } # Extract the actual interface and store each arg entry into a hash of specifications... my $seq = 0; my $seen = {}; while ( ( $required || q{} ) =~ m{ $euclid_arg }gxms ) { $seen = _register_specs( $1, $2, $seq, \%requireds, \%longnames, $seen ); $seq++; } while ( ( $options || q{} ) =~ m{ $euclid_arg }gxms ) { $seen = _register_specs( $1, $2, $seq, \%options, \%longnames, $seen ); $seq++; } undef $seen; _minimize_entries_of( \%longnames ); # Extract Euclid information... my $all_specs = {%requireds, %options}; _process_euclid_specs( $all_specs ); # Insert default values (if any) in the program's documentation $required = _insert_default_values(\%requireds); $options = _insert_default_values(\%options ); # One-line representation of interface... my $arg_summary = join ' ', (sort { $requireds{$a}{'seq'} <=> $requireds{$b}{'seq'} } (keys %requireds)); 1 while $arg_summary =~ s/\[ [^][]* \]//gxms; if ($opt_name) { $arg_summary .= ' ' if $arg_summary; $arg_summary .= lc "[$opt_name]"; } $arg_summary =~ s/\s+/ /gxms; # Manual message $man =~ s{ ($head_start_re $usage_re \s*) .*? (\s*) $head_end_re } {$1$SCRIPT_NAME $arg_summary$2}xms; $man =~ s{ ($head_start_re $required_re \s*) .*? (\s*) $head_end_re } {$1$required$2}xms; $man =~ s{ ($head_start_re $options_re \s*) .*? (\s*) $head_end_re } {$1$options$2}xms; # Usage message $usage = " $SCRIPT_NAME $arg_summary\n"; $usage .= " $SCRIPT_NAME --help\n"; $usage .= " $SCRIPT_NAME --man\n"; $usage .= " $SCRIPT_NAME --usage\n"; $usage .= " $SCRIPT_NAME --version\n"; # Help message $help = "=head1 \L\uUsage:\E\n\n$usage\n"; $help .= "=head1 \L\u$req_name:\E\n\n$required\n\n" if ( $req_name || q{} ) =~ /\S/; $help .= "=head1 \L\u$opt_name:\E\n\n$options\n\n" if ( $opt_name || q{} ) =~ /\S/; $usage = "Usage:\n".$usage; # Version message $version = "This is $SCRIPT_NAME version $SCRIPT_VERSION\n"; $version .= "\n$licence\n" if $licence; # Convert arg specifications to regexes... _convert_to_regex( $all_specs ); # Build matcher... my @arg_list = ( values(%requireds), values(%options) ); $matcher = join '|', map { $_->{matcher} } sort( { $b->{name} cmp $a->{name} } grep { $_->{name} =~ /^[^<]/ } @arg_list ), sort( { $a->{seq} <=> $b->{seq} } grep { $_->{name} =~ /^[<]/ } @arg_list ); $matcher .= '|(?> (.+)) (?{ push @errors, $^N }) (?!)'; $matcher = '(?:' . $matcher . ')'; return 1; } sub _register_specs { my ($name_re, $spec, $seq, $storage, $longnames, $seen) = @_; my @variants = _get_variants($name_re); $storage->{$name_re} = { seq => $seq, src => $spec, name => $name_re, variants => \@variants, }; if ($minimal_keys) { my $minimal = _minimize_name($name_re); croak "Internal error: minimalist mode caused arguments ". "'$name_re' and '".$seen->{$minimal}."' to clash" if $seen->{$minimal}; $seen->{$minimal} = $name_re; } $longnames->{ _longestname(@variants) } = $name_re; return $seen; } sub _process_euclid_specs { my ($args) = @_; my %all_var_list; my %excluded_by_def; ARG: while ( (undef, my $arg) = each %$args ) { # Validate and record variable names seen here... my $var_list = _validate_name( $arg->{name} ); while (my ($var_name, undef) = each %$var_list) { $all_var_list{$var_name} = undef; } # Process arguments with a Euclid specification further $arg->{src} =~ s{^ =for \s+ Euclid\b [^\n]* \s* (.*) \z}{}ixms or next ARG; my $info = $1; $arg->{is_repeatable} = $info =~ s{^ \s* repeatable \s*? $}{}xms; my @false_vals; while ( $info =~ s{^ \s* false \s*[:=] \s* ([^\n]*)}{}xms ) { my $regex = $1; 1 while $regex =~ s/ \[ ([^]]*) \] /(?:$1)?/gxms; $regex =~ s/ (\s+) /$1.'[\\s\\0\\1]*'/egxms; push @false_vals, $regex; } if (@false_vals) { $arg->{false_vals} = '(?:' . join( '|', @false_vals ) . ')'; } while ( $info =~ m{\G \s* (([^.]+)\.([^:=\s]+) \s*[:=]\s* ([^\n]*)) }gcxms ) { my ( $spec, $var, $field, $val ) = ( $1, $2, $3, $4 ); # Check for misplaced fields... if ( $arg->{name} !~ m{\Q<$var>}xms ) { _fail( "Invalid constraint: $spec\n(No <$var> placeholder in ". "argument: $arg->{name})" ); } # Decode... if ( $field eq 'type.error' ) { $arg->{var}{$var}{type_error} = $val; } elsif ( $field eq 'type' ) { $val = _qualify_variables_fully( $val ); my ( $matchtype, $comma, $constraint ) = $val =~ m{(/(?:\.|.)+/ | [^,\s]+)\s*(?:(,))?\s*(.*)}xms; $arg->{var}{$var}{type} = $matchtype; if ( $comma && length $constraint ) { ( $arg->{var}{$var}{constraint_desc} = $constraint ) =~ s/\s*\b\Q$var\E\b\s*//g; $constraint =~ s/\b\Q$var\E\b/\$_[0]/g; $arg->{var}{$var}{constraint} = eval "sub{ $constraint }" or _fail("Invalid .type constraint: $spec\n($@)"); } elsif ( length $constraint ) { $arg->{var}{$var}{constraint_desc} = $constraint; $arg->{var}{$var}{constraint} = eval "sub{ \$_[0] $constraint }" or _fail("Invalid .type constraint: $spec\n($@)"); } else { $arg->{var}{$var}{constraint_desc} = $matchtype; $arg->{var}{$var}{constraint} = $matchtype =~ m{\A\s*/.*/\s*\z}xms ? sub { 1 } : $std_constraint_for{$matchtype} or _fail("Unknown .type constraint: $spec"); } } elsif ( ($field eq 'default') || ($field eq 'opt_default') ) { $val = _qualify_variables_fully( $val ); eval "\$val = $val; 1" or _fail("Invalid .$field value: $spec\n($@)"); $arg->{var}{$var}{$field} = $val; my $has_field = 'has_'.$field; $arg->{$has_field} = exists $arg->{$has_field} ? $arg->{$has_field}++ : 1; if ($field eq 'opt_default') { # Check that placeholders with optional defaults have a flagged argument if ( $arg->{name} =~ m{^<}xms ) { _fail( "Invalid .$field constraint: $spec\nParameter ". "$arg->{name} must have a flag" ); } # Check that placeholders with optional defaults is optional if ( $arg->{name} !~ m{\Q[<$var>]}xms ) { _fail( "Invalid .$field constraint: $spec\nPlaceholder". " <$var> must be optional, i.e. [<$var>], to have ". "an optional default in argument: $arg->{name}" ); } } } elsif ( $field eq 'excludes.error' ) { $arg->{var}{$var}{excludes_error} = $val; } elsif ( $field eq 'excludes' ) { $arg->{var}{$var}{excludes} = [ split '\s*,\s*', $val ]; for my $excl_var (@{$arg->{var}{$var}{excludes}}) { if ($var eq $excl_var) { _fail( "Invalid .excludes value for variable <$var>: ". "<$excl_var> cannot exclude itself." ); } } } else { _fail("Unknown specification: $spec"); } } # Record variables excluded by another that has a default while (my ($var_name, $var_data) = each %{$arg->{var}}) { for my $excl_var (@{$arg->{var}{$var_name}{excludes}}) { $excluded_by_def{$excl_var}{default}{$var_name} = 1 if $arg->{has_default}; $excluded_by_def{$excl_var}{opt_default}{$var_name} = 1 if $arg->{has_opt_default}; } } if ( $info =~ m{\G \s* ([^\s\0\1] [^\n]*) }gcxms ) { _fail("Unknown specification: $1"); } } # Validate and complete .excludes specs while ( (undef, my $arg) = each %$args ) { while ( my ($var, $var_specs) = each %{$arg->{var}} ) { # Check for invalid placeholder name in .excludes specifications for my $excl_var (@{$var_specs->{excludes}}) { if (not exists $all_var_list{$excl_var}) { _fail( "Invalid .excludes value for variable <$var>: ". "<$excl_var> does not exist\n" ); } } # Remove default for placeholders excluded by others that have a default for my $type ( 'default', 'opt_default' ) { if ( (exists $arg->{var}->{$var}->{$type}) && (exists $excluded_by_def{$var}{$type}) ) { delete $arg->{var}->{$var}->{$type}; $arg->{"has_$type"}--; if ($arg->{"has_$type"} == 0) { delete $arg->{"has_$type"}; } } } } } return 1; } sub _qualify_variables_fully { # Restore fully-qualified name to variables: # $x becomes $main::x # $::x becomes $main::x # $Package::x stays as $Package::x # /^asdf$/ stays as /^asdf$/ # '$10' stays as '$10' # Note: perlvar indicates that ' can also be used instead of :: my ($val) = @_; if ($val =~ m/[\$\@\%]/) { # Avoid expensive Text::Balanced operations when there are no variables my $new_val; for my $s (extract_multiple($val,[{Quoted=>sub{extract_delimited($_[0])}}],undef,0)) { if (not ref $s) { # A non-quoted section... may contain variables to fix for my $var_name ( @{_get_variable_names($s)} ) { # Skip fully qualified names, such as '$Package::x' next if $var_name =~ m/main(?:'|::)/; # Remove sigils from beginning of variable name: $ @ % { $var_name =~ s/^[\$\@\%\{]+//; # Substitute non-fully qualified vars, e.g. '$x' or '$::x', by '$main::x' my $new_name = Symbol::qualify($var_name, 'main'); next if $new_name eq $var_name; $var_name = quotemeta( $var_name ); $s =~ s/$var_name/$new_name/; } $new_val .= $s; } else { # A quoted section, to keep as-is $new_val .= $$s; } } return $new_val; } else { return $val; } } sub _get_variable_names { # Get an arrayref of the variables names found in the provided string. # This function is a hack, needed only because of Text::Balanced ticket #78855: # https://rt.cpan.org/Public/Bug/Display.html?id=78855 my ($str) = @_; my $vars = []; for my $var (extract_multiple($str,[sub{extract_variable($_[0],'')}],undef,1)) { # Name must start with underscore or a letter, e.g. $t $$h{a} ${$h}{a} $h->{a} @_ # Skip special or invalid names, e.g. $/ $1 my $tmp = $var; $tmp =~ s/(?:{|})//g; next if not $tmp =~ m/^[\$\@\%]+[_a-z]/i; push @$vars, $var; } return $vars; } sub _minimize_name { my ($name_re) = @_; $name_re =~ s{[][]}{}gxms; # remove all square brackets $name_re =~ s{\A \W+ ([\w-]*) .* \z}{$1}gxms; $name_re =~ s{-}{_}gxms; return $name_re; } sub _minimize_entries_of { my ($arg_ref) = @_; return if ref $arg_ref ne 'HASH'; for my $old_key (keys %$arg_ref) { my $new_key = _minimize_name($old_key); $arg_ref->{$new_key} = delete $arg_ref->{$old_key}; } return 1; } # Do match, recursively trying to expand cuddles... sub _doesnt_match { my ( $matcher, $argv, $arg_specs_ref ) = @_; our @errors; # 'our' instead of 'my' because it is needed for the re pragma local @errors = (); %ARGV = (); # Match arguments, populate %ARGV and @errors # Note that the matcher needs the pragma: use re 'eval'; $argv =~ m{\A (?: \s* $matcher )* \s* \z}xms; # Report errors in passed arguments for my $error (@errors) { if ( $error =~ m/\A ((\W) (\w) (\w+))/xms ) { my ( $bundle, $marker, $firstchar, $chars ) = ( $1, $2, $3, $4 ); $argv =~ s{\Q$bundle\E}{$marker$firstchar $marker$chars}xms; return if !_doesnt_match( $matcher, $argv, $arg_specs_ref ); } ARG: for my $arg_spec_ref ( values %{$arg_specs_ref} ) { our $bad_type; local $bad_type; next ARG if $error !~ m/\A [\s\0\1]* ($arg_spec_ref->{generic_matcher})/xms || !$bad_type; my $msg = _type_error( $bad_type->{arg}, $bad_type->{var}, $bad_type->{val}, $bad_type->{type}, $bad_type->{type_error} ); return $msg; } return "Unknown argument: $error"; } return 0; # No error } sub _escape_arg { my $arg = shift; my ($num_replaced) = ($arg =~ tr/ \t/\0\1/); return $arg; } sub _rectify_arg { my $arg = shift; my ($num_replaced) = ($arg =~ tr/\0\1/ \t/); return $arg; } sub _rectify_all_args { while ( my (undef, $arg_list) = each %ARGV ) { for my $arg ( @{$arg_list} ) { if ( ref $arg eq 'HASH' ) { for my $var ( values %{$arg} ) { if ( ref $var eq 'ARRAY' ) { $var = [ map { _rectify_arg($_) } @{$var} ]; } else { $var = _rectify_arg($var); } } } else { if ( ref $arg eq 'ARRAY' ) { $arg = [ map { _rectify_arg($_) } @{$arg} ]; } else { $arg = _rectify_arg($arg); } } } } return 1; } sub _verify_args { my ($arg_specs_ref) = @_; # Check exclusive variables, variable constraints and fill in defaults... # Handle mutually exclusive arguments my %seen_vars; while ( my ($arg_name, $arg_elems) = each %ARGV ) { for my $elem (@{$arg_elems}) { while ( my ($var_name) = each (%{$elem}) ) { $seen_vars{$var_name} = $arg_name if $var_name; } } } while ( my ($arg_name, $arg) = each %{$arg_specs_ref} ) { while ( my ($var_name, $var) = each %{$arg->{var}} ) { # Enforce placeholders that cannot be specified with others for my $excluded_var ( @{$var->{excludes}} ) { if (exists $seen_vars{$var_name} && exists $seen_vars{$excluded_var}) { my $excl_arg = $seen_vars{$excluded_var}; my $msg; if (exists $var->{excludes_error}) { $msg = $var->{excludes_error}; } else { $msg = qq{Invalid "$excl_arg" argument.\n<$excluded_var> }. qq{cannot be specified with <$var_name> because }. qq{argument "$arg_name" excludes <$excluded_var>}; } _bad_arglist($msg); } } } } # Enforce constraints and fill in defaults... ARG: while (my ($arg_name, $arg_specs) = each %{$arg_specs_ref} ) { # Skip non-existent/non-defaulting/non-optional-defaulting arguments next ARG if !exists $ARGV{$arg_name} && !( $arg_specs->{has_default} || $arg_specs->{has_opt_default} ); # Ensure all vars exist within arg... my @vars = keys %{$arg_specs->{placeholders}}; for my $index ( 0 .. $#{ $ARGV{$arg_name} } ) { my $entry = $ARGV{$arg_name}[$index]; @{$entry}{@vars} = @{$entry}{@vars}; # Get arg specs... VAR: for my $var (@vars) { my $arg_vars = $arg_specs->{var}->{$var}; # Check constraints on vars... if ( exists $ARGV{$arg_name} ) { if ( ref $entry eq 'HASH' && defined $entry->{$var} ) { # Named vars... for my $val ( ref $entry->{$var} eq 'ARRAY' ? @{ $entry->{$var} } : $entry->{$var} ) { if ( $arg_vars->{constraint} && !$arg_vars->{constraint}->($val) ) { _bad_arglist( _type_error($arg_name, $var, $val, $arg_vars->{constraint_desc}, $arg_vars->{type_error}) ); } } next VAR; } elsif ( ref $entry ne 'HASH' && defined $entry ) { # Unnamed vars... for my $val ( ref $entry eq 'ARRAY' ? @{$entry} : $entry ) { if ( $arg_vars->{constraint} && !$arg_vars->{constraint}->($val) ) { _bad_arglist( _type_error( $arg_name, $var, $val, $arg_vars->{constraint_desc}, $arg_vars->{type_error}) ); } $entry->{$var} = '' unless defined( $ARGV{$arg_name} ); } next VAR; } } # Assign placeholder defaults (if necessary)... next ARG if !exists $arg_vars->{default} && !exists $arg_vars->{opt_default}; $entry->{$var} = exists $arg_vars->{opt_default} ? $arg_vars->{opt_default} : $arg_vars->{default}; } } # Handle defaults for missing args... if ( !@{ $ARGV{$arg_name} } ) { for my $var (@vars) { # Assign defaults (if necessary)... my $arg_vars = $arg_specs->{var}->{$var}; next ARG if !exists $arg_vars->{default}; # no default specified # Omit default if it conflicts with a specified parameter for my $excl_var ( @{$arg_specs->{var}->{$var}->{excludes}} ) { if (exists $seen_vars{$excl_var}) { next ARG; } } $ARGV{$arg_name}[0]{$var} = $arg_vars->{default}; } } } return 1; } sub _type_error { my ($arg_name, $var_name, $var_val, $var_constraint, $var_error) = @_; my $msg = qq{Invalid "$arg_name" argument.\n}; $var_name =~ s{\W+}{}gxms; if ( $var_error ) { $msg = $var_error; $msg =~ s{(?)}{$var_val}gxms; } else { $msg = qq{<$var_name> must be $var_constraint but the supplied value }. qq{("$var_val") is not.}; } return $msg; } sub _convert_to_regex { my ($args_ref) = @_; # Regexp to capture the start of a new argument my $no_esc_ws = '(?!\0)'; # no escaped whitespaces my @arg_variants; while ( my ($arg_name, $arg_specs) = each %{$args_ref} ) { push @arg_variants, @{$arg_specs->{variants}}; } my $no_match = join('|',@arg_variants); $no_match = _escape_specials($no_match); $no_match = '(?!(?:'.$no_match.')'.$no_esc_ws.')'; while ( my ($arg_name, $arg) = each %{$args_ref} ) { my $regex = $arg_name; # Quotemeta specials... $regex = _escape_specials($regex); $regex = "(?:$regex)"; # Convert optionals... 1 while $regex =~ s/ \[ ([^]]*) \] /(?:$1)?/gxms; $regex =~ s/ (\s+) /$1.'\s*'.$no_esc_ws/egxms; my $generic = $regex; # Set the matcher $regex =~ s{ < (.*?) >(\.\.\.|) } { my ($var_name, $var_rep) = ($1, $2); $var_name =~ s/(\s+)\[\\s\\0\\1]\*/$1/gxms; my $type = $arg->{var}{$var_name}{type} || q{}; $arg->{placeholders}->{$var_name} = undef; my $matcher = $type =~ m{\A\s*/.*/\s*\z}xms ? eval "qr$type" : $std_matcher_for{ $type } or _fail("Unknown type ($type) in specification: $arg_name"); $var_rep ? "(?:[\\s\\0\\1]*$no_match($matcher)(?{push \@{(\$ARGV{q{$arg_name}}||=[{}])->[-1]{q{$var_name}}}, \$^N}))+" : "(?:$no_match($matcher)(?{(\$ARGV{q{$arg_name}}||=[{}])->[-1]{q{$var_name}} = \$^N}))"; }gexms or do { $regex .= "(?{(\$ARGV{q{$arg_name}}||=[{}])->[-1]{q{}} = 1})"; }; if ( $arg->{is_repeatable} ) { $arg->{matcher} = "$regex (?:(?{matcher} = "(??{exists\$ARGV{q{$arg_name}}?'(?!)':''}) " . ( $arg->{false_vals} ? "(?:$arg->{false_vals} (?:(? 0 }] }) | $regex (?:(? 1}] }))" : "$regex (?:(? } { my $var_name = $1; $var_name =~ s/(\s+)\[\\s\\0\\1]\*/$1/gxms; my $type = $arg->{var}{$var_name}{type} || q{}; my $type_error = $arg->{var}{$var_name}{type_error} || q{}; my $matcher = $type =~ m{\A\s*/.*/\s*\z}xms ? eval "qr$type" : $std_matcher_for{ $type }; "(?:($matcher|([^\\s\\0\\1]+)" . "(?{\$bad_type ||= " . "{arg=>q{$arg_name},type=>q{$type},type_error=>q{$type_error}, var=>q{<$var_name>},val=>\$^N};})))" }gexms; $arg->{generic_matcher} = $generic; } return 1; } sub _escape_specials { # Escape quotemeta special characters my $arg = shift; $arg =~ s{([@#\$^*()+{}?])}{\\$1}gxms; return $arg; } sub _print_pod { my ( $pod, $paged ) = @_; if ($paged) { # Page output eval { require IO::Pager::Page } or eval { require IO::Page }; } # Convert POD to plaintext, wrapping the lines at 76 chars and print to STDOUT open my $parser_in, '<', \$pod or croak "Could not read from variable because $!"; Pod::PlainText->new()->parse_from_filehandle($parser_in); close $parser_in; return 1; } sub _validate_name { # Check that the argument name only has pairs of < > brackets (ticket 34199) # Return the name of the variables that this argument specifies my ($name) = @_; if ($name =~ m/[<>]/) { # skip expensive Text::Balance functions if possible my %var_names; my $pos = 0; for my $s (extract_multiple($name,[sub{extract_bracketed($_[0],'<>')}],undef,0)) { next if not $s =~ m/[<>]/; $s =~ s/^<(.*)>$/$1/; if ( $s =~ m/[<>]/ ) { _fail( 'Invalid argument specification: '.$name ); } $pos++; $var_names{$s} = $pos if not exists $var_names{$s}; } return \%var_names; } else { return {}; } } sub _get_variants { my @arg_desc = shift =~ m{ [^[|]+ (?: $optional_re [^[|]* )* }gmxs; for (@arg_desc) { s{^ \s+ | \s+ $}{}gxms; } # Only consider first "word"... return $1 if $arg_desc[0] =~ m/\A (< [^>]+ >)/xms; $arg_desc[0] =~ s/\A ([^\s<]+) \s* (?: < .*)? \z/$1/xms; # Variants are all those with and without each optional component... my %variants; while (@arg_desc) { my $arg_desc_with = shift @arg_desc; my $arg_desc_without = $arg_desc_with; if ( $arg_desc_without =~ s/ \[ [^][]* \] //xms ) { push @arg_desc, $arg_desc_without; } if ( $arg_desc_with =~ m/ [[(] ([^][()]*) [])] /xms ) { my $option = $1; for my $alternative ( split /\|/, $option ) { my $arg_desc = $arg_desc_with; $arg_desc =~ s{[[(] [^][()]* [])]}{$alternative}xms; push @arg_desc, $arg_desc; } } $arg_desc_with =~ s/[][]//gxms; $arg_desc_with =~ s/\b[^-\w] .* \z//xms; $variants{$arg_desc_with} = 1; } return keys %variants; } sub _longestname { return ( sort { length $a <=> length $b || $a cmp $b } @_ )[-1]; } sub _export_var { my ( $prefix, $key, $value ) = @_; my $export_as = $prefix . $key; $export_as =~ s{\W}{_}gxms; # mainly for '-' my $callpkg = caller( $export_lvl + ($Exporter::ExportLevel || 0) ); no strict 'refs'; *{"$callpkg\::$export_as"} = ( ref $value ) ? $value : \$value; return 1; } # Utility sub to factor out hash key aliasing... sub _make_equivalent { my ( $hash_ref, %alias_hash ) = @_; while ( my ( $name_re, $aliases ) = each %alias_hash ) { for my $alias (@$aliases) { $hash_ref->{$alias} = $hash_ref->{$name_re}; } } return 1; } # Report problems in specification and die sub _fail { my (@msg) = @_; croak "Getopt::Euclid: @msg"; } sub _get_pod_names { # Parse the POD of the caller program and its modules. my @caller = caller(1); # Sanity check if ($has_run) { carp 'Getopt::Euclid loaded a second time'; warn "Second attempt to parse command-line was ignored\n"; return 0; } # Handle calls from .pm files if ( $caller[1] =~ m/[.]pm \z/xms ) { my @caller = caller(1); # at import()'s level push @pod_names, $caller[1]; # Install this import() sub as module's import sub... no strict 'refs'; croak '.pm file cannot define an explicit import() when using Getopt::Euclid' if *{"$caller[0]::import"}{CODE}; my $lambda; # Needed so the anon sub is generated at run-time *{"$caller[0]::import"} = bless sub { $lambda = 1; goto &Getopt::Euclid::import }, 'Getopt::Euclid::Importer'; return 0; } # Add name of caller program push @pod_names, $0 if (-e $0); # When calling perl -e '...', $0 is '-e', i.e. not a actual file return 1; } sub _insert_default_values { my ($args) = @_; my $pod_string = ''; # Retrieve item names in sequential order for my $item_name ( sort { $args->{$a}->{'seq'} <=> $args->{$b}->{'seq'} } (keys %$args) ) { my $item_spec = $args->{$item_name}->{'src'}; $item_spec =~ s/=for(.*)//ms; $pod_string .= "=item $item_name\n\n"; # Get list of variable for this argument while ( my ($var_name, $var) = each %{$args->{$item_name}->{var}} ) { # Get default for this variable for my $default_type ( 'default', 'opt_default' ) { my $var_default; if (exists $var->{$default_type}) { if (ref($var->{$default_type}) eq 'ARRAY') { $var_default = join(' ', @{$var->{$default_type}}); } elsif (ref($var->{$default_type}) eq '') { $var_default = $var->{$default_type}; } else { carp 'Getopt::Euclid found an unexpected default value type'; } } else { $var_default = 'none'; } $item_spec =~ s/$var_name\.$default_type/$var_default/g; } } if ($item_spec =~ m/(\S+(\.(?:opt_)?default))/) { my ($reference, $default_type) = ($1, $2); _fail( "Invalid reference to field $reference in argument ". "description:\n$item_spec" ); } $pod_string .= $item_spec; } $pod_string = "=over\n\n".$pod_string."=back\n\n"; return $pod_string; } 1; # Magic true value required at end of module =head1 NAME Getopt::Euclid - Executable Uniform Command-Line Interface Descriptions =head1 VERSION This document describes Getopt::Euclid version 0.4.5 =head1 SYNOPSIS use Getopt::Euclid; if ($ARGV{-i}) { print "Interactive mode...\n"; } for my $x (0..$ARGV{-size}{h}-1) { for my $y (0..$ARGV{-size}{w}-1) { do_something_with($x, $y); } } __END__ =head1 NAME yourprog - Your program here =head1 VERSION This documentation refers to yourprog version 1.9.4 =head1 USAGE yourprog [options] -s[ize]=x -o[ut][file] =head1 REQUIRED ARGUMENTS =over =item -s[ize]=x Specify size of simulation =for Euclid: h.type: int > 0 h.default: 24 w.type: int >= 10 w.default: 80 =item -o[ut][file] Specify output file =for Euclid: file.type: writable file.default: '-' =back =head1 OPTIONS =over =item -i Specify interactive simulation =item -l[[en][gth]] Length of simulation. The default is l.default =for Euclid: l.type: int > 0 l.default: 99 =item --debug [] Set the log level. Default is log_level.default but if you provide --debug, then it is log_level.opt_default. =for Euclid: log_level.type: int log_level.default: 0 log_level.opt_default: 1 =item --version =item --usage =item --help =item --man Print the usual program information =back Remainder of documentation starts here... =head1 AUTHOR Damian Conway (DCONWAY@CPAN.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2005, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) =head1 DESCRIPTION Getopt::Euclid uses your program's own POD documentation to create a powerful command-line argument parser. This ensures that your program's documented interface and its actual interface always agree. The created command-line argument parser includes many features such as argument type checking, required arguments, exclusive arguments, optional arguments with default values, automatic usage message, ... To use the module, simply write the following at the top of your program: use Getopt::Euclid; This will cause Getopt::Euclid to be require'd and its import method will be called. It is important that the import method be allowed to run, so do not invoke Getopt::Euclid in the following manner: # Will not work use Getopt::Euclid (); When the module is loaded within a regular Perl program, it will: =over =item 1. locate any POD in the same *.pl file or its associated *.pod file. =item 2. extract information from that POD, most especially from the C<=head1 REQUIRED ARGUMENTS> and C<=head1 OPTIONS> sections, =item 3. build a parser that parses the arguments and options the POD specifies, =item 4. remove the command-line arguments from C<@ARGV> and parse them, and =item 5. put the results in the global C<%ARGV> variable (or into specifically named optional variables, if you request that -- see L). =back As a special case, if the module is loaded within some other module (i.e. from within a C<.pm> file), it still locates and extracts POD information, but instead of parsing C<@ARGV> immediately, it caches that information and installs an C subroutine in the caller module. This new C acts just like Getopt::Euclid's own import, except that it adds the POD from the caller module to the POD of the callee. All of which just means you can put some or all of your CLI specification in a module, rather than in the application's source file. See L for more details. =head1 INTERFACE =head2 Program interface You write: use Getopt::Euclid; and your command-line is parsed automagically. =head2 Module interface =over =item import() You write: use Getopt::Euclid; and your module will then act just like Getopt::Euclid (i.e. you can use your module I of Getopt::Euclid>, except that your module's POD will also be prepended to the POD of any module that loads yours. In other words, you can use Getopt::Euclid in a module to create a standard set of CLI arguments, which can then be added to any application simply by loading your module. To accomplish this trick Getopt::Euclid installs an C subroutine in your module. If your module already has an C subroutine defined, terrible things happen. So do not do that. You may also short-circuit the import method within your calling program to have the POD from several modules included for argument parsing. use Module1::Getopt (); # No argument parsing use Module2::Getopt (); # No argument parsing use Getopt::Euclid; # Arguments parsed =item process_args() Alternatively, to parse arguments from a source different from C<@ARGV>, use the C subroutine. use Getopt::Euclid qw(:defer); my @args = ( '-in', 'file.txt', '-out', 'results.txt' ); Getopt::Euclid->process_args(\@args); If you want to use the :minimal or :vars mode in this type of scenario, you can pass extra options to C: use Getopt::Euclid qw(:defer); my @args = ( '-in', 'file.txt', '-out', 'results.txt' ); Getopt::Euclid->process_args(\@args, {-minimal => 1, -vars => 'prefix_'}); This is particularly when you plan on processing POD manually. =item process_pods() Similarly, to parse argument specifications from a source different than the current script (and its dependencies), use the C subroutine. use Getopt::Euclid (); my @pods = ( 'script.pl', 'Module.pm' ); $Getopt::Euclid::MAN = Getopt::Euclid->process_pods(\@pods, {-strict => 1}); my @args = ( '-in', 'file.txt', '-out', 'results.txt' ); Getopt::Euclid->process_args(\@args); By default, this method will look for .pod files associated with the given .pl and .pm files and use these .pod files preferentially when available. Set -strict to 1 to only use the given files. =back =head2 POD interface This is where all the action is. POD markup can be placed in a .pod file that has the same prefix as the corresponding Perl file. Alternatively, POD can be inserted anywhere in the Perl code, but is typically added either after an __END__ statement (like in the L), or interspersed in the code: use Getopt::Euclid; =head1 NAME yourprog - Your program here =head1 REQUIRED ARGUMENTS =over =item -s[ize]=x Specify size of simulation =for Euclid: h.type: int > 0 h.default: 24 w.type: int >= 10 w.default: 80 =back =head1 OPTIONS =over =item -i Specify interactive simulation =back =cut # Getopt::Euclid has parsed commandline parameters and stored them in %ARGV if ($ARGV{-i}) { print "Interactive mode...\n"; } for my $x (0..$ARGV{-size}{h}-1) { for my $y (0..$ARGV{-size}{w}-1) { do_something_with($x, $y); } } When Getopt::Euclid is loaded in a non-C<.pm> file, it searches that file for the following POD documentation: =over =item =head1 NAME Getopt::Euclid ignores the name specified here. In fact, if you use the standard C<--help>, C<--usage>, C<--man>, C<--podfile>, or C<--version> arguments (see L), the module replaces the name specified in this POD section with the actual name by which the program was invoked (i.e. with C<$0>). =item =head1 USAGE Getopt::Euclid ignores the usage line specified here. If you use the standard C<--help>, C<--usage>, C<--man> or C<--podfile> arguments, the module replaces the usage line specified in this POD section with a usage line that reflects the actual interface that the module has constructed. =item =head1 VERSION Getopt::Euclid extracts the current version number from this POD section. To do that it simply takes the first substring that matches I<< >>.I<< >> or I<< >>_I<< >>. It also accepts one or more additional trailing .I<< >> or _I<< >>, allowing for multi-level and "alpha" version numbers such as: =head1 VERSION This is version 1.2.3 or: =head1 VERSION This is alpha release 1.2_34 You may also specify the version number in your code. However, in order for Getopt::Euclid to properly read it, it must be in a C block: BEGIN { use version; our $VERSION = qv('1.2.3') } use Getopt::Euclid; Euclid stores the version as C<$Getopt::Euclid::SCRIPT_VERSION>. =item =head1 REQUIRED ARGUMENTS Getopt::Euclid uses the specifications in this POD section to build a parser for command-line arguments. That parser requires that every one of the specified arguments is present in any command-line invocation. See L for details of the specification syntax. The actual headings that Getopt::Euclid can recognize here are: =head1 [STANDARD|STD|PROGRAM|SCRIPT|CLI|COMMAND[-| ]LINE] [REQUIRED|MANDATORY] [PARAM|PARAMETER|ARG|ARGUMENT][S] B Do not put additional subheadings (=headX) inside the REQUIRED ARGUMENTS section. =item =head1 OPTIONS Getopt::Euclid uses the specifications in this POD section to build a parser for command-line arguments. That parser does not require that any of the specified arguments is actually present in a command-line invocation. Again, see L for details of the specification syntax. Typically a program will specify both C and C, but there is no requirement that it supply both, or either. The actual headings that Getopt::Euclid recognizes here are: =head1 [STANDARD|STD|PROGRAM|SCRIPT|CLI|COMMAND[-| ]LINE] OPTION[AL|S] [PARAM|PARAMETER|ARG|ARGUMENT][S] B Do not put additional subheadings (=headX) inside the REQUIRED ARGUMENTS section. =item =head1 COPYRIGHT Getopt::Euclid prints this section whenever the standard C<--version> option is specified on the command-line. The actual heading that Getopt::Euclid recognizes here is any heading containing any of the words "COPYRIGHT", "LICENCE", or "LICENSE". =back =head2 Specifying arguments Each required or optional argument is specified in the POD in the following format: =item ARGUMENT_STRUCTURE ARGUMENT_DESCRIPTION =for Euclid: ARGUMENT_OPTIONS PLACEHOLDER_CONSTRAINTS =head3 Argument structure =over =item * Each argument is specified as an C<=item>. =item * Any part(s) of the specification that appear in square brackets are treated as optional. =item * Any parts that appear in angle brackets are placeholders for actual values that must be specified on the command-line. =item * Any placeholder that is immediately followed by C<...> may be repeated as many times as desired. =item * Any whitespace in the structure specifies that any amount of whitespace (including none) is allowed at the same position on the command-line. =item * A vertical bar indicates the start of an alternative variant of the argument. =back For example, the argument specification: =item -i[n] [=] | --from indicates that any of the following may appear on the command-line: -idata.txt -i data.txt -i=data.txt -i = data.txt -indata.txt -in data.txt -in=data.txt -in = data.txt --from data.text as well as any other combination of whitespacing. Any of the above variations would cause all three of: $ARGV{'-i'} $ARGV{'-in'} $ARGV{'--from'} to be set to the string C<'data.txt'>. You could allow the optional C<=> to also be an optional colon by specifying: =item -i[n] [=|:] Optional components may also be nested, so you could write: =item -i[n[put]] [=] which would allow C<-i>, C<-in>, and C<-input> as synonyms for this argument and would set all three of C<$ARGV{'-i'}>, C<$ARGV{'-in'}>, and C<$ARGV{'-input'}> to the supplied file name. The point of setting every possible variant within C<%ARGV> is that this allows you to use a single key (say C<$ARGV{'-input'}>, regardless of how the argument is actually specified on the command-line. =head2 Repeatable arguments Normally Getopt::Euclid only accepts each specified argument once, the first time it appears in @ARGV. However, you can specify that an argument may appear more than once, using the C option: =item file= =for Euclid: repeatable When an argument is marked repeatable the corresponding entry of C<%ARGV> will not contain a single value, but rather an array reference. If the argument also has L, then the corresponding entry in C<%ARGV> will be an array reference with each array entry being a hash reference. =head2 Boolean arguments If an argument has no placeholders it is treated as a boolean switch and its entry in C<%ARGV> will be true if the argument appeared in C<@ARGV>. For a boolean argument, you can also specify variations that are I, if they appear. For example, a common idiom is: =item --print Print results =item --noprint Do not print results These two arguments are effectively the same argument, just with opposite boolean values. However, as specified above, only one of C<$ARGV{'--print'}> and C<$ARGV{'--noprint'}> will be set. As an alternative you can specify a single argument that accepts either value and sets both appropriately: =item --[no]print [Do not] print results =for Euclid: false: --noprint With this specification, if C<--print> appears in C<@ARGV>, then C<$ARGV{'--print'}> will be true and C<$ARGV{'--noprint'}> will be false. On the other hand, if C<--noprint> appears in C<@ARGV>, then C<$ARGV{'--print'}> will be false and C<$ARGV{'--noprint'}> will be true. The specified false values can follow any convention you wish: =item [+|-]print =for Euclid: false: -print or: =item -report[_no[t]] =for Euclid: false: -report_no[t] et cetera. =head2 Multiple placeholders An argument can have two or more placeholders: =item -size The corresponding command line argument would then have to provide two values: -size 24 80 Multiple placeholders can optionally be separated by literal characters (which must then appear on the command-line). For example: =item -size x would then require a command-line of the form: -size 24x80 If an argument has two or more placeholders, the corresponding entry in C<%ARGV> becomes a hash reference, with each of the placeholder names as one key. That is, the above command-line would set both C<$ARGV{'-size'}{'h'}> and C<$ARGV{'-size'}{'w'}>. =head2 Optional placeholders Placeholders can be specified as optional as well: =item -size [] This specification then allows either: -size 24 or: -size 24 80 on the command-line. If the second placeholder value is not provided, the corresponding C<$ARGV{'-size'}{'w'}> entry is set to C. See also L. =head2 Unflagged placeholders If an argument consists of a single placeholder with no "flag" marking it: =item then the corresponding entry in C<%ARG> will have a key the same as the placeholder (including the surrounding angle brackets): if ($ARGV{''} eq '-') { $fh = \*STDIN; } The same is true for any more-complicated arguments that begin with a placeholder: =item [x ] The only difference in the more-complex cases is that, if the argument has any additional placeholders, the entire entry in C<%ARGV> becomes a hash: my $total_size = $ARGV{''}{'h'} * $ARGV{''}{'w'} Note that, as in earlier multi-placeholder examples, the individual second- level placeholder keys I retain their angle-brackets. =head2 Repeated placeholders Any placeholder that is immediately followed by C<...>, like so: =item -lib ... =for Euclid: file.type: readable will match at least once, but as many times as possible before encountering the next argument on the command-line. This allows one to specify multiple values for an argument, for example: -lib file1.txt file2.txt An unconstrained repeated unflagged placeholder (see L and L) will consume the rest of the command-line, and so should be specified last in the POD =item -n =item ... =for Euclid: offset.type: 0+int and on the command-line: -n foobar 1 5 0 23 If a placeholder is repeated, the corresponding entry in C<%ARGV> will then be an array reference, with each individual placeholder match in a separate element. For example: for my $lib (@{ $ARGV{'-lib'} }) { add_lib($lib); } warn "First offset is: $ARGV{''}[0]"; my $first_offset = shift @{ $ARGV{''} }; =head2 Placeholder constraints You can specify that the value provided for a particular placeholder must satisfy a particular set of restrictions by using a C<=for Euclid> block. For example: =item -size x =for Euclid: h.type: integer w.type: integer specifies that both the C<< >> and C<< >> must be given integers. You can also specify an operator expression after the type name: =for Euclid: h.type: integer > 0 w.type: number <= 100 specifies that C<< >> has to be given an integer that is greater than zero, and that C<< >> has to be given a number (not necessarily an integer) that is no more than 100. These type constraints have two alternative syntaxes: PLACEHOLDER.type: TYPE BINARY_OPERATOR EXPRESSION as shown above, and the more general: PLACEHOLDER.type: TYPE [, EXPRESSION_INVOLVING(PLACEHOLDER)] Using the second syntax, you could write the previous constraints as: =for Euclid: h.type: integer, h > 0 w.type: number, w <= 100 In other words, the first syntax is just sugar for the most common case of the second syntax. The expression can be as complex as you wish and can refer to the placeholder as many times as necessary: =for Euclid: h.type: integer, h > 0 && h < 100 w.type: number, Math::is_prime(w) || w % 2 == 0 Note that the expressions are evaluated in the C namespace, so it is important to qualify any subroutines that are not in that namespace. Furthermore, any subroutines used must be defined (or loaded from a module) I the C statement. You can also use constraints that involve variables. You must use the :defer mode and the variables must be globally accessible: use Getopt::Euclid qw(:defer); our $MIN_VAL = 100; Getopt::Euclid->process_args(\@ARGV); __END__ =head1 OPTIONS =over =item --magnitude =for Euclid magnitude.type: number, magnitude > $MIN_VAL =back =head2 Standard placeholder types Getopt::Euclid recognizes the following standard placeholder types: Name Placeholder value... Synonyms ============ ==================== ================ integer ...must be an integer int i +integer ...must be a positive +int +i integer (same as: integer > 0) 0+integer ...must be a positive 0+int 0+i integer or zero (same as: integer >= 0) number ...must be an number num n +number ...must be a positive +num +n number (same as: number > 0) 0+number ...must be a positive 0+num 0+n number or zero (same as: number >= 0) string ...may be any string str s (default type) readable ...must be the name input in of a readable file writeable ...must be the name writable output out of a writeable file (or of a non-existent file in a writeable directory) // ...must be a string matching the specified pattern Since regular expressions are supported, you can easily match many more type of strings for placeholders by using the regular expressions available in Regexp::Common. If you do that, you may want to also use custom placeholder error messages (see L) since the messages would otherwise not be very informative to users. use Regexp::Common qw /zip/; use Getopt::Euclid; ... =item -p Enter your postcode here =for Euclid: postcode.type: /$RE{zip}{France}/ postcode.type.error: must be a valid ZIP code =head2 Placeholder type errors If a command-line argument's placeholder value does not satisify the specified type, an error message is automatically generated. However, you can provide your own message instead, using the C<.type.error> specifier: =for Euclid: h.type: integer, h > 0 && h < 100 h.type.error: must be between 0 and 100 (not h) w.type: number, Math::is_prime(w) || w % 2 == 0 w.type.error: Cannot use w for (must be an even prime number) Whenever an explicit error message is provided, any occurrence within the message of the placeholder's unbracketed name is replaced by the placeholder's value (just as in the type test itself). =head2 Placeholder defaults You can also specify a default value for any placeholders that are not given values on the command-line (either because their argument is not provided at all, or because the placeholder is optional within the argument). For example: =item -size [x] Set the size of the simulation =for Euclid: h.default: 24 w.default: 80 This ensures that if no C<< >> value is supplied: -size 20 then C<$ARGV{'-size'}{'w'}> is set to 80. Likewise, of the C<-size> argument is omitted entirely, both C<$ARGV{'-size'}{'h'}> and C<$ARGV{'-size'}{'w'}> are set to their respective default values However, Getopt::Euclid also supports a second type of default, optional defaults, that apply only to flagged, optional placeholders. For example: =item --debug [] Set the log level =for Euclid: log_level.type: int log_level.default: 0 log_level.opt_default: 1 This ensures that if the option C<< --debug >> is not specified, then C<$ARGV{'--debug'}> is set to 0, the regular default. But if no C<< >> value is supplied: --debug then C<$ARGV{'--debug'}> is set to 1, the optional default. The default value can be any valid Perl compile-time expression: =item -pi= =for Euclid: pi value.default: atan2(0,-1) You can refer to an argument default or optional default value in its POD entry as shown below: =item -size [x] Set the size of the simulation [default: h.default x w.default] =for Euclid: h.default: 24 w.default: 80 =item --debug Set the debug level. The default is level.default if you supply --debug but omit a value. =for Euclid: level.opt_default: 3 Just like for L, you can also use variables to define default values. You must use the :defer mode and the variables must be globally accessible: use Getopt::Euclid qw(:defer); Getopt::Euclid->process_args(\@ARGV); __END__ =head1 OPTIONS =over =item --home Your project home. When omitted, this defaults to the location stored in the HOME environment variable. =for Euclid home.default: $ENV{'HOME'} =back =head2 Exclusive placeholders Some arguments can be mutually exclusive. In this case, it is possible to specify that a placeholder excludes a list of other placeholders, for example: =item -height Set the desired height =item -width Set the desired width =item -volume Set the desired volume =for Euclid: v.excludes: h, w v.excludes.error: Either set the volume or the height and weight Specifying both placeholders at the same time on the command-line will generate an error. Note that the error message can be customized, as illustrated above. When using exclusive arguments that have default values, the default value of the placeholder with the .excludes statement has precedence over any other placeholders. =head2 Argument cuddling Getopt::Euclid allows any "flag" argument to be "cuddled". A flag argument consists of a single non- alphanumeric character, followed by a single alpha-numeric character: =item -v =item -x =item +1 =item =z Cuddling means that two or more such arguments can be concatenated after a single common non-alphanumeric. For example: -vx Note, however, that only flags with the same leading non-alphanumeric can be cuddled together. Getopt::Euclid would not allow: -vxz This is because cuddling is recognized by progressively removing the second character of the cuddle. In other words: -vxz becomes: -v -xz which becomes: -v -x z which will fail, unless a C argument has also been specified. On the other hand, if the argument: =item -e had been specified, the module I accept: -vxe'print time' as a cuddled version of: -v -x -e'print time' =head2 Exporting option variables By default, the module only stores arguments into the global %ARGV hash. You can request that options are exported as variables into the calling package using the special C<':vars'> specifier: use Getopt::Euclid qw( :vars ); That is, if your program accepts the following arguments: -v --mode --auto-fudge (repeatable) --also ... --size x --multiply x (repeatable) Then these variables will be exported $ARGV_v $ARGV_mode $ARGV_infile $ARGV_outfile @ARGV_auto_fudge @ARGV_also %ARGV_size # With entries $ARGV_size{w} and $ARGV_size{h} @ARGV_multiply # With entries that are hashref similar to \%ARGV_size For options that have multiple variants, only the longest variant is exported. The type of variable exported (scalar, hash, or array) is determined by the type of the corresponding value in C<%ARGV>. Command-line flags and arguments that take single values will produce scalars, arguments that take multiple values will produce hashes, and repeatable arguments will produce arrays. If you do not like the default prefix of "ARGV_", you can specify your own, such as "opt_", like this: use Getopt::Euclid qw( :vars ); The major advantage of using exported variables is that any misspelling of argument variables in your code will be caught at compile-time by C. =head2 Standard arguments Getopt::Euclid automatically provides four standard arguments to any program that uses the module. The behaviours of these arguments are "hard- wired" and cannot be changed, not even by defining your own arguments of the same name. The standard arguments are: =over =item --usage usage() The --usage argument causes the program to print a short usage summary and exit. The Cusage()> subroutine provides access to the string of this message. =item --help help() The --help argument causes the program to take a longer usage summary (with a full list of required and optional arguments) provided in POD format by C, convert it to plaintext, display it and exit. The message is paged using IO::Pager::Page (or IO::Page) if possible. =item --man man() The --man argument causes the program to take the POD documentation for the program, provided by C, convert it to plaintext, display it and exit. The message is paged using IO::Pager::Page (or IO::Page) if possible. =item --podfile podfile() The --podfile argument is provided for authors. It causes the program to take the POD manual from C, write it in a .pod file with the same base name as the program, display the name of the output file and exit. These actions can also be executed by calling the C subroutine.This argument is not really a standard argument, but it is useful if the program's POD is to be passed to a POD converter because, among other things, any default value specified is interpolated and replaced by its value in the .pod file, contrary to in the program's .pl file. If you want to automate the creation of a POD file during the build process, you can edit you Makefile.PL or Build.PL file and add these lines: my @args = ($^X, '-Ilib', '/path/to/script', '--podfile'); system(@args) == 0 or die "System call to '@args' failed:\n$?\n"; If you use L to bundle your script, you might be interested in using L to include the --podfile step into the installation process. =item --version version() The --version argument causes the program to print the version number of the program (as specified in the C<=head1 VERSION> section of the POD) and any copyright information (as specified in the C<=head1 COPYRIGHT> POD section) and then exit. The Cversion()> subroutine provides access to the string of this message. =back =head2 Minimalist keys By default, the keys of C<%ARGV> will match the program's interface exactly. That is, if your program accepts the following arguments: -v --mode --auto-fudge Then the keys that appear in C<%ARGV> will be: '-v' '--mode' '' '' '--auto-fudge' In some cases, however, it may be preferable to have Getopt::Euclid set up those hash keys without "decorations". That is, to have the keys of C<%ARGV> be simply: 'v' 'mode' 'infile' 'outfile' 'auto_fudge' You can arrange this by loading the module with the special C<':minimal_keys'> specifier: use Getopt::Euclid qw( :minimal_keys ); Note that, in rare cases, using this mode may cause you to lose data (for example, if the interface specifies both a C<--step> and a C<< >> option). The module throws an exception if this happens. =head2 Deferring argument parsing In some instances, you may want to avoid the parsing of arguments to take place as soon as your program is executed and Getopt::Euclid is loaded. For example, you may need to examine C<@ARGV> before it is processed (and emptied) by Getopt::Euclid. Or you may intend to pass your own arguments manually only using C. To defer the parsing of arguments, use the specifier C<':defer'>: use Getopt::Euclid qw( :defer ); # Do something... Getopt::Euclid->process_args(\@ARGV); =head1 DIAGNOSTICS =head2 Compile-time diagnostics The following diagnostics are mainly caused by problems in the POD specification of the command-line interface: =over =item Getopt::Euclid was unable to access POD Something is horribly wrong. Getopt::Euclid was unable to read your program to extract the POD from it. Check your program's permissions, though it is a mystery how I was able to run the program in the first place, if it is not readable. =item .pm file cannot define an explicit import() when using Getopt::Euclid You tried to define an C subroutine in a module that was also using Getopt::Euclid. Since the whole point of using Getopt::Euclid in a module is to have it build an C for you, supplying your own C as well defeats the purpose. =item Unknown specification: %s You specified something in a C<=for Euclid> section that Getopt::Euclid did not understand. This is often caused by typos, or by reversing a I.I or I.I specification (that is, writing I.I or I.I instead). =item Unknown type (%s) in specification: %s =item Unknown .type constraint: %s Both these errors mean that you specified a type constraint that Getopt::Euclid did not recognize. This may have been a typo: =for Euclid count.type: inetger or else the module simply does not know about the type you specified: =for Euclid count.type: complex See L for a list of types that Getopt::Euclid I recognize. =item Invalid .type constraint: %s You specified a type constraint that is not valid Perl. For example: =for Euclid max.type: integer not equals 0 instead of: =for Euclid max.type: integer != 0 =item Invalid .default value: %s You specified a default value that is not valid Perl. For example: =for Euclid curse.default: *$@!& instead of: =for Euclid curse.default: '*$@!&' =item Invalid .opt_default value: %s Same as previous diagnostic, but for optional defaults. =item Invalid reference to field %s.default in argument description: %s You referred to a default value in the description of an argument, but there is no such default. It may be a typo, or you may be referring to the default value for a different argument, e.g.: =item -a An optional age. Default: years.default =for Euclid age.default: 21 instead of: =item -a An optional age. Default: age.default =for Euclid age.default: 21 =item Invalid reference to field %s.opt_default in argument description: %s Same as previous diagnostic, but for optional defaults. =item Invalid .opt_default constraint: Placeholder <%s> must be optional You specified an optional default but the placeholder that it affects is not an optional placeholder. For example: =item -l[[en][gth]] =for Euclid: l.opt_default: 123 instead of: =item -l[[en][gth]] [] =for Euclid: l.opt_default: 123 =item Invalid .opt_default constraint: Parameter %s must have a flag You specified an optional default but the parameter that it affects is unflagged. For example: =item =for Euclid: l.opt_default: 123 instead of: =item -l [] =for Euclid: l.opt_default: 123 =item Invalid .excludes value for variable %s: <%s> does not exist You specified to exclude a variable that was not seen in the POD. Make sure that this is not a typo. =item Invalid constraint: %s (No <%s> placeholder in argument: %s) You attempted to define a C<.type> constraint for a placeholder that did not exist. Typically this is the result of the misspelling of a placeholder name: =item -foo =for Euclid: baz.type: integer or a C<=for Euclid:> that has drifted away from its argument: =item -foo =item -verbose =for Euclid: bar.type: integer =item Getopt::Euclid loaded a second time You tried to load the module twice in the same program. Getopt::Euclid does not work that way. Load it only once. =item Unknown mode ('%s') The only argument that a C command accepts is C<':minimal_keys'> (see L). You specified something else instead (or possibly forgot to put a semicolon after C). =item Internal error: minimalist mode caused arguments '%s' and '%s' to clash Minimalist mode removes certain characters from the keys hat are returned in C<%ARGV>. This can mean that two command-line options (such as C<--step> and C<< >>) map to the same key (i.e. C<'step'>). This in turn means that one of the two options has overwritten the other within the C<%ARGV> hash. The program developer should either turn off C<':minimal_keys'> mode within the program, or else change the name of one of the options so that the two no longer clash. =back =head2 Run-time diagnostics The following diagnostics are caused by problems in parsing the command-line =over =item Missing required argument(s): %s At least one argument specified in the C POD section was not present on the command-line. =item Invalid %s argument. %s must be %s but the supplied value (%s) is not. Getopt::Euclid recognized the argument you were trying to specify on the command-line, but the value you gave to one of that argument's placeholders was of the wrong type. =item Unknown argument: %s Getopt::Euclid did not recognize an argument you were trying to specify on the command-line. This is often caused by command-line typos or an incomplete interface specification. =back =head1 CONFIGURATION AND ENVIRONMENT Getopt::Euclid requires no configuration files or environment variables. =head1 DEPENDENCIES =over =item * version =item * Pod::Select =item * Pod::PlainText =item * File::Basename =item * File::Spec::Functions =item * List::Util =item * Text::Balanced =item * IO::Pager::Page (recommended) =back =head1 INCOMPATIBILITIES Getopt::Euclid may not work properly with POD in Perl files that have been converted into an executable with PerlApp or similar software. A possible workaround may be to move the POD to a __DATA__ section or a separate .pod file. =head1 BUGS AND LIMITATIONS Please report any bugs or feature requests via L Pull requests to fix bugs / add features welcome! L C<< git clone git@github.com:bigpresh/Getopt-Euclid.git >> The L still exists but GitHub issues are preferred due to their integration with pull requests etc. =head1 AUTHOR Damian Conway C<< >> Florent Angly C<< >> David Precious (BIGPRESH) C<< >> =head1 LICENCE AND COPYRIGHT Copyright (c) 2005, Damian Conway C<< >>. All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. fail_unknown_spec.t100644001750001750 405214446775743 20332 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tuse Test::More 'no_plan'; BEGIN { require 5.006_001 or plan 'skip_all'; close *STDERR; open *STDERR, '>', \my $stderr; *CORE::GLOBAL::exit = sub { die $stderr }; } BEGIN { $INFILE = $0; $OUTFILE = $0; $LEN = 42; $H = 2; $W = -10; $TIMEOUT = 7; @ARGV = ( '-v', "-out=", $OUTFILE, "size", "${H}x${W}", "-i", $INFILE, "-lgth", $LEN, "--timeout", $TIMEOUT, ); } if (eval { require Getopt::Euclid and Getopt::Euclid->import(); 1 }) { ok 0 => 'Unexpectedly succeeded'; } else { like $@, qr/Getopt::Euclid: Unknown specification: max.headroom/ => 'Failed as expected'; } __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file =for Euclid: file.type: readable file.default: '-' =item -o[ut][file]= Specify output file =for Euclid: file.type: writable file.default: '-' =back =head1 OPTIONS =over =item size x Specify height and width =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: l.type: int > 0 l.default: 24 =item -v[erbose] Print all warnings =item --timeout [] [] =for Euclid: min.type: int max.headroom: int =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) fail_bad_excludes.t100644001750001750 233214446775743 20242 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tuse Test::More 'no_plan'; BEGIN { require 5.006_001 or plan 'skip_all'; close *STDERR; open *STDERR, '>', \my $stderr; *CORE::GLOBAL::exit = sub { die $stderr }; } BEGIN { $INFILE = $0; $L = 42; $G = 2; @ARGV = ( "-i", $INFILE, "-lgth", $L, "-girth", $G, ); chmod 0644, $0; } if (eval { require Getopt::Euclid and Getopt::Euclid->import(); 1 }) { ok 0 => 'Unexpectedly succeeded'; } else { like $@, qr/Getopt::Euclid: Invalid .excludes value for variable : does not exist/ => 'Failed as expected'; } __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file =for Euclid: file.type: readable file.default: '-' =back =head1 OPTIONS =over =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: l.type: int > 0 l.default: 24 =item -girth Display girth [default: 42 ] =for Euclid: g.default: 42 g.excludes: nexistpas =back fail_excludes_msg.t100644001750001750 412714446775743 20306 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tuse Test::More 'no_plan'; BEGIN { require 5.006_001 or plan 'skip_all'; close *STDERR; open *STDERR, '>', \my $stderr; *CORE::GLOBAL::exit = sub { die $stderr }; } BEGIN { $INFILE = $0; $OUTFILE = $0; $LEN = 42; $H = 2; $W = -10; $TIMEOUT = 7; @ARGV = ( '-v', "-out=$OUTFILE", 'size', "${H}x${W}", '-i', $INFILE, '-lgth', $LEN, '--timeout', $TIMEOUT, ); } if (eval { require Getopt::Euclid and Getopt::Euclid->import(); 1 }) { ok 0 => 'Unexpectedly succeeded'; } else { like $@, qr/Why would you do that\?/ => 'Failed as expected'; } __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file =for Euclid: file.type: readable file.default: '-' =item -o[ut][file]= Specify output file =for Euclid: file.type: writable file.default: '-' =back =head1 OPTIONS =over =item size x Specify height and width =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: l.type: int > 0 l.default: 24 l.excludes: h, w l.excludes.error: Why would you do that? =item -v[erbose] Print all warnings =item --timeout [] [] =for Euclid: min.type: int max.type: int =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) fail_unknown_mode.t100644001750001750 104114446775743 20317 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tuse Test::More 'no_plan'; BEGIN { require 5.006_001 or plan 'skip_all'; close *STDERR; open *STDERR, '>', \my $stderr; *CORE::GLOBAL::exit = sub { die $stderr }; } if (eval { require Getopt::Euclid and Getopt::Euclid->import(':foo'); 1 }) { ok 0 => 'Unexpectedly succeeded'; } else { like $@, qr/Unknown mode \(':foo'\)/ => 'Failed as expected'; } if (eval { require Getopt::Euclid and Getopt::Euclid->import(':minimal_keys'); 1 }) { ok 1 => 'Minimal mode accepted'; } else { ok 0 => 'Unexpectedly failed'; } pod_cmd_after_cut.t100644001750001750 53614446775743 20252 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tBEGIN { @ARGV = qw/ -a foo / } use Test::More 'no_plan'; if (eval { require Getopt::Euclid and Getopt::Euclid->import(); 1 }) { ok 1 => 'Optional argument not read as required'; } else { ok 0 => 'Optional argument read as required'; } =head1 REQUIRED =over =item -a =back =cut =head1 OPTIONS =over =item -b =back =cutfail_unknown_type.t100644001750001750 404614446775743 20364 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tuse Test::More 'no_plan'; BEGIN { require 5.006_001 or plan 'skip_all'; close *STDERR; open *STDERR, '>', \my $stderr; *CORE::GLOBAL::exit = sub { die $stderr }; } BEGIN { $INFILE = $0; $OUTFILE = $0; $LEN = 42; $H = 2; $W = -10; $TIMEOUT = 7; @ARGV = ( '-v', "-out=", $OUTFILE, "size", "${H}x${W}", "-i", $INFILE, "-lgth", $LEN, "--timeout", $TIMEOUT, ); } if (eval { require Getopt::Euclid and Getopt::Euclid->import(); 1 }) { ok 0 => 'Unexpectedly succeeded'; } else { like $@, qr/Unknown .type constraint: file.type: \s* bleadable/ => 'Failed as expected'; } __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file =for Euclid: file.type: bleadable file.default: '-' =item -o[ut][file]= Specify output file =for Euclid: file.type: writable file.default: '-' =back =head1 OPTIONS =over =item size x Specify height and width =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: l.type: int > 0 l.default: 24 =item -v[erbose] Print all warnings =item --timeout [] [] =for Euclid: min.type: int max.type: int =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) ignore_decorations.t100644001750001750 677014446775743 20514 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tBEGIN { $INFILE = $0; $OUTFILE = $0; $LEN = 42; $H = 2; $W = -10; $TIMEOUT = 7; @ARGV = ( '-i', $INFILE, "-out=$OUTFILE", '-lgth', $LEN, 'size', "${H}x${W}", '-v', '--timeout', $TIMEOUT, '--with', 's p a c e s', 7, ); chmod 0644, $0; } sub lucky { my ($num) = @_; return $num == 7; } use Getopt::Euclid; use Test::More 'no_plan'; sub got_arg { my ($key, $val) = @_; is $ARGV{$key}, $val, "Got expected value for $key"; } is keys %ARGV, 18 => 'Right number of args returned'; got_arg -i => $INFILE; got_arg -infile => $INFILE; got_arg -l => $LEN; got_arg -len => $LEN; got_arg -length => $LEN; got_arg -lgth => $LEN; got_arg -girth => 42; got_arg -o => $OUTFILE; got_arg -ofile => $OUTFILE; got_arg -out => $OUTFILE; got_arg -outfile => $OUTFILE; got_arg -v => 1, got_arg -verbose => 1, is ref $ARGV{'--timeout'}, 'HASH' => 'Hash reference returned for timeout'; is $ARGV{'--timeout'}{min}, $TIMEOUT => 'Got expected value for timeout '; is $ARGV{'--timeout'}{max}, -1 => 'Got default value for timeout '; is ref $ARGV{size}, 'HASH' => 'Hash reference returned for size'; is $ARGV{size}{h}, $H => 'Got expected value for size '; is $ARGV{size}{w}, $W => 'Got expected value for size '; is $ARGV{'--with'}, 's p a c e s' => 'Handled spaces correctly'; is $ARGV{-w}, 's p a c e s' => 'Handled alternation correctly'; is $ARGV{''}, 7 => 'Handled step size correctly'; __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file =for Euclid: file.type: readable file.default: '-' =item -o[ut][file]= Specify output file =for Euclid: out_file.type: writable out_file.default: '-' =back =head1 OPTIONS =head2 General behaviour You can customize the usage of orchestrate with the following options: =over =item size x Specify height and width =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: l.type: int > 0 l.default: 24 =item -girth Display girth [default: 42 ] =for Euclid: g.default: 42 =back Note however that those flags are optional: since C comes with some sane defaults, you can fire C as is. =head2 Ratings You can also take advantage of ratings if you want =over =item -v[erbose] Print all warnings =item --timeout [] [] =for Euclid: min.type: int max.type: int max.default: -1 =item -w | --with Test something spaced =item Step size =for Euclid: step.type: int, lucky(step) =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) fail_minimal_clash.t100644001750001750 500414446775743 20417 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tuse Test::More 'no_plan'; BEGIN { require 5.006_001 or plan 'skip_all'; close *STDERR; open *STDERR, '>', \my $stderr; *CORE::GLOBAL::exit = sub { die $stderr }; } BEGIN { $INFILE = $0; $OUTFILE = $0; $LEN = 42; $H = 2; $W = -10; $TIMEOUT = 7; @ARGV = ( "-i", $INFILE, "-out=", $OUTFILE, "-lgth", $LEN, "-step", "${H}x${W}", '-v', "--timeout", $TIMEOUT, '-w', 's p a c e s', 7, ); } if (eval { require Getopt::Euclid; Getopt::Euclid->import(qw( :minimal_keys )); 1; } ) { is 0 => 'Succeeded unexpectedly'; } else { my $error = $@; like $error, qr{\AInternal error: minimalist mode caused arguments} => 'Clashed as expected'; like $error, qr{'-step} => 'Clashed on -step'; like $error, qr{''} => 'Clashed on '; } __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file =for Euclid: file.type: readable file.default: '-' =item -o[ut][file]= Specify output file =for Euclid: file.type: writable file.default: '-' =back =head1 OPTIONS =over =item -step x Specify height and width =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: l.type: int > 0 l.default: 24 =item -girth Display girth [default: 42 ] =for Euclid: g.default: 42 =item -v[erbose] Print all warnings =item --timeout [] [] =for Euclid: min.type: int max.type: int max.default: -1 =item -w Test something spaced =item Step size =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) fail_missing_var_2.t100644001750001750 101414446775743 20356 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tuse Test::More 'no_plan'; BEGIN { require 5.006_001 or plan 'skip_all'; close *STDERR; open *STDERR, '>', \my $stderr; *CORE::GLOBAL::exit = sub { die $stderr }; } BEGIN { @ARGV = ( "--foo", "--bar", ); } if (eval { require Getopt::Euclid and Getopt::Euclid->import(); 1 }) { ok 0 => 'Unexpectedly succeeded'; } else { like $@, qr/Unknown argument: --foo --bar/ => 'Failed as expected'; } __END__ =head1 OPTIONS =over =item --foo =item --bar =back =cut fail_bad_excludes_2.t100644001750001750 232114446775743 20461 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tuse Test::More 'no_plan'; BEGIN { require 5.006_001 or plan 'skip_all'; close *STDERR; open *STDERR, '>', \my $stderr; *CORE::GLOBAL::exit = sub { die $stderr }; } BEGIN { $INFILE = $0; $L = 42; $G = 2; @ARGV = ( "-i", $INFILE, "-lgth", $L, "-girth", $G, ); chmod 0644, $0; } if (eval { require Getopt::Euclid and Getopt::Euclid->import(); 1 }) { ok 0 => 'Unexpectedly succeeded'; } else { like $@, qr/Getopt::Euclid: Invalid .excludes value for variable : cannot exclude itself/ => 'Failed as expected'; } __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file =for Euclid: file.type: readable file.default: '-' =back =head1 OPTIONS =over =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: l.type: int > 0 l.default: 24 =item -girth Display girth [default: 42 ] =for Euclid: g.default: 42 g.excludes: g =back fail_bad_constraint.t100644001750001750 400414446775743 20610 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tuse Test::More 'no_plan'; BEGIN { require 5.006_001 or plan 'skip_all'; close *STDERR; open *STDERR, '>', \my $stderr; *CORE::GLOBAL::exit = sub { die $stderr }; } BEGIN { $OUTFILE = $0; $INFILE = 'nexistpas'; $LEN = 42; $H = 2; $W = -10; $TIMEOUT = 7; @ARGV = ( '-v', "-out=$OUTFILE", 'size', "${H}x${W}", '-i', $INFILE, '-lgth', $LEN, '--timeout', $TIMEOUT, ); } if (eval { require Getopt::Euclid and Getopt::Euclid->import(); 1 }) { ok 0 => 'Unexpectedly succeeded'; } else { like $@, qr/must be readable/ => 'Failed as expected'; } __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file =for Euclid: file.type: readable file.default: '-' =item -o[ut][file]= Specify output file =for Euclid: file.type: writable file.default: '-' =back =head1 OPTIONS =over =item size x Specify height and width =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: l.type: int > 0 l.default: 24 =item -v[erbose] Print all warnings =item --timeout [] [] =for Euclid: min.type: int max.type: int =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) fail_misplaced_type.t100644001750001750 413114446775743 20621 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tuse Test::More 'no_plan'; BEGIN { require 5.006_001 or plan 'skip_all'; close *STDERR; open *STDERR, '>', \my $stderr; *CORE::GLOBAL::exit = sub { die $stderr }; } BEGIN { $OUTFILE = $0; $INFILE = 'nexistpas'; $LEN = 42; $H = 2; $W = -10; $TIMEOUT = 7; @ARGV = ( '-v', "-out=", $OUTFILE, "size", "${H}x${W}", "-i", $INFILE, "-lgth", $LEN, "--timeout", $TIMEOUT, ); } if (eval { require Getopt::Euclid and Getopt::Euclid->import(); 1 }) { ok 0 => 'Unexpectedly succeeded'; } else { like $@, qr/Invalid constraint: min.type: int\n\(No placeholder in argument: --foo / => 'Failed as expected'; } __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file =for Euclid: file.type: readable file.default: '-' =item -o[ut][file]= Specify output file =for Euclid: file.type: writable file.default: '-' =back =head1 OPTIONS =over =item size x Specify height and width =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: l.type: int > 0 l.default: 24 =item -v[erbose] Print all warnings =item --timeout [] [] =item --foo =for Euclid: min.type: int max.type: int =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) fail_unknown_spec_2.t100644001750001750 405014446775743 20551 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tuse Test::More 'no_plan'; BEGIN { require 5.006_001 or plan 'skip_all'; close *STDERR; open *STDERR, '>', \my $stderr; *CORE::GLOBAL::exit = sub { die $stderr }; } BEGIN { $INFILE = $0; $OUTFILE = $0; $LEN = 42; $H = 2; $W = -10; $TIMEOUT = 7; @ARGV = ( '-v', "-out=", $OUTFILE, "size", "${H}x${W}", "-i", $INFILE, "-lgth", $LEN, "--timeout", $TIMEOUT, ); } if (eval { require Getopt::Euclid and Getopt::Euclid->import(); 1 }) { ok 0 => 'Unexpectedly succeeded'; } else { like $@, qr/Getopt::Euclid: Unknown specification: maxheadroom/ => 'Failed as expected'; } __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file =for Euclid: file.type: readable file.default: '-' =item -o[ut][file]= Specify output file =for Euclid: file.type: writable file.default: '-' =back =head1 OPTIONS =over =item size x Specify height and width =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: l.type: int > 0 l.default: 24 =item -v[erbose] Print all warnings =item --timeout [] [] =for Euclid: min.type: int maxheadroom: int =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) fail_user_constraint.t100644001750001750 377614446775743 21057 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tuse Test::More 'no_plan'; BEGIN { require 5.006_001 or plan 'skip_all'; close *STDERR; open *STDERR, '>', \my $stderr; *CORE::GLOBAL::exit = sub { die $stderr }; } BEGIN { $INFILE = $0; $OUTFILE = $0; $LEN = -42; $H = 2; $W = -10; $TIMEOUT = 7; @ARGV = ( '-v', "-out=$OUTFILE", 'size', "${H}x${W}", '-i', $INFILE, '-lgth', $LEN, '--timeout', $TIMEOUT, ); } if (eval { require Getopt::Euclid and Getopt::Euclid->import(); 1 }) { ok 0 => 'Unexpectedly succeeded'; } else { like $@, qr/ must be > 0 but/ => 'Failed as expected'; } __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file =for Euclid: file.type: readable file.default: '-' =item -o[ut][file]= Specify output file =for Euclid: file.type: writable file.default: '-' =back =head1 OPTIONS =over =item size x Specify height and width =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: l.type: int > 0 l.default: 24 =item -v[erbose] Print all warnings =item --timeout [] [] =for Euclid: min.type: int max.type: int =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) fail_bad_default_ref.t100644001750001750 412714446775743 20712 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tuse Test::More 'no_plan'; BEGIN { require 5.006_001 or plan 'skip_all'; close *STDERR; open *STDERR, '>', \my $stderr; *CORE::GLOBAL::exit = sub { die $stderr }; } BEGIN { $INFILE = $0; $OUTFILE = $0; $LEN = 42; $H = 2; $W = -10; $TIMEOUT = 7; @ARGV = ( '-v', "-out=", $OUTFILE, "size", "${H}x${W}", "-i", $INFILE, "-lgth", $LEN, "--timeout", $TIMEOUT, ); } if (eval { require Getopt::Euclid and Getopt::Euclid->import(); 1 }) { ok 0 => 'Unexpectedly succeeded'; } else { like $@, qr/Getopt::Euclid: Invalid reference to field XXX.default in argument description:/ => 'Failed as expected'; } __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file. Default: XXX.default =for Euclid: file.type: readable file.default: '-' =item -o[ut][file]= Specify output file =for Euclid: file.type: writable file.default: '-' =back =head1 OPTIONS =over =item size x Specify height and width =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: l.type: int > 0 l.default: 24 =item -v[erbose] Print all warnings =item --timeout [] [] =for Euclid: min.type: int max.type: int =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) fail_bad_opt_default.t100644001750001750 460214446775743 20736 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tuse Test::More 'no_plan'; BEGIN { require 5.006_001 or plan 'skip_all'; close *STDERR; open *STDERR, '>', \my $stderr; *CORE::GLOBAL::exit = sub { die $stderr }; } BEGIN { $INFILE = $0; $OUTFILE = $0; $H = 2; $W = -10; $TIMEOUT = 7; @ARGV = ( "-i", $INFILE, "-out=", $OUTFILE, "-lgth", "size", "${H}x${W}", '-v', "--timeout", $TIMEOUT, '--with', 's p a c e s', 7, ); chmod 0644, $0; } if (eval { require Getopt::Euclid and Getopt::Euclid->import(); 1 }) { ok 0 => 'Unexpectedly succeeded'; } else { like $@, qr/Getopt::Euclid: Invalid .opt_default constraint/ => 'Failed as expected'; like $@, qr/Placeholder .* must be optional/ => 'With expected message'; } __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file =for Euclid: file.type: readable file.default: '-' =item -o[ut][file]= Specify output file =for Euclid: out_file.type: writable out_file.default: '-' =back =head1 OPTIONS =over =item size x Specify height and width =item -l[[en][gth]] Display length [opt_default: 123] =for Euclid: l.type: int > 0 l.opt_default: 123 =item -girth Display girth [default: 42 ] =for Euclid: g.default: 42 =item -v[erbose] Print all warnings =item --timeout [] [] =for Euclid: min.type: int max.type: int max.default: -1 max.opt_default: -3 =item -w | --with Test something spaced =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) fail_missing_required.t100644001750001750 420014446775743 21165 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tuse Test::More 'no_plan'; BEGIN { require 5.006_001 or plan 'skip_all'; close *STDERR; open *STDERR, '>', \my $stderr; *CORE::GLOBAL::exit = sub { die $stderr }; } BEGIN { $INFILE = $0; $LEN = 42; $H = 2; $W = -10; $TIMEOUT = 7; @ARGV = ( '-v', 'size', "${H}x${W}", '-i', $INFILE, '-lgth', $LEN, '--timeout', $TIMEOUT, ); } if (eval { require Getopt::Euclid and Getopt::Euclid->import(); 1 }) { ok 0 => 'Unexpectedly succeeded'; } else { like $@, qr/Missing required argument:/ => 'Failed as expected'; like $@, qr/-o/ => 'With expected message'; } __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 Notice that there are mandatory and optional arguments, described in the two next subsections. =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file =for Euclid: file.type: readable file.default: '-' =item -o[ut][file]= Specify output file =for Euclid: file.type: writable file.default: '-' =back =head1 OPTIONS =over =item size x Specify height and width =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: l.type: int > 0 l.default: 24 =item -v[erbose] Print all warnings =item --timeout [] [] =for Euclid: min.type: int max.type: int =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) fail_bad_opt_default_2.t100644001750001750 466514446775743 21170 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tuse Test::More 'no_plan'; BEGIN { require 5.006_001 or plan 'skip_all'; close *STDERR; open *STDERR, '>', \my $stderr; *CORE::GLOBAL::exit = sub { die $stderr }; } BEGIN { $INFILE = $0; $OUTFILE = $0; $LEN = 42; $H = 2; $W = -10; $TIMEOUT = 7; @ARGV = ( '-i', $INFILE, "-out=$OUTFILE", '-lgth', $LEN, 'size', "${H}x${W}", '-v', '--timeout', $TIMEOUT, '--with', 's p a c e s', 7, ); chmod 0644, $0; } if (eval { require Getopt::Euclid and Getopt::Euclid->import(); 1 }) { ok 0 => 'Unexpectedly succeeded'; } else { like $@, qr/Getopt::Euclid: Invalid .opt_default constraint/ => 'Failed as expected'; like $@, qr/Parameter .* must have a flag/ => 'With expected message'; } __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file =for Euclid: file.type: readable file.default: '-' =item -o[ut][file]= Specify output file =for Euclid: out_file.type: writable out_file.default: '-' =back =head1 OPTIONS =over =item size x Specify height and width =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: l.type: int > 0 l.default: 24 =item -girth Display girth [default: 42 ] =for Euclid: g.default: 42 =item -v[erbose] Print all warnings =item --timeout [] [] =for Euclid: min.type: int max.type: int max.default: -1 =item -w | --with Test something spaced =item Step size =for Euclid: step.type: int step.opt_default: 123 =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) fail_user_constraint_type.t100644001750001750 377514446775743 22117 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tuse Test::More 'no_plan'; BEGIN { require 5.006_001 or plan 'skip_all'; close *STDERR; open *STDERR, '>', \my $stderr; *CORE::GLOBAL::exit = sub { die $stderr }; } BEGIN { $INFILE = $0; $OUTFILE = $0; $LEN = -42; $H = 2; $W = -10; $TIMEOUT = 7; @ARGV = ( '-v', "-out=$OUTFILE", 'size', "${H}x${W}", '-i', $INFILE, '-lgth', $LEN, '--timeout', $TIMEOUT, ); } if (eval { require Getopt::Euclid and Getopt::Euclid->import(); 1 }) { ok 0 => 'Unexpectedly succeeded'; } else { like $@, qr/ must be \+int but/ => 'Failed as expected'; } __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file =for Euclid: file.type: readable file.default: '-' =item -o[ut][file]= Specify output file =for Euclid: file.type: writable file.default: '-' =back =head1 OPTIONS =over =item size x Specify height and width =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: l.type: +int l.default: 24 =item -v[erbose] Print all warnings =item --timeout [] [] =for Euclid: min.type: int max.type: int =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) fail_user_constraint_comma.t100644001750001750 400114446775743 22211 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/tuse Test::More 'no_plan'; BEGIN { require 5.006_001 or plan 'skip_all'; close *STDERR; open *STDERR, '>', \my $stderr; *CORE::GLOBAL::exit = sub { die $stderr }; } BEGIN { $INFILE = $0; $OUTFILE = $0; $LEN = -42; $H = 2; $W = -10; $TIMEOUT = 7; @ARGV = ( '-v', "-out=$OUTFILE", 'size', "${H}x${W}", '-i', $INFILE, '-lgth', $LEN, '--timeout', $TIMEOUT, ); } if (eval { require Getopt::Euclid and Getopt::Euclid->import(); 1 }) { ok 0 => 'Unexpectedly succeeded'; } else { like $@, qr/ must be > 0 but/ => 'Failed as expected'; } __END__ =head1 NAME orchestrate - Convert a file to Melkor's .orc format =head1 VERSION This documentation refers to orchestrate version 1.9.4 =head1 USAGE orchestrate -in source.txt --out dest.orc -verbose -len=24 =head1 REQUIRED ARGUMENTS =over =item -i[nfile] [=] Specify input file =for Euclid: file.type: readable file.default: '-' =item -o[ut][file]= Specify output file =for Euclid: file.type: writable file.default: '-' =back =head1 OPTIONS =over =item size x Specify height and width =item -l[[en][gth]] Display length [default: 24 ] =for Euclid: l.type: int, l > 0 l.default: 24 =item -v[erbose] Print all warnings =item --timeout [] [] =for Euclid: min.type: int max.type: int =item --version =item --usage =item --help =item --man Print the usual program information =back =begin remainder of documentation here... =end =head1 AUTHOR Damian Conway (damian@conway.org) =head1 BUGS There are undoubtedly serious bugs lurking somewhere in this code. Bug reports and other feedback are most welcome. =head1 COPYRIGHT Copyright (c) 2002, Damian Conway. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License (see http://www.perl.com/perl/misc/Artistic.html) Getopt000755001750001750 014446775743 20512 5ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/Getopt-Euclid/libEuclid.pm100644001750001750 6614446775743 22357 0ustar00davidpdavidp000000000000Getopt-Euclid-0.4.6/Getopt-Euclid/lib/Getoptuse strict; use warnings; package Getopt::Euclid; 1;