Getopt-Euclid-0.4.4/0000755000175000017500000000000012205064475014411 5ustar flofloooflofloooGetopt-Euclid-0.4.4/Build.PL0000644000175000017500000000224512205010710015667 0ustar floflooofloflooouse strict; use warnings; use Module::Build; # If you updated this file, don't forget to update the Makefile.PL file as well! my $builder = Module::Build->new( module_name => 'Getopt::Euclid', dist_author => 'Damian Conway ', license => 'perl', dist_version_from => 'lib/Getopt/Euclid.pm', build_requires => { 'Test::More' => 0, 'Pod::Checker' => 0, }, requires => { 'version' => 0, 'Pod::Select' => 0, 'Pod::PlainText' => 0, 'File::Basename' => 0, 'File::Spec::Functions' => 0, 'List::Util' => 0, 'Text::Balanced' => 0, }, recommends => { 'IO::Pager::Page' => 0, }, add_to_cleanup => [ 'Getopt-Euclid-*' ], ); $builder->create_build_script(); if ( -e 'MANIFEST.SKIP' ) { generate_readme( 'lib/Getopt/Euclid.pm', 'README' ); } sub generate_readme { my ($in, $out) = @_; `pod2text $in $out`; warn "Warning: Could not generate $out.\n$!\n" if $? == -1; return $?; # exit status } Getopt-Euclid-0.4.4/META.json0000644000175000017500000000251012173161236016025 0ustar floflooofloflooo{ "abstract" : "Executable Uniform Command-Line Interface Descriptions", "author" : [ "Damian Conway " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4003, CPAN::Meta::Converter version 2.120921", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Getopt-Euclid", "prereqs" : { "build" : { "requires" : { "Pod::Checker" : "0", "Test::More" : "0" } }, "configure" : { "requires" : { "Module::Build" : "0.40" } }, "runtime" : { "recommends" : { "IO::Pager::Page" : "0" }, "requires" : { "File::Basename" : "0", "File::Spec::Functions" : "0", "List::Util" : "0", "Pod::PlainText" : "0", "Pod::Select" : "0", "Text::Balanced" : "0", "version" : "0" } } }, "provides" : { "Getopt::Euclid" : { "file" : "lib/Getopt/Euclid.pm", "version" : "v0.4.3" } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ] }, "version" : "v0.4.3" } Getopt-Euclid-0.4.4/lib/0000755000175000017500000000000012205064475015157 5ustar flofloooflofloooGetopt-Euclid-0.4.4/lib/Getopt/0000755000175000017500000000000012205064475016421 5ustar flofloooflofloooGetopt-Euclid-0.4.4/lib/Getopt/Euclid.pm0000644000175000017500000024446212205064054020171 0ustar floflooofloflooopackage Getopt::Euclid; use version; our $VERSION = version->declare('0.4.4'); 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 __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} ) { # Named vars... if ( ref $entry eq 'HASH' && defined $entry->{$var} ) { 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; } # Unnamed vars... elsif ( ref $entry ne 'HASH' && defined $entry ) { 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}))+" : "(?:($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.4 =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 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 to C, or through the web interface at L. Getopt::Euclid has a development repository on Sourceforge.net at L in which the code is managed by Git. Feel free to clone this repository and push patches! To get started: git clone L) git branch 0.2.x origin/0.2.x git checkout 0.2.x =head1 AUTHOR Damian Conway C<< >> Florent Angly 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. Getopt-Euclid-0.4.4/Changes0000644000175000017500000002123112205064121015667 0ustar flofloooflofloooRevision history for Getopt-Euclid 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. Getopt-Euclid-0.4.4/README0000644000175000017500000012505612205064376015302 0ustar flofloooflofloooNAME Getopt::Euclid - Executable Uniform Command-Line Interface Descriptions VERSION This document describes Getopt::Euclid version 0.4.4 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 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 to "bug-getopt-euclid@rt.cpan.org", or through the web interface at . Getopt::Euclid has a development repository on Sourceforge.net at in which the code is managed by Git. Feel free to clone this repository and push patches! To get started: git clone ) git branch 0.2.x origin/0.2.x git checkout 0.2.x AUTHOR Damian Conway "" Florent Angly "" 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. Getopt-Euclid-0.4.4/MANIFEST0000644000175000017500000000307612205064446015546 0ustar flofloooflofloooBuild.PL Changes inc/Module/Install.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/Fetch.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm lib/Getopt/Euclid.pm Makefile.PL MANIFEST This list of files META.json META.yml README 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_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 Getopt-Euclid-0.4.4/META.yml0000644000175000017500000000136712173161236015666 0ustar floflooofloflooo--- abstract: 'Executable Uniform Command-Line Interface Descriptions' author: - 'Damian Conway ' build_requires: Pod::Checker: 0 Test::More: 0 configure_requires: Module::Build: 0.40 dynamic_config: 1 generated_by: 'Module::Build version 0.4003, CPAN::Meta::Converter version 2.120921' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Getopt-Euclid provides: Getopt::Euclid: file: lib/Getopt/Euclid.pm version: v0.4.3 recommends: IO::Pager::Page: 0 requires: File::Basename: 0 File::Spec::Functions: 0 List::Util: 0 Pod::PlainText: 0 Pod::Select: 0 Text::Balanced: 0 version: 0 resources: license: http://dev.perl.org/licenses/ version: v0.4.3 Getopt-Euclid-0.4.4/inc/0000755000175000017500000000000012205064475015162 5ustar flofloooflofloooGetopt-Euclid-0.4.4/inc/Module/0000755000175000017500000000000012205064475016407 5ustar flofloooflofloooGetopt-Euclid-0.4.4/inc/Module/Install.pm0000644000175000017500000003013512205064375020354 0ustar floflooofloflooo#line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } use 5.005; use strict 'vars'; use Cwd (); use File::Find (); use File::Path (); use vars qw{$VERSION $MAIN}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '1.06'; # Storage for the pseudo-singleton $MAIN = undef; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; #------------------------------------------------------------- # all of the following checks should be included in import(), # to allow "eval 'require Module::Install; 1' to test # installation of Module::Install. (RT #51267) #------------------------------------------------------------- # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE" } Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE # This reportedly fixes a rare Win32 UTC file time issue, but # as this is a non-cross-platform XS module not in the core, # we shouldn't really depend on it. See RT #24194 for detail. # (Also, this module only supports Perl 5.6 and above). eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006; # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 ) { my $s = (stat($0))[9]; # If the modification time is only slightly in the future, # sleep briefly to remove the problem. my $a = $s - time; if ( $a > 0 and $a < 5 ) { sleep 5 } # Too far in the future, throw an error. my $t = time; if ( $s > $t ) { die <<"END_DIE" } Your installer $0 has a modification time in the future ($s > $t). This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE } # Build.PL was formerly supported, but no longer is due to excessive # difficulty in implementing every single feature twice. if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" } Module::Install no longer supports Build.PL. It was impossible to maintain duel backends, and has been deprecated. Please remove all Build.PL files and only use the Makefile.PL installer. END_DIE #------------------------------------------------------------- # To save some more typing in Module::Install installers, every... # use inc::Module::Install # ...also acts as an implicit use strict. $^H |= strict::bits(qw(refs subs vars)); #------------------------------------------------------------- unless ( -f $self->{file} ) { foreach my $key (keys %INC) { delete $INC{$key} if $key =~ /Module\/Install/; } local $^W; require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } local $^W; *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{'inc/Module/Install.pm'}; delete $INC{'Module/Install.pm'}; # Save to the singleton $MAIN = $self; return 1; } sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::cwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { # Delegate back to parent dirs goto &$code unless $cwd eq $pwd; } unless ($$sym =~ s/([^:]+)$//) { # XXX: it looks like we can't retrieve the missing function # via $$sym (usually $main::AUTOLOAD) in this case. # I'm still wondering if we should slurp Makefile.PL to # get some context or not ... my ($package, $file, $line) = caller; die <<"EOT"; Unknown function is found at $file line $line. Execution of $file aborted due to runtime errors. If you're a contributor to a project, you may need to install some Module::Install extensions from CPAN (or other repository). If you're a user of a module, please contact the author. EOT } my $method = $1; if ( uc($method) eq $method ) { # Do nothing return; } elsif ( $method =~ /^_/ and $self->can($method) ) { # Dispatch to the root M:I class return $self->$method(@_); } # Dispatch to the appropriate plugin unshift @_, ( $self, $1 ); goto &{$self->can('call')}; }; } sub preload { my $self = shift; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { @exts = $self->{admin}->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { local $^W; *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; delete $INC{'FindBin.pm'}; { # to suppress the redefine warning local $SIG{__WARN__} = sub {}; require FindBin; } # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; $args{wrote} = 0; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; my $should_reload = 0; unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; $should_reload = 1; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { local $^W; require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = $should_reload ? delete $INC{$file} : $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { my $content = Module::Install::_read($subpath . '.pm'); my $in_pod = 0; foreach ( split //, $content ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } ##################################################################### # Common Utility Functions sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _read { local *FH; open( FH, '<', $_[0] ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_NEW sub _read { local *FH; open( FH, "< $_[0]" ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_OLD sub _readperl { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s; $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg; return $string; } sub _readpod { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; return $string if $_[0] =~ /\.pod\z/; $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg; $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg; $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg; $string =~ s/^\n+//s; return $string; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _write { local *FH; open( FH, '>', $_[0] ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_NEW sub _write { local *FH; open( FH, "> $_[0]" ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_OLD # _version is for processing module versions (eg, 1.03_05) not # Perl versions (eg, 5.8.1). sub _version ($) { my $s = shift || 0; my $d =()= $s =~ /(\.)/g; if ( $d >= 2 ) { # Normalise multipart versions $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg; } $s =~ s/^(\d+)\.?//; my $l = $1 || 0; my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g; $l = $l . '.' . join '', @v if @v; return $l + 0; } sub _cmp ($$) { _version($_[1]) <=> _version($_[2]); } # Cloned from Params::Util::_CLASS sub _CLASS ($) { ( defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s ) ? $_[0] : undef; } 1; # Copyright 2008 - 2012 Adam Kennedy. Getopt-Euclid-0.4.4/inc/Module/Install/0000755000175000017500000000000012205064475020015 5ustar flofloooflofloooGetopt-Euclid-0.4.4/inc/Module/Install/Makefile.pm0000644000175000017500000002743712205064375022104 0ustar floflooofloflooo#line 1 package Module::Install::Makefile; use strict 'vars'; use ExtUtils::MakeMaker (); use Module::Install::Base (); use Fcntl qw/:flock :seek/; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing or non-interactive session, always use defaults if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } # Store a cleaned up version of the MakeMaker version, # since we need to behave differently in a variety of # ways based on the MM version. my $makemaker = eval $ExtUtils::MakeMaker::VERSION; # If we are passed a param, do a "newer than" comparison. # Otherwise, just return the MakeMaker version. sub makemaker { ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0 } # Ripped from ExtUtils::MakeMaker 6.56, and slightly modified # as we only need to know here whether the attribute is an array # or a hash or something else (which may or may not be appendable). my %makemaker_argtype = ( C => 'ARRAY', CONFIG => 'ARRAY', # CONFIGURE => 'CODE', # ignore DIR => 'ARRAY', DL_FUNCS => 'HASH', DL_VARS => 'ARRAY', EXCLUDE_EXT => 'ARRAY', EXE_FILES => 'ARRAY', FUNCLIST => 'ARRAY', H => 'ARRAY', IMPORTS => 'HASH', INCLUDE_EXT => 'ARRAY', LIBS => 'ARRAY', # ignore '' MAN1PODS => 'HASH', MAN3PODS => 'HASH', META_ADD => 'HASH', META_MERGE => 'HASH', PL_FILES => 'HASH', PM => 'HASH', PMLIBDIRS => 'ARRAY', PMLIBPARENTDIRS => 'ARRAY', PREREQ_PM => 'HASH', CONFIGURE_REQUIRES => 'HASH', SKIP => 'ARRAY', TYPEMAPS => 'ARRAY', XS => 'HASH', # VERSION => ['version',''], # ignore # _KEEP_AFTER_FLUSH => '', clean => 'HASH', depend => 'HASH', dist => 'HASH', dynamic_lib=> 'HASH', linkext => 'HASH', macro => 'HASH', postamble => 'HASH', realclean => 'HASH', test => 'HASH', tool_autosplit => 'HASH', # special cases where you can use makemaker_append CCFLAGS => 'APPENDABLE', DEFINE => 'APPENDABLE', INC => 'APPENDABLE', LDDLFLAGS => 'APPENDABLE', LDFROM => 'APPENDABLE', ); sub makemaker_args { my ($self, %new_args) = @_; my $args = ( $self->{makemaker_args} ||= {} ); foreach my $key (keys %new_args) { if ($makemaker_argtype{$key}) { if ($makemaker_argtype{$key} eq 'ARRAY') { $args->{$key} = [] unless defined $args->{$key}; unless (ref $args->{$key} eq 'ARRAY') { $args->{$key} = [$args->{$key}] } push @{$args->{$key}}, ref $new_args{$key} eq 'ARRAY' ? @{$new_args{$key}} : $new_args{$key}; } elsif ($makemaker_argtype{$key} eq 'HASH') { $args->{$key} = {} unless defined $args->{$key}; foreach my $skey (keys %{ $new_args{$key} }) { $args->{$key}{$skey} = $new_args{$key}{$skey}; } } elsif ($makemaker_argtype{$key} eq 'APPENDABLE') { $self->makemaker_append($key => $new_args{$key}); } } else { if (defined $args->{$key}) { warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n}; } $args->{$key} = $new_args{$key}; } } return $args; } # For mm args that take multiple space-seperated args, # append an argument to the current list. sub makemaker_append { my $self = shift; my $name = shift; my $args = $self->makemaker_args; $args->{$name} = defined $args->{$name} ? join( ' ', $args->{$name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } sub _wanted_t { } sub tests_recursive { my $self = shift; my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } my %tests = map { $_ => 1 } split / /, ($self->tests || ''); require File::Find; File::Find::find( sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 }, $dir ); $self->tests( join ' ', sort keys %tests ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; # Check the current Perl version my $perl_version = $self->perl_version; if ( $perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } # Make sure we have a new enough MakeMaker require ExtUtils::MakeMaker; if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) { # This previous attempted to inherit the version of # ExtUtils::MakeMaker in use by the module author, but this # was found to be untenable as some authors build releases # using future dev versions of EU:MM that nobody else has. # Instead, #toolchain suggests we use 6.59 which is the most # stable version on CPAN at time of writing and is, to quote # ribasushi, "not terminally fucked, > and tested enough". # TODO: We will now need to maintain this over time to push # the version up as new versions are released. $self->build_requires( 'ExtUtils::MakeMaker' => 6.59 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 ); } else { # Allow legacy-compatibility with 5.005 by depending on the # most recent EU:MM that supported 5.005. $self->build_requires( 'ExtUtils::MakeMaker' => 6.36 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 ); } # Generate the MakeMaker params my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name; $args->{NAME} =~ s/-/::/g; $args->{VERSION} = $self->version or die <<'EOT'; ERROR: Can't determine distribution version. Please specify it explicitly via 'version' in Makefile.PL, or set a valid $VERSION in a module, and provide its file path via 'version_from' (or 'all_from' if you prefer) in Makefile.PL. EOT if ( $self->tests ) { my @tests = split ' ', $self->tests; my %seen; $args->{test} = { TESTS => (join ' ', grep {!$seen{$_}++} @tests), }; } elsif ( $Module::Install::ExtraTests::use_extratests ) { # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness. # So, just ignore our xt tests here. } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) { $args->{test} = { TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ), }; } if ( $] >= 5.005 ) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = join ', ', @{$self->author || []}; } if ( $self->makemaker(6.10) ) { $args->{NO_META} = 1; #$args->{NO_MYMETA} = 1; } if ( $self->makemaker(6.17) and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } if ( $self->makemaker(6.31) and $self->license ) { $args->{LICENSE} = $self->license; } my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->requires) ); # Remove any reference to perl, PREREQ_PM doesn't support it delete $args->{PREREQ_PM}->{perl}; # Merge both kinds of requires into BUILD_REQUIRES my $build_prereq = ($args->{BUILD_REQUIRES} ||= {}); %$build_prereq = ( %$build_prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->configure_requires, $self->build_requires) ); # Remove any reference to perl, BUILD_REQUIRES doesn't support it delete $args->{BUILD_REQUIRES}->{perl}; # Delete bundled dists from prereq_pm, add it to Makefile DIR my $subdirs = ($args->{DIR} || []); if ($self->bundles) { my %processed; foreach my $bundle (@{ $self->bundles }) { my ($mod_name, $dist_dir) = @$bundle; delete $prereq->{$mod_name}; $dist_dir = File::Basename::basename($dist_dir); # dir for building this module if (not exists $processed{$dist_dir}) { if (-d $dist_dir) { # List as sub-directory to be processed by make push @$subdirs, $dist_dir; } # Else do nothing: the module is already present on the system $processed{$dist_dir} = undef; } } } unless ( $self->makemaker('6.55_03') ) { %$prereq = (%$prereq,%$build_prereq); delete $args->{BUILD_REQUIRES}; } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; if ( $self->makemaker(6.48) ) { $args->{MIN_PERL_VERSION} = $perl_version; } } if ($self->installdirs) { warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS}; $args->{INSTALLDIRS} = $self->installdirs; } my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_} ) } keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if ( my $preop = $self->admin->preop($user_preop) ) { foreach my $key ( keys %$preop ) { $args{dist}->{$key} = $preop->{$key}; } } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; eval { flock MAKEFILE, LOCK_EX }; my $makefile = do { local $/; }; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; seek MAKEFILE, 0, SEEK_SET; truncate MAKEFILE, 0; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 544 Getopt-Euclid-0.4.4/inc/Module/Install/Can.pm0000644000175000017500000000615712205064375021064 0ustar floflooofloflooo#line 1 package Module::Install::Can; use strict; use Config (); use ExtUtils::MakeMaker (); use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # Check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { next if $dir eq ''; require File::Spec; my $abs = File::Spec->catfile($dir, $cmd); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # Can our C compiler environment build XS files sub can_xs { my $self = shift; # Ensure we have the CBuilder module $self->configure_requires( 'ExtUtils::CBuilder' => 0.27 ); # Do we have the configure_requires checker? local $@; eval "require ExtUtils::CBuilder;"; if ( $@ ) { # They don't obey configure_requires, so it is # someone old and delicate. Try to avoid hurting # them by falling back to an older simpler test. return $self->can_cc(); } # Do we have a working C compiler my $builder = ExtUtils::CBuilder->new( quiet => 1, ); unless ( $builder->have_compiler ) { # No working C compiler return 0; } # Write a C file representative of what XS becomes require File::Temp; my ( $FH, $tmpfile ) = File::Temp::tempfile( "compilexs-XXXXX", SUFFIX => '.c', ); binmode $FH; print $FH <<'END_C'; #include "EXTERN.h" #include "perl.h" #include "XSUB.h" int main(int argc, char **argv) { return 0; } int boot_sanexs() { return 1; } END_C close $FH; # Can the C compiler access the same headers XS does my @libs = (); my $object = undef; eval { local $^W = 0; $object = $builder->compile( source => $tmpfile, ); @libs = $builder->link( objects => $object, module_name => 'sanexs', ); }; my $result = $@ ? 0 : 1; # Clean up all the build files foreach ( $tmpfile, $object, @libs ) { next unless defined $_; 1 while unlink; } return $result; } # Can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 236 Getopt-Euclid-0.4.4/inc/Module/Install/WriteAll.pm0000644000175000017500000000237612205064375022105 0ustar floflooofloflooo#line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_, ); $self->sign(1) if $args{sign}; $self->admin->WriteAll(%args) if $self->is_admin; $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{PL_FILES} ) { # XXX: This still may be a bit over-defensive... unless ($self->makemaker(6.25)) { $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL'; } } # Until ExtUtils::MakeMaker support MYMETA.yml, make sure # we clean it up properly ourself. $self->realclean_files('MYMETA.yml'); if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } # The Makefile write process adds a couple of dependencies, # so write the META.yml files after the Makefile. if ( $args{meta} ) { $self->Meta->write; } # Experimental support for MYMETA if ( $ENV{X_MYMETA} ) { if ( $ENV{X_MYMETA} eq 'JSON' ) { $self->Meta->write_mymeta_json; } else { $self->Meta->write_mymeta_yaml; } } return 1; } 1; Getopt-Euclid-0.4.4/inc/Module/Install/Metadata.pm0000644000175000017500000004327712205064375022107 0ustar floflooofloflooo#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } my @boolean_keys = qw{ sign }; my @scalar_keys = qw{ name module_name abstract version distribution_type tests installdirs }; my @tuple_keys = qw{ configure_requires build_requires requires recommends bundles resources }; my @resource_keys = qw{ homepage bugtracker repository }; my @array_keys = qw{ keywords author }; *authors = \&author; sub Meta { shift } sub Meta_BooleanKeys { @boolean_keys } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } sub Meta_ResourceKeys { @resource_keys } sub Meta_ArrayKeys { @array_keys } foreach my $key ( @boolean_keys ) { *$key = sub { my $self = shift; if ( defined wantarray and not @_ ) { return $self->{values}->{$key}; } $self->{values}->{$key} = ( @_ ? $_[0] : 1 ); return $self; }; } foreach my $key ( @scalar_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} = shift; return $self; }; } foreach my $key ( @array_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} ||= []; push @{$self->{values}->{$key}}, @_; return $self; }; } foreach my $key ( @resource_keys ) { *$key = sub { my $self = shift; unless ( @_ ) { return () unless $self->{values}->{resources}; return map { $_->[1] } grep { $_->[0] eq $key } @{ $self->{values}->{resources} }; } return $self->{values}->{resources}->{$key} unless @_; my $uri = shift or die( "Did not provide a value to $key()" ); $self->resources( $key => $uri ); return 1; }; } foreach my $key ( grep { $_ ne "resources" } @tuple_keys) { *$key = sub { my $self = shift; return $self->{values}->{$key} unless @_; my @added; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @added, [ $module, $version ]; } push @{ $self->{values}->{$key} }, @added; return map {@$_} @added; }; } # Resource handling my %lc_resource = map { $_ => 1 } qw{ homepage license bugtracker repository }; sub resources { my $self = shift; while ( @_ ) { my $name = shift or last; my $value = shift or next; if ( $name eq lc $name and ! $lc_resource{$name} ) { die("Unsupported reserved lowercase resource '$name'"); } $self->{values}->{resources} ||= []; push @{ $self->{values}->{resources} }, [ $name, $value ]; } $self->{values}->{resources}; } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub dynamic_config { my $self = shift; my $value = @_ ? shift : 1; if ( $self->{values}->{dynamic_config} ) { # Once dynamic we never change to static, for safety return 0; } $self->{values}->{dynamic_config} = $value ? 1 : 0; return 1; } # Convenience command sub static_config { shift->dynamic_config(0); } sub perl_version { my $self = shift; return $self->{values}->{perl_version} unless @_; my $version = shift or die( "Did not provide a value to perl_version()" ); # Normalize the version $version = $self->_perl_version($version); # We don't support the really old versions unless ( $version >= 5.005 ) { die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; } $self->{values}->{perl_version} = $version; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die( "all_from called with no args without setting name() first" ); $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; unless ( -e $file ) { die("all_from cannot find $file from $name"); } } unless ( -f $file ) { die("The path '$file' does not exist, or is not a file"); } $self->{values}{all_from} = $file; # Some methods pull from POD instead of code. # If there is a matching .pod, use that instead my $pod = $file; $pod =~ s/\.pm$/.pod/i; $pod = $file unless -e $pod; # Pull the different values $self->name_from($file) unless $self->name; $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; $self->author_from($pod) unless @{$self->author || []}; $self->license_from($pod) unless $self->license; $self->abstract_from($pod) unless $self->abstract; return 1; } sub provides { my $self = shift; my $provides = ( $self->{values}->{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}->{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $self->{values}->{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}->{no_index}->{$type} }, @_ if $type; return $self->{values}->{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML::Tiny', 0 ); require YAML::Tiny; my $data = YAML::Tiny::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->version( ExtUtils::MM_Unix->parse_version($file) ); # for version integrity check $self->makemaker_args( VERSION_FROM => $file ); } sub abstract_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } # Add both distribution and module name sub name_from { my ($self, $file) = @_; if ( Module::Install::_read($file) =~ m/ ^ \s* package \s* ([\w:]+) \s* ; /ixms ) { my ($name, $module_name) = ($1, $1); $name =~ s{::}{-}g; $self->name($name); unless ( $self->module_name ) { $self->module_name($module_name); } } else { die("Cannot determine name from $file\n"); } } sub _extract_perl_version { if ( $_[0] =~ m/ ^\s* (?:use|require) \s* v? ([\d_\.]+) \s* ; /ixms ) { my $perl_version = $1; $perl_version =~ s{_}{}g; return $perl_version; } else { return; } } sub perl_version_from { my $self = shift; my $perl_version=_extract_perl_version(Module::Install::_read($_[0])); if ($perl_version) { $self->perl_version($perl_version); } else { warn "Cannot determine perl version info from $_[0]\n"; return; } } sub author_from { my $self = shift; my $content = Module::Install::_read($_[0]); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; # XXX: ugly but should work anyway... if (eval "require Pod::Escapes; 1") { # Pod::Escapes has a mapping table. # It's in core of perl >= 5.9.3, and should be installed # as one of the Pod::Simple's prereqs, which is a prereq # of Pod::Text 3.x (see also below). $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $Pod::Escapes::Name2character_number{$1} ? chr($Pod::Escapes::Name2character_number{$1}) : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) { # Pod::Text < 3.0 has yet another mapping table, # though the table name of 2.x and 1.x are different. # (1.x is in core of Perl < 5.6, 2.x is in core of # Perl < 5.9.3) my $mapping = ($Pod::Text::VERSION < 2) ? \%Pod::Text::HTML_Escapes : \%Pod::Text::ESCAPES; $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $mapping->{$1} ? $mapping->{$1} : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } else { $author =~ s{E}{<}g; $author =~ s{E}{>}g; } $self->author($author); } else { warn "Cannot determine author info from $_[0]\n"; } } #Stolen from M::B my %license_urls = ( perl => 'http://dev.perl.org/licenses/', apache => 'http://apache.org/licenses/LICENSE-2.0', apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1', artistic => 'http://opensource.org/licenses/artistic-license.php', artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php', lgpl => 'http://opensource.org/licenses/lgpl-license.php', lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php', lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html', bsd => 'http://opensource.org/licenses/bsd-license.php', gpl => 'http://opensource.org/licenses/gpl-license.php', gpl2 => 'http://opensource.org/licenses/gpl-2.0.php', gpl3 => 'http://opensource.org/licenses/gpl-3.0.html', mit => 'http://opensource.org/licenses/mit-license.php', mozilla => 'http://opensource.org/licenses/mozilla1.1.php', open_source => undef, unrestricted => undef, restrictive => undef, unknown => undef, ); sub license { my $self = shift; return $self->{values}->{license} unless @_; my $license = shift or die( 'Did not provide a value to license()' ); $license = __extract_license($license) || lc $license; $self->{values}->{license} = $license; # Automatically fill in license URLs if ( $license_urls{$license} ) { $self->resources( license => $license_urls{$license} ); } return 1; } sub _extract_license { my $pod = shift; my $matched; return __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?) (=head \d.*|=cut.*|)\z /xms ) || __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?) (=head \d.*|=cut.*|)\z /xms ); } sub __extract_license { my $license_text = shift or return; my @phrases = ( '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1, '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1, 'Artistic and GPL' => 'perl', 1, 'GNU general public license' => 'gpl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser general public license' => 'lgpl', 1, 'GNU lesser public license' => 'lgpl', 1, 'GNU library general public license' => 'lgpl', 1, 'GNU library public license' => 'lgpl', 1, 'GNU Free Documentation license' => 'unrestricted', 1, 'GNU Affero General Public License' => 'open_source', 1, '(?:Free)?BSD license' => 'bsd', 1, 'Artistic license 2\.0' => 'artistic_2', 1, 'Artistic license' => 'artistic', 1, 'Apache (?:Software )?license' => 'apache', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'Mozilla Public License' => 'mozilla', 1, 'Q Public License' => 'open_source', 1, 'OpenSSL License' => 'unrestricted', 1, 'SSLeay License' => 'unrestricted', 1, 'zlib License' => 'open_source', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s#\s+#\\s+#gs; if ( $license_text =~ /\b$pattern\b/i ) { return $license; } } return ''; } sub license_from { my $self = shift; if (my $license=_extract_license(Module::Install::_read($_[0]))) { $self->license($license); } else { warn "Cannot determine license info from $_[0]\n"; return 'unknown'; } } sub _extract_bugtracker { my @links = $_[0] =~ m#L<( https?\Q://rt.cpan.org/\E[^>]+| https?\Q://github.com/\E[\w_]+/[\w_]+/issues| https?\Q://code.google.com/p/\E[\w_\-]+/issues/list )>#gx; my %links; @links{@links}=(); @links=keys %links; return @links; } sub bugtracker_from { my $self = shift; my $content = Module::Install::_read($_[0]); my @links = _extract_bugtracker($content); unless ( @links ) { warn "Cannot determine bugtracker info from $_[0]\n"; return 0; } if ( @links > 1 ) { warn "Found more than one bugtracker link in $_[0]\n"; return 0; } # Set the bugtracker bugtracker( $links[0] ); return 1; } sub requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->requires( $module => $version ); } } sub test_requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->test_requires( $module => $version ); } } # Convert triple-part versions (eg, 5.6.1 or 5.8.9) to # numbers (eg, 5.006001 or 5.008009). # Also, convert double-part versions (eg, 5.8) sub _perl_version { my $v = $_[-1]; $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e; $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e; $v =~ s/(\.\d\d\d)000$/$1/; $v =~ s/_.+$//; if ( ref($v) ) { # Numify $v = $v + 0; } return $v; } sub add_metadata { my $self = shift; my %hash = @_; for my $key (keys %hash) { warn "add_metadata: $key is not prefixed with 'x_'.\n" . "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/; $self->{values}->{$key} = $hash{$key}; } } ###################################################################### # MYMETA Support sub WriteMyMeta { die "WriteMyMeta has been deprecated"; } sub write_mymeta_yaml { my $self = shift; # We need YAML::Tiny to write the MYMETA.yml file unless ( eval { require YAML::Tiny; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.yml\n"; YAML::Tiny::DumpFile('MYMETA.yml', $meta); } sub write_mymeta_json { my $self = shift; # We need JSON to write the MYMETA.json file unless ( eval { require JSON; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.json\n"; Module::Install::_write( 'MYMETA.json', JSON->new->pretty(1)->canonical->encode($meta), ); } sub _write_mymeta_data { my $self = shift; # If there's no existing META.yml there is nothing we can do return undef unless -f 'META.yml'; # We need Parse::CPAN::Meta to load the file unless ( eval { require Parse::CPAN::Meta; 1; } ) { return undef; } # Merge the perl version into the dependencies my $val = $self->Meta->{values}; my $perl = delete $val->{perl_version}; if ( $perl ) { $val->{requires} ||= []; my $requires = $val->{requires}; # Canonize to three-dot version after Perl 5.6 if ( $perl >= 5.006 ) { $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e } unshift @$requires, [ perl => $perl ]; } # Load the advisory META.yml file my @yaml = Parse::CPAN::Meta::LoadFile('META.yml'); my $meta = $yaml[0]; # Overwrite the non-configure dependency hashs delete $meta->{requires}; delete $meta->{build_requires}; delete $meta->{recommends}; if ( exists $val->{requires} ) { $meta->{requires} = { map { @$_ } @{ $val->{requires} } }; } if ( exists $val->{build_requires} ) { $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } }; } return $meta; } 1; Getopt-Euclid-0.4.4/inc/Module/Install/Win32.pm0000644000175000017500000000340312205064375021254 0ustar floflooofloflooo#line 1 package Module::Install::Win32; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); die <<'END_MESSAGE' unless $rv; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } 1; Getopt-Euclid-0.4.4/inc/Module/Install/Base.pm0000644000175000017500000000214712205064375021230 0ustar floflooofloflooo#line 1 package Module::Install::Base; use strict 'vars'; use vars qw{$VERSION}; BEGIN { $VERSION = '1.06'; } # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } #line 42 sub new { my $class = shift; unless ( defined &{"${class}::call"} ) { *{"${class}::call"} = sub { shift->_top->call(@_) }; } unless ( defined &{"${class}::load"} ) { *{"${class}::load"} = sub { shift->_top->load(@_) }; } bless { @_ }, $class; } #line 61 sub AUTOLOAD { local $@; my $func = eval { shift->_top->autoload } or return; goto &$func; } #line 75 sub _top { $_[0]->{_top}; } #line 90 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } #line 106 sub is_admin { ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin'); } sub DESTROY {} package Module::Install::Base::FakeAdmin; use vars qw{$VERSION}; BEGIN { $VERSION = $Module::Install::Base::VERSION; } my $fake; sub new { $fake ||= bless(\@_, $_[0]); } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 159 Getopt-Euclid-0.4.4/inc/Module/Install/Fetch.pm0000644000175000017500000000462712205064375021414 0ustar floflooofloflooo#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; Getopt-Euclid-0.4.4/Makefile.PL0000644000175000017500000000233612205010710016346 0ustar floflooofloflooouse strict; use warnings; use inc::Module::Install; # If you updated this file, don't forget to update the Build.PL file as well! name 'Getopt-Euclid'; all_from 'lib/Getopt/Euclid.pm'; resources homepage 'http://search.cpan.org/search?query=Getopt%3A%3AEuclid&mode=dist'; bugtracker 'https://rt.cpan.org/Public/Dist/Display.html?Name=Getopt-Euclid'; repository 'git://getopt-euclid.git.sourceforge.net/gitroot/getopt-euclid/getopt-euclid'; # Perl core modules build_requires 'Test::More' => 0; build_requires 'Pod::Checker' => 0; requires 'version' => 0, requires 'Pod::Select' => 0; requires 'Pod::PlainText' => 0; # uses Pod::Select requires 'File::Basename' => 0; requires 'File::Spec::Functions' => 0; requires 'List::Util' => 0; # CPAN modules requires 'Text::Balanced' => 0; recommends 'IO::Pager::Page' => 0; WriteAll; if ( -e 'MANIFEST.SKIP' ) { generate_readme( 'lib/Getopt/Euclid.pm', 'README' ); } sub generate_readme { my ($in, $out) = @_; `pod2text $in $out`; warn "Warning: Could not generate $out.\n$!\n" if $? == -1; return $?; # exit status } Getopt-Euclid-0.4.4/t/0000755000175000017500000000000012205064475014654 5ustar flofloooflofloooGetopt-Euclid-0.4.4/t/false.t0000644000175000017500000000361711455450626016145 0ustar flofloooflofloooBEGIN { @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) Getopt-Euclid-0.4.4/t/compile.t0000644000175000017500000000100512205010710016444 0ustar floflooofloflooouse 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 Getopt-Euclid-0.4.4/t/insert_defaults.t0000644000175000017500000001151612205010710020217 0ustar flofloooflofloooBEGIN { $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) Getopt-Euclid-0.4.4/t/types_regex.t0000644000175000017500000000244412205010711017363 0ustar flofloooflofloooBEGIN { @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) Getopt-Euclid-0.4.4/t/ignore_decorations.t0000644000175000017500000000677012205010710020707 0ustar flofloooflofloooBEGIN { $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) Getopt-Euclid-0.4.4/t/repeated.t0000644000175000017500000000521312205010711016613 0ustar flofloooflofloooBEGIN { @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) Getopt-Euclid-0.4.4/t/minimal.t0000644000175000017500000000626012205010711016453 0ustar flofloooflofloooBEGIN { $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) Getopt-Euclid-0.4.4/t/fail_type.t0000644000175000017500000000400612205010710016774 0ustar floflooofloflooouse 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) Getopt-Euclid-0.4.4/t/fail_unknown_arg.t0000644000175000017500000000377612205027171020371 0ustar floflooofloflooouse 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) Getopt-Euclid-0.4.4/t/fail_unknown_mode.t0000644000175000017500000000104111455450626020536 0ustar floflooofloflooouse 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'; } Getopt-Euclid-0.4.4/t/fail_quoted_args.t0000644000175000017500000000113112205010710020324 0ustar floflooofloflooouse 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 Getopt-Euclid-0.4.4/t/fail_bad_opt_default_2.t0000644000175000017500000000466512205034564021400 0ustar floflooofloflooouse 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) Getopt-Euclid-0.4.4/t/fail_missing_var.t0000644000175000017500000000367712205027024020357 0ustar floflooofloflooouse 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) Getopt-Euclid-0.4.4/t/lib/0000755000175000017500000000000012205064475015422 5ustar flofloooflofloooGetopt-Euclid-0.4.4/t/lib/HierDemo.pod0000644000175000017500000000042112205010711017577 0ustar floflooofloflooo=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 Getopt-Euclid-0.4.4/t/lib/HierDemo2.pod0000644000175000017500000000031412205010711017662 0ustar floflooofloflooo# 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 Getopt-Euclid-0.4.4/t/lib/HierDemo2.pm0000644000175000017500000000051412205010711017516 0ustar floflooofloflooopackage 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; Getopt-Euclid-0.4.4/t/lib/HierDemo.pm0000644000175000017500000000006312205010710017432 0ustar floflooofloflooopackage t::lib::HierDemo; use Getopt::Euclid; 1; Getopt-Euclid-0.4.4/t/fail_type_msg.t0000644000175000017500000000411312205010710017641 0ustar floflooofloflooouse 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) Getopt-Euclid-0.4.4/t/hier_no_pod.t0000644000175000017500000000104312205010710017303 0ustar flofloooflofloooBEGIN { $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'; Getopt-Euclid-0.4.4/t/types_vars.t0000644000175000017500000000276412205010711017231 0ustar flofloooflofloooBEGIN { @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 Getopt-Euclid-0.4.4/t/fail_no_spec.t0000644000175000017500000000123212205027066017453 0ustar floflooofloflooouse 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'; } Getopt-Euclid-0.4.4/t/types.t0000644000175000017500000001421512205010711016170 0ustar flofloooflofloooBEGIN { $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 Getopt-Euclid-0.4.4/t/pod_coverage.t0000644000175000017500000000034712205010711017462 0ustar floflooofloflooo#!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'); Getopt-Euclid-0.4.4/t/hier_export.t0000644000175000017500000000473412205010710017360 0ustar flofloooflofloooBEGIN { $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) Getopt-Euclid-0.4.4/t/fail_bad_opt_default.t0000644000175000017500000000460212205033023021133 0ustar floflooofloflooouse 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) Getopt-Euclid-0.4.4/t/fail_bad_name_2.t0000644000175000017500000000223212205010710017761 0ustar floflooofloflooouse 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) Getopt-Euclid-0.4.4/t/opt_default.t0000644000175000017500000000633312205010711017334 0ustar flofloooflofloooBEGIN { $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) Getopt-Euclid-0.4.4/t/fail_user_constraint.t0000644000175000017500000000377612205010710021252 0ustar floflooofloflooouse 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) Getopt-Euclid-0.4.4/t/std_arguments.t0000644000175000017500000001347212205010711017707 0ustar flofloooflofloooBEGIN { $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) Getopt-Euclid-0.4.4/t/repeatable.t0000644000175000017500000000655712205010711017142 0ustar flofloooflofloooBEGIN { $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) Getopt-Euclid-0.4.4/t/fail_user_constraint_type.t0000644000175000017500000000377512205027377022333 0ustar floflooofloflooouse 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) Getopt-Euclid-0.4.4/t/quoted_args.t0000644000175000017500000000265312205010711017344 0ustar flofloooflofloooBEGIN { @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) Getopt-Euclid-0.4.4/t/hier_2.t0000644000175000017500000000721612205010710016176 0ustar floflooofloflooo#! /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) Getopt-Euclid-0.4.4/t/00.load.t0000644000175000017500000000017611455450626016205 0ustar floflooofloflooouse Test::More tests => 1; BEGIN { use_ok( 'Getopt::Euclid' ); } diag( "Testing Getopt::Euclid $Getopt::Euclid::VERSION" ); Getopt-Euclid-0.4.4/t/fail_user_constraint_comma.t0000644000175000017500000000400112205010710022404 0ustar floflooofloflooouse 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) Getopt-Euclid-0.4.4/t/fail_missing_required.t0000644000175000017500000000420012205010710021360 0ustar floflooofloflooouse 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) Getopt-Euclid-0.4.4/t/fail_bad_constraint.t0000644000175000017500000000400412205010710021003 0ustar floflooofloflooouse 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) Getopt-Euclid-0.4.4/t/excludes.t0000644000175000017500000001076212205010710016642 0ustar floflooofloflooouse 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) Getopt-Euclid-0.4.4/t/eval.t0000644000175000017500000000051612205010710015751 0ustar flofloooflofloooBEGIN { $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; Getopt-Euclid-0.4.4/t/hier.t0000644000175000017500000000720612205010710015754 0ustar floflooofloflooo#! /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::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) Getopt-Euclid-0.4.4/t/vars_export.t0000644000175000017500000001145512205010711017403 0ustar flofloooflofloooour ( $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) Getopt-Euclid-0.4.4/t/pod_file.pod0000644000175000017500000000312312205010711017120 0ustar floflooofloflooo=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) Getopt-Euclid-0.4.4/t/entity_angles.t0000644000175000017500000000642712205010710017676 0ustar flofloooflofloooBEGIN { $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) Getopt-Euclid-0.4.4/t/simple.t0000644000175000017500000000627712205010711016326 0ustar flofloooflofloooBEGIN { $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) Getopt-Euclid-0.4.4/t/fail_bad_default_ref.t0000644000175000017500000000412712205040711021111 0ustar floflooofloflooouse 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) Getopt-Euclid-0.4.4/t/minimal_2.t0000644000175000017500000000251512205046342016704 0ustar flofloooflofloooBEGIN { $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 Getopt-Euclid-0.4.4/t/fail_bad_default.t0000644000175000017500000000420012205026460020252 0ustar floflooofloflooouse 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) Getopt-Euclid-0.4.4/t/pod.t0000644000175000017500000000021411455450626015623 0ustar floflooofloflooo#!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(); Getopt-Euclid-0.4.4/t/pod_cmd_after_cut.t0000644000175000017500000000053611717117450020505 0ustar flofloooflofloooBEGIN { @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 =cutGetopt-Euclid-0.4.4/t/fail_bad_name.t0000644000175000017500000000226412205010710017545 0ustar floflooofloflooouse 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) Getopt-Euclid-0.4.4/t/fail_unknown_spec.t0000644000175000017500000000405212205027250020534 0ustar floflooofloflooouse 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) Getopt-Euclid-0.4.4/t/pod_file.t0000644000175000017500000000317512205010711016610 0ustar flofloooflofloooBEGIN { $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'; Getopt-Euclid-0.4.4/t/fail_unknown_spec_2.t0000644000175000017500000000405012205027273020760 0ustar floflooofloflooouse 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) Getopt-Euclid-0.4.4/t/simple_alternate.t0000644000175000017500000000626612205010711020363 0ustar flofloooflofloooBEGIN { $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) Getopt-Euclid-0.4.4/t/substr_2.t0000644000175000017500000000055212205010711016566 0ustar flofloooflofloooBEGIN { @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 Getopt-Euclid-0.4.4/t/repeated_2.t0000644000175000017500000000225412205010711017036 0ustar flofloooflofloooBEGIN { @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) Getopt-Euclid-0.4.4/t/fail_unknown_type.t0000644000175000017500000000404612205027342020570 0ustar floflooofloflooouse 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) Getopt-Euclid-0.4.4/t/defer_all.t0000644000175000017500000000144612205011022016737 0ustar flofloooflofloooBEGIN { $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; Getopt-Euclid-0.4.4/t/fail_minimal_clash.t0000644000175000017500000000500412205026745020631 0ustar floflooofloflooouse 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) Getopt-Euclid-0.4.4/t/bundle.t0000644000175000017500000000464612205010710016303 0ustar flofloooflofloooBEGIN { $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) Getopt-Euclid-0.4.4/t/fail_type_msg_2.t0000644000175000017500000000412712205010710020067 0ustar floflooofloflooouse 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) Getopt-Euclid-0.4.4/t/defer.t0000644000175000017500000001403612205011022016106 0ustar flofloooflofloooBEGIN { $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) Getopt-Euclid-0.4.4/t/simple_shuffle.t0000644000175000017500000000515412205010711020033 0ustar flofloooflofloooBEGIN { $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) Getopt-Euclid-0.4.4/t/quoted_args_2.t0000644000175000017500000000130712205010711017560 0ustar flofloooflofloooBEGIN { @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 Getopt-Euclid-0.4.4/t/fail_excludes_msg.t0000644000175000017500000000412712205010710020501 0ustar floflooofloflooouse 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) Getopt-Euclid-0.4.4/t/empty_ARGV_array.t0000644000175000017500000000426212205010710020177 0ustar flofloooflofloooBEGIN { $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) Getopt-Euclid-0.4.4/t/fail_misplaced_type.t0000644000175000017500000000413112205026774021035 0ustar floflooofloflooouse 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) Getopt-Euclid-0.4.4/t/fail_bad_excludes_2.t0000644000175000017500000000232112205026620020663 0ustar floflooofloflooouse 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 Getopt-Euclid-0.4.4/t/fail_bad_excludes.t0000644000175000017500000000233212205026566020455 0ustar floflooofloflooouse 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 Getopt-Euclid-0.4.4/t/any_array.t0000644000175000017500000000464012205010710017011 0ustar flofloooflofloooBEGIN { $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) Getopt-Euclid-0.4.4/t/substr.t0000644000175000017500000000055212205010711016345 0ustar flofloooflofloooBEGIN { @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