r4105 - in
/packages/libgetopt-euclid-perl/branches/upstream/current:
Changes MANIFEST META.yml README lib/Getopt/Euclid.pm t/minimal.t
t/regex_type.t t/simple.t t/simple_shuffle.t
eloy at users.alioth.debian.org
eloy at users.alioth.debian.org
Mon Oct 9 10:13:03 UTC 2006
Author: eloy
Date: Mon Oct 9 10:13:03 2006
New Revision: 4105
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=4105
Log:
Load /tmp/tmp.vKDYo24523/libgetopt-euclid-perl-0.0.8 into
packages/libgetopt-euclid-perl/branches/upstream/current.
Added:
packages/libgetopt-euclid-perl/branches/upstream/current/t/regex_type.t
Modified:
packages/libgetopt-euclid-perl/branches/upstream/current/Changes
packages/libgetopt-euclid-perl/branches/upstream/current/MANIFEST
packages/libgetopt-euclid-perl/branches/upstream/current/META.yml
packages/libgetopt-euclid-perl/branches/upstream/current/README
packages/libgetopt-euclid-perl/branches/upstream/current/lib/Getopt/Euclid.pm
packages/libgetopt-euclid-perl/branches/upstream/current/t/minimal.t
packages/libgetopt-euclid-perl/branches/upstream/current/t/simple.t
packages/libgetopt-euclid-perl/branches/upstream/current/t/simple_shuffle.t
Modified: packages/libgetopt-euclid-perl/branches/upstream/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libgetopt-euclid-perl/branches/upstream/current/Changes?rev=4105&op=diff
==============================================================================
--- packages/libgetopt-euclid-perl/branches/upstream/current/Changes (original)
+++ packages/libgetopt-euclid-perl/branches/upstream/current/Changes Mon Oct 9 10:13:03 2006
@@ -51,3 +51,18 @@
- Added user-specified type.error messages (thanks Thomas)
- Tightened up checking of placeholder type constraints (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
Modified: packages/libgetopt-euclid-perl/branches/upstream/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libgetopt-euclid-perl/branches/upstream/current/MANIFEST?rev=4105&op=diff
==============================================================================
--- packages/libgetopt-euclid-perl/branches/upstream/current/MANIFEST (original)
+++ packages/libgetopt-euclid-perl/branches/upstream/current/MANIFEST Mon Oct 9 10:13:03 2006
@@ -37,3 +37,4 @@
t/hier_export.t
t/fail_misplaced_type.t
t/fail_type_msg.t
+t/regex_type.t
Modified: packages/libgetopt-euclid-perl/branches/upstream/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libgetopt-euclid-perl/branches/upstream/current/META.yml?rev=4105&op=diff
==============================================================================
--- packages/libgetopt-euclid-perl/branches/upstream/current/META.yml (original)
+++ packages/libgetopt-euclid-perl/branches/upstream/current/META.yml Mon Oct 9 10:13:03 2006
@@ -1,7 +1,7 @@
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: Getopt-Euclid
-version: v0.0.7
+version: v0.0.8
version_from: lib/Getopt/Euclid.pm
installdirs: site
requires:
Modified: packages/libgetopt-euclid-perl/branches/upstream/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libgetopt-euclid-perl/branches/upstream/current/README?rev=4105&op=diff
==============================================================================
--- packages/libgetopt-euclid-perl/branches/upstream/current/README (original)
+++ packages/libgetopt-euclid-perl/branches/upstream/current/README Mon Oct 9 10:13:03 2006
@@ -1,4 +1,4 @@
-Getopt::Euclid version 0.0.7
+Getopt::Euclid version 0.0.8
Getopt::Euclid uses your program's own documentation to create a com-
mand-line argument parser. This ensures that your program's documented
Modified: packages/libgetopt-euclid-perl/branches/upstream/current/lib/Getopt/Euclid.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libgetopt-euclid-perl/branches/upstream/current/lib/Getopt/Euclid.pm?rev=4105&op=diff
==============================================================================
--- packages/libgetopt-euclid-perl/branches/upstream/current/lib/Getopt/Euclid.pm (original)
+++ packages/libgetopt-euclid-perl/branches/upstream/current/lib/Getopt/Euclid.pm Mon Oct 9 10:13:03 2006
@@ -1,6 +1,6 @@
package Getopt::Euclid;
-use version; $VERSION = qv('0.0.7');
+use version; $VERSION = qv('0.0.8');
use warnings;
use strict;
@@ -201,10 +201,10 @@
'number' => sub { 1 }, # Always okay (matcher ensures this)
'+number' => sub { $_[0] > 0 },
'0+number' => sub { $_[0] >= 0 },
- 'input' => sub { -r $_[0] },
+ 'input' => sub { $_[0] eq '-' || -r $_[0] },
'output' => sub { my (undef, $dir) = splitpath($_[0]);
$dir ||= '.';
- -e $_[0] ? -w $_[0] : -w $dir
+ $_[0] eq '-' ? 1 : -e $_[0] ? -w $_[0] : -w $dir
},
);
@@ -232,7 +232,10 @@
my @false_vals;
while ($info =~ s{^ \s* false \s*[:=] \s* ([^\n]*)}{}xms) {
- push @false_vals, quotemeta $1;
+ 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) .')';
@@ -269,7 +272,10 @@
}
else {
$arg->{var}{$var}{constraint_desc} = $matchtype;
- $arg->{var}{$var}{constraint} = $STD_CONSTRAINT_FOR{$matchtype}
+ $arg->{var}{$var}{constraint} =
+ $matchtype =~ m{\A\s*/.*/\s*\z}xms
+ ? sub {1}
+ : $STD_CONSTRAINT_FOR{$matchtype}
or _fail("Unknown .type constraint: $spec");
}
}
@@ -445,6 +451,13 @@
# Recursively remove decorations on %ARGV keys
+sub AUTOLOAD {
+ our $AUTOLOAD;
+ $AUTOLOAD =~ s{.*::}{main::}xms;
+ no strict 'refs';
+ goto &$AUTOLOAD;
+}
+
sub _minimize_name {
my ($name) = @_;
$name =~ s{[][]}{}gxms; # remove all square brackets
@@ -494,8 +507,6 @@
my $msg;
if ($msg = $bad_type->{type_error}) {
- use Smart::Comments;
- ### $msg
my $var = $bad_type->{var};
$var =~ s{\W+}{}gxms;
$msg =~ s{(?<!<)\b$var\b|\b$var\b(?!>)}{$bad_type->{val}}gxms;
@@ -655,7 +666,9 @@
$var_name =~ s/(\s+)\[\\s\\0\\1]\*/$1/gxms;
my $type = $arg->{var}{$var_name}{type} || q{};
push @{$arg->{placeholders}}, $var_name;
- my $matcher = $STD_MATCHER_FOR{ $type }
+ 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]*($matcher)(?{push \@{(\$ARGV{q{$arg_name}}||=[{}])->[-1]{q{$var_name}}}, \$^N}))+"
:
@@ -683,7 +696,9 @@
$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 = $STD_MATCHER_FOR{ $type };
+ 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};})))"
@@ -757,7 +772,7 @@
=head1 VERSION
-This document describes Getopt::Euclid version 0.0.7
+This document describes Getopt::Euclid version 0.0.8
=head1 SYNOPSIS
@@ -1152,17 +1167,17 @@
The specified false values can follow any convention you wish:
- =item [+-]print
+ =item [+|-]print
=for Euclid:
false: -print
or:
- =item -report[_not]
+ =item -report[_no[t]]
=for Euclid:
- false: report_not
+ false: -report_no[t]
et cetera.
@@ -1308,6 +1323,11 @@
=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<package main> namespace,
+so it's important to qualify any subroutines that are not in that namespace.
+Furthermore, any subroutines used must be defined (or loaded from a module)
+I<before> the C<use Getopt::Euclid> statement.
=head2 Standard placeholder types
@@ -1348,6 +1368,9 @@
file in a writeable
directory)
+ /<regex>/ ...must be a string
+ matching the specified
+ pattern
=head2 Placeholder type errors
@@ -1647,6 +1670,27 @@
=for Euclid
curse.default: '*$@!&'
+
+=item Invalid constraint: %s (No <%s> placeholder in argument: %s)
+
+You attempted to define a C<.type> constraint for a placeholder that
+didn't exist. Typically this is the result of the misspelling of a
+placeholder name:
+
+ =item -foo <bar>
+
+ =for Euclid:
+ baz.type: integer
+
+or a C<=for Euclid:> that has drifted away from its argument:
+
+ =item -foo <bar>
+
+ =item -verbose
+
+ =for Euclid:
+ bar.type: integer
+
=item Getopt::Euclid loaded a second time
Modified: packages/libgetopt-euclid-perl/branches/upstream/current/t/minimal.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libgetopt-euclid-perl/branches/upstream/current/t/minimal.t?rev=4105&op=diff
==============================================================================
--- packages/libgetopt-euclid-perl/branches/upstream/current/t/minimal.t (original)
+++ packages/libgetopt-euclid-perl/branches/upstream/current/t/minimal.t Mon Oct 9 10:13:03 2006
@@ -11,7 +11,7 @@
"-out=", $OUTFILE,
"-lgth $LEN",
"size ${H}x${W}",
- '--auto-fudge',
+ '-no-fudge',
'-v',
"--timeout $TIMEOUT",
'-w', 's p a c e s',
@@ -47,8 +47,8 @@
got_arg 'v' => 1,
got_arg 'verbose' => 1,
-got_arg 'auto' => 1;
-got_arg 'auto_fudge' => 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 <min>';
@@ -88,13 +88,13 @@
file.type: readable
file.default: '-'
-=item -o[ut][file]= <file>
+=item -o[ut][file]= <out_file>
Specify output file
=for Euclid:
- file.type: writable
- file.default: '-'
+ out_file.type: writable
+ out_file.default: '-'
=back
@@ -136,9 +136,12 @@
Test something spaced
-=item --auto[-fudge]
+=item [-]-no[-fudge]
Automaticaly fudge the factors.
+
+=for Euclid:
+ false: --no[-fudge]
=item <step>
Added: packages/libgetopt-euclid-perl/branches/upstream/current/t/regex_type.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libgetopt-euclid-perl/branches/upstream/current/t/regex_type.t?rev=4105&op=file
==============================================================================
--- packages/libgetopt-euclid-perl/branches/upstream/current/t/regex_type.t (added)
+++ packages/libgetopt-euclid-perl/branches/upstream/current/t/regex_type.t Mon Oct 9 10:13:03 2006
@@ -1,0 +1,62 @@
+BEGIN {
+ @ARGV = (
+ "-h=hostname1234",
+ );
+}
+
+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 <dev>';
+is $ARGV{'-h'}{port}, 1234 => 'Got expected value for -h <port>';
+
+__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 = <dev>[<port>]
+
+Specify device/port
+
+=for Euclid:
+ dev.type: /[^:]+\D/
+ port.type: /\d+/
+
+=back
+
+=head1 AUTHOR
+
+Damian Conway (damian at 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)
+
Modified: packages/libgetopt-euclid-perl/branches/upstream/current/t/simple.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libgetopt-euclid-perl/branches/upstream/current/t/simple.t?rev=4105&op=diff
==============================================================================
--- packages/libgetopt-euclid-perl/branches/upstream/current/t/simple.t (original)
+++ packages/libgetopt-euclid-perl/branches/upstream/current/t/simple.t Mon Oct 9 10:13:03 2006
@@ -18,7 +18,13 @@
);
}
+sub lucky {
+ my ($num) = @_;
+ return $num == 7;
+}
+
use Getopt::Euclid;
+
use Test::More 'no_plan';
sub got_arg {
@@ -84,13 +90,13 @@
file.type: readable
file.default: '-'
-=item -o[ut][file]= <file>
+=item -o[ut][file]= <out_file>
Specify output file
=for Euclid:
- file.type: writable
- file.default: '-'
+ out_file.type: writable
+ out_file.default: '-'
=back
@@ -136,6 +142,9 @@
Step size
+=for Euclid:
+ step.type: int, lucky(step)
+
=item --version
=item --usage
Modified: packages/libgetopt-euclid-perl/branches/upstream/current/t/simple_shuffle.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libgetopt-euclid-perl/branches/upstream/current/t/simple_shuffle.t?rev=4105&op=diff
==============================================================================
--- packages/libgetopt-euclid-perl/branches/upstream/current/t/simple_shuffle.t (original)
+++ packages/libgetopt-euclid-perl/branches/upstream/current/t/simple_shuffle.t Mon Oct 9 10:13:03 2006
@@ -1,6 +1,6 @@
BEGIN {
$INFILE = $0;
- $OUTFILE = $0;
+ $OUTFILE = '-';
$LEN = 42;
$H = 2;
$W = -10;
More information about the Pkg-perl-cvs-commits
mailing list