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