Hello community,
here is the log from the commit of package perl-Regexp-Common for
openSUSE:Factory checked in at 2013-06-14 16:47:28
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/perl-Regexp-Common (Old)
and /work/SRC/openSUSE:Factory/.perl-Regexp-Common.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Regexp-Common"
Changes:
--------
--- /work/SRC/openSUSE:Factory/perl-Regexp-Common/perl-Regexp-Common.changes
2012-02-14 19:05:23.000000000 +0100
+++
/work/SRC/openSUSE:Factory/.perl-Regexp-Common.new/perl-Regexp-Common.changes
2013-06-14 16:47:31.000000000 +0200
@@ -1,0 +2,23 @@
+Tue Jun 11 11:58:34 UTC 2013 - [email protected]
+
+- updated to 2013031301
+ + Pattern for IPv6 addresses. Requested by Guy Edwards and many others.
+ RT 50693.
+
+ Version 2013031201 Tue Mar 12 15:44:48 CET 2013
+ + Allow host/domain names to start with a digit, using
+ $RE{net}{domain}{-rfc1101}. Requested by Guy Edwards and many others.
+ RT 23626.
+
+ Version 2013031101 Mon Mar 11 21:02:45 CET 2013
+ + For integers and decimal numbers (reals), allow the user to specify the
+ pattern of the signs (leading sign, and for reals, the sign of the
exponent).
+ This gives the user the option to ask for a pattern that matches unsigned
+ numbers (by specifying the empty string as the pattern).
+ Requested by "Wilson, Jonathan" <[email protected]>.
+
+ Version 2013030901 Sat Mar 9 14:51:42 CET 2013
+ + Use (?-1) instead of (??{ }) for the recursive balanced pattern.
+ This makes the pattern unavailable for pre-5.010 perls.
+
+-------------------------------------------------------------------
Old:
----
Regexp-Common-2011121001.tar.gz
New:
----
Regexp-Common-2013031301.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ perl-Regexp-Common.spec ++++++
--- /var/tmp/diff_new_pack.EGI8Ee/_old 2013-06-14 16:47:32.000000000 +0200
+++ /var/tmp/diff_new_pack.EGI8Ee/_new 2013-06-14 16:47:32.000000000 +0200
@@ -1,7 +1,7 @@
#
# spec file for package perl-Regexp-Common
#
-# Copyright (c) 2012 SUSE LINUX Products GmbH, Nuernberg, Germany.
+# Copyright (c) 2013 SUSE LINUX Products GmbH, Nuernberg, Germany.
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -17,7 +17,7 @@
Name: perl-Regexp-Common
-Version: 2011121001
+Version: 2013031301
Release: 0
%define cpan_name Regexp-Common
Summary: Provide commonly requested regular expressions
++++++ Regexp-Common-2011121001.tar.gz -> Regexp-Common-2013031301.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Regexp-Common-2011121001/Changes
new/Regexp-Common-2013031301/Changes
--- old/Regexp-Common-2011121001/Changes 2011-12-10 22:05:01.000000000
+0100
+++ new/Regexp-Common-2013031301/Changes 2013-03-13 12:45:56.000000000
+0100
@@ -1,3 +1,23 @@
+Version 2013031301 Wed Mar 13 12:03:41 CET 2013
++ Pattern for IPv6 addresses. Requested by Guy Edwards and many others.
+ RT 50693.
+
+Version 2013031201 Tue Mar 12 15:44:48 CET 2013
++ Allow host/domain names to start with a digit, using
+ $RE{net}{domain}{-rfc1101}. Requested by Guy Edwards and many others.
+ RT 23626.
+
+Version 2013031101 Mon Mar 11 21:02:45 CET 2013
++ For integers and decimal numbers (reals), allow the user to specify the
+ pattern of the signs (leading sign, and for reals, the sign of the exponent).
+ This gives the user the option to ask for a pattern that matches unsigned
+ numbers (by specifying the empty string as the pattern).
+ Requested by "Wilson, Jonathan" <[email protected]>.
+
+Version 2013030901 Sat Mar 9 14:51:42 CET 2013
++ Use (?-1) instead of (??{ }) for the recursive balanced pattern.
+ This makes the pattern unavailable for pre-5.010 perls.
+
Version 2011121001 Sat Dec 10 21:32:49 CET 2011
+ Fixed a few cases where $[ was used instead of $].
(RT 73033 by Father Chrysostomos <[email protected]>)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Regexp-Common-2011121001/MANIFEST
new/Regexp-Common-2013031301/MANIFEST
--- old/Regexp-Common-2011121001/MANIFEST 2011-12-10 22:07:44.000000000
+0100
+++ new/Regexp-Common-2013031301/MANIFEST 2013-03-13 13:20:29.000000000
+0100
@@ -62,6 +62,7 @@
t/test_domain.t
t/test_i.t
t/test_ip.t
+t/test_ipv6.t
t/test_keep.t
t/test_lingua_palindrome.t
t/test_list.t
@@ -101,4 +102,5 @@
t/zip/zip.t
t/zzz_50_pod.t
t/zzz_60_pod_coverage.t
-META.yml Module meta-data (added by MakeMaker)
+META.yml Module YAML meta-data (added by
MakeMaker)
+META.json Module JSON meta-data (added by
MakeMaker)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Regexp-Common-2011121001/META.json
new/Regexp-Common-2013031301/META.json
--- old/Regexp-Common-2011121001/META.json 1970-01-01 01:00:00.000000000
+0100
+++ new/Regexp-Common-2013031301/META.json 2013-03-13 13:20:26.000000000
+0100
@@ -0,0 +1,57 @@
+{
+ "abstract" : "Provide commonly requested regular expressions",
+ "author" : [
+ "Abigail <[email protected]>"
+ ],
+ "dynamic_config" : 1,
+ "generated_by" : "ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter
version 2.120921",
+ "keywords" : [
+ "regular expression",
+ "pattern"
+ ],
+ "license" : [
+ "mit"
+ ],
+ "meta-spec" : {
+ "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec";,
+ "version" : "2"
+ },
+ "name" : "Regexp-Common",
+ "no_index" : {
+ "directory" : [
+ "t",
+ "inc"
+ ]
+ },
+ "prereqs" : {
+ "build" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "0",
+ "strict" : "0"
+ }
+ },
+ "configure" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "0",
+ "strict" : "0"
+ }
+ },
+ "runtime" : {
+ "requires" : {
+ "perl" : "5.00473",
+ "strict" : "0",
+ "vars" : "0"
+ }
+ }
+ },
+ "release_status" : "stable",
+ "resources" : {
+ "repository" : {
+ "url" : "git://github.com/Abigail/Regexp--Common.git"
+ }
+ },
+ "version" : "2013031301",
+ "x_test_requires" : {
+ "strict" : 0
+ }
+}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Regexp-Common-2011121001/META.yml
new/Regexp-Common-2013031301/META.yml
--- old/Regexp-Common-2011121001/META.yml 2011-12-10 22:07:44.000000000
+0100
+++ new/Regexp-Common-2013031301/META.yml 2013-03-13 13:20:26.000000000
+0100
@@ -1,33 +1,33 @@
---- #YAML:1.0
-name: Regexp-Common
-version: 2011121001
-abstract: Provide commonly requested regular expressions
+---
+abstract: 'Provide commonly requested regular expressions'
author:
- - Abigail <[email protected]>
-license: mit
-distribution_type: module
-configure_requires:
- ExtUtils::MakeMaker: 0
- strict: 0
+ - 'Abigail <[email protected]>'
build_requires:
- ExtUtils::MakeMaker: 0
- strict: 0
+ ExtUtils::MakeMaker: 0
+ strict: 0
+configure_requires:
+ ExtUtils::MakeMaker: 0
+ strict: 0
+dynamic_config: 1
+generated_by: 'ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version
2.120921'
+keywords:
+ - 'regular expression'
+ - pattern
+license: mit
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
+name: Regexp-Common
+no_index:
+ directory:
+ - t
+ - inc
requires:
- perl: 5.00473
- strict: 0
- vars: 0
+ perl: 5.00473
+ strict: 0
+ vars: 0
resources:
- repository: git://github.com/Abigail/Regexp--Common.git
-no_index:
- directory:
- - t
- - inc
-generated_by: ExtUtils::MakeMaker version 6.56
-meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: 1.4
-keywords:
- - regular expression
- - pattern
-test_requires:
- strict: 0
+ repository: git://github.com/Abigail/Regexp--Common.git
+version: 2013031301
+x_test_requires:
+ strict: 0
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Regexp-Common-2011121001/README
new/Regexp-Common-2013031301/README
--- old/Regexp-Common-2011121001/README 2011-04-17 16:50:06.000000000 +0200
+++ new/Regexp-Common-2013031301/README 2013-03-13 12:45:56.000000000 +0100
@@ -1,5 +1,5 @@
==============================================================================
- Release of version 2011041702 of Regexp::Common
+ Release of version 2013031301 of Regexp::Common
==============================================================================
The main reason for version 2.122 is a change in the license. You now
@@ -8,6 +8,9 @@
WARNINGS:
+ As of version 2013030901, $RE {balanced} is no longer supported
+ for pre-5.10 Perls.
+
INCOMPATIBLE CHANGE in version 2.119:
The $N settings for the -keep option of US postal codes
($RE {zip} {US} {-keep}) have been changed. See the
@@ -104,7 +107,7 @@
COPYRIGHT and LICENSE
- This software is Copyright (c) 2001 - 2009, Damian Conway and Abigail.
+ This software is Copyright (c) 2001 - 2013, Damian Conway and Abigail.
This module is free software, and maybe used under any of the following
licences:
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/Regexp-Common-2011121001/lib/Regexp/Common/balanced.pm
new/Regexp-Common-2013031301/lib/Regexp/Common/balanced.pm
--- old/Regexp-Common-2011121001/lib/Regexp/Common/balanced.pm 2010-02-23
17:59:52.000000000 +0100
+++ new/Regexp-Common-2013031301/lib/Regexp/Common/balanced.pm 2013-03-09
14:31:03.000000000 +0100
@@ -6,20 +6,15 @@
use warnings;
use vars qw /$VERSION/;
-$VERSION = '2010010201';
+$VERSION = '2013030901';
my %closer = ( '{'=>'}', '('=>')', '['=>']', '<'=>'>' );
-my $count = -1;
my %cache;
sub nested {
my ($start, $finish) = @_;
- return $Regexp::Common::balanced [$cache {$start} {$finish}]
- if exists $cache {$start} {$finish};
-
- $count ++;
- my $r = '(??{$Regexp::Common::balanced ['. $count . ']})';
+ return $cache {$start} {$finish} if exists $cache {$start} {$finish};
my @starts = map {s/\\(.)/$1/g; $_} grep {length}
$start =~ /([^|\\]+|\\.)+/gs;
@@ -41,24 +36,21 @@
my $tb = quotemeta substr $begin => 1;
my $te = quotemeta substr $end => 1;
- use re 'eval';
-
my $add;
if ($fb eq $fe) {
push @re =>
- qr /(?:$qb(?:(?>[^$fb]+)|$fb(?!$tb)(?!$te)|$r)*$qe)/;
+ qq /(?:$qb(?:(?>[^$fb]+)|$fb(?!$tb)(?!$te)|(?-1))*$qe)/;
}
else {
my @clauses = "(?>[^$fb$fe]+)";
push @clauses => "$fb(?!$tb)" if length $tb;
push @clauses => "$fe(?!$te)" if length $te;
- push @clauses => $r;
- push @re => qr /(?:$qb(?:@clauses)*$qe)/;
+ push @clauses => "(?-1)";
+ push @re => qq /(?:$qb(?:@clauses)*$qe)/;
}
}
- $cache {$start} {$finish} = $count;
- $Regexp::Common::balanced [$count] = qr/@re/;
+ $cache {$start} {$finish} = qr /(@re)/;
}
@@ -73,10 +65,9 @@
$flag -> {-begin} = join "|" => @open;
$flag -> {-end} = join "|" => @close;
}
- my $pat = nested @$flag {qw /-begin -end/};
- return exists $flag -> {-keep} ? qr /($pat)/ : $pat;
+ return nested @$flag {qw /-begin -end/};
},
- version => 5.006,
+ version => 5.010,
;
}
@@ -122,15 +113,8 @@
in which case all specified parenthesis types must be correctly balanced within
the string.
-If we are using C{-keep} (See L<Regexp::Common>):
-
-=over 4
-
-=item $1
-
-captures the entire expression
-
-=back
+Since version 2013030901, C<< $1 >> will always be set (to the entire
+matched substring), regardless whether C<< {-keep} >> is used or not.
=head2 C<< $RE{balanced}{-begin => "begin"}{-end => "end"} >>
@@ -150,15 +134,15 @@
are ignored. If either of I<-begin> or I<-end> isn't given, or is empty,
I<< -begin => '(' >> and I<< -end => ')' >> are assumed.
-If we are using C{-keep} (See L<Regexp::Common>):
-
-=over 4
-
-=item $1
+Since version 2013030901, C<< $1 >> will always be set (to the entire
+matched substring), regardless whether C<< {-keep} >> is used or not.
-captures the entire expression
+=head2 Note
-=back
+Since version 2013030901 the pattern will make of the recursive construct
+C<< (?-1) >>, instead of using the problematic C<< (??{ }) >> construct.
+This fixes an problem that was introduced in the 5.17 development track.
+This also means the pattern is no longer available for Perls older than 5.010.
=head1 SEE ALSO
@@ -181,7 +165,7 @@
=head1 LICENSE and COPYRIGHT
-This software is Copyright (c) 2001 - 2009, Damian Conway and Abigail.
+This software is Copyright (c) 2001 - 2013, Damian Conway and Abigail.
This module is free software, and maybe used under any of the following
licenses:
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Regexp-Common-2011121001/lib/Regexp/Common/net.pm
new/Regexp-Common-2013031301/lib/Regexp/Common/net.pm
--- old/Regexp-Common-2011121001/lib/Regexp/Common/net.pm 2010-02-23
17:59:52.000000000 +0100
+++ new/Regexp-Common-2013031301/lib/Regexp/Common/net.pm 2013-03-13
12:45:56.000000000 +0100
@@ -6,7 +6,7 @@
use warnings;
use vars qw /$VERSION/;
-$VERSION = '2010010201';
+$VERSION = '2013031301';
my %IPunit = (
@@ -20,11 +20,18 @@
hex => q{(?k:[0-9a-fA-F]{1,2})},
);
+my %IPv6unit = (
+ hex => q {(?k:[0-9a-f]{1,4})},
+ HEX => q {(?k:[0-9A-F]{1,4})},
+ HeX => q {(?k:[0-9a-fA-F]{1,4})},
+);
+
sub dec {$_};
sub bin {oct "0b$_"}
-my $IPdefsep = '[.]';
-my $MACdefsep = ':';
+my $IPdefsep = '[.]';
+my $MACdefsep = ':';
+my $IPv6defsep = ':';
pattern name => [qw (net IPv4)],
create => "(?k:$IPunit{dec}$IPdefsep$IPunit{dec}$IPdefsep" .
@@ -64,20 +71,74 @@
}
+
+my %cache6;
+pattern name => [qw (net IPv6), "-sep=$IPv6defsep", "-style=HeX"],
+ create => sub {
+ my $style = $_ [1] {-style};
+ my $sep = $_ [1] {-sep};
+
+ return $cache6 {$style, $sep} if $cache6 {$style, $sep};
+
+ my @re;
+
+ die "Impossible style '$style'\n" unless exists $IPv6unit {$style};
+
+ #
+ # Nothing missing
+ #
+ push @re => join $sep => ($IPv6unit {$style}) x 8;
+
+ #
+ # For "double colon" representations, at least 2 units must
+ # be omitted, leaving us with at most 6 units. 0 units is also
+ # possible. Note we can have at most one double colon.
+ #
+ for (my $l = 0; $l <= 6; $l ++) {
+ #
+ # We prefer to do longest match, so larger $r gets priority
+ #
+ for (my $r = 6 - $l; $r >= 0; $r --) {
+ #
+ # $l is the number of blocks left of the double colon,
+ # $r is the number of blocks left of the double colon,
+ # $m is the number of omitted blocks
+ #
+ my $m = 8 - $l - $r;
+ my $patl = $l ? ($IPv6unit {$style} . $sep) x $l : $sep;
+ my $patr = $r ? ($sep . $IPv6unit {$style}) x $r : $sep;
+ my $patm = "(?k:)" x $m;
+ my $pat = $patl . $patm . $patr;
+ push @re => "(?:$pat)";
+ }
+ }
+ local $" = "|";
+ $cache6 {$style, $sep} = qq /(?k:(?|@re))/;
+ },
+ version => 5.010
+;
+
+
my $letter = "[A-Za-z]";
my $let_dig = "[A-Za-z0-9]";
my $let_dig_hyp = "[-A-Za-z0-9]";
# Domain names, from RFC 1035.
-pattern name => [qw (net domain -nospace=)],
+pattern name => [qw (net domain -nospace= -rfc1101=)],
create => sub {
+ my $rfc1101 = exists $_ [1] {-rfc1101} &&
+ !defined $_ [1] {-rfc1101};
+
+ my $lead = $rfc1101 ? "(?!$RE{net}{IPv4}(?:[.]|\$))$let_dig"
+ : $letter;
+
if (exists $_ [1] {-nospace} && !defined $_ [1] {-nospace}) {
- return "(?k:$letter(?:(?:$let_dig_hyp){0,61}$let_dig)?" .
- "(?:\\.$letter(?:(?:$let_dig_hyp){0,61}$let_dig)?)*)"
+ return "(?k:$lead(?:(?:$let_dig_hyp){0,61}$let_dig)?" .
+ "(?:\\.$lead(?:(?:$let_dig_hyp){0,61}$let_dig)?)*)"
}
else {
- return "(?k: |(?:$letter(?:(?:$let_dig_hyp){0,61}$let_dig)?" .
- "(?:\\.$letter(?:(?:$let_dig_hyp){0,61}$let_dig)?)*))"
+ return "(?k: |(?:$lead(?:(?:$let_dig_hyp){0,61}$let_dig)?" .
+ "(?:\\.$lead(?:(?:$let_dig_hyp){0,61}$let_dig)?)*))"
}
},
;
@@ -261,7 +322,41 @@
If C<< -sep=I<P> >> is specified the pattern I<P> is used as the separator.
By default I<P> is C<qr/:/>.
-=head2 $RE{net}{domain}
+=head2 C<$RE{net}{IPv6}{-sep => ':'}{-style => 'HeX'}>
+
+Returns a pattern matching IPv6 numbers. An IPv6 address consists of
+eigth groups of four hexadecimal digits, separated by colons. In each
+group, leading zeros may be omitted. Two or more consecutive groups
+consisting of only zeros may be omitted (including any colons separating
+them), resulting into two sets of groups, separated by a double colon.
+(Each of the groups may be empty; C<< :: >> is a valid address, equal to
+C<< 0000:0000:0000:0000:0000:0000:0000:0000 >>). The hex numbers may be
+in either case.
+
+If the C<< -sep >> option is used, its argument is a pattern that matches
+the separator that separates groups. This defaults to C<< : >>. The
+C<< -style >> option is used to denote which case the hex numbers may be.
+The default style, C<< 'HeX' >> indicates both lower case letters C<< 'a' >>
+to C<< 'f' >> and upper case letters C<< 'A' >> to C<< 'F' >> will be
+matched. The style C<< 'HEX' >> restricts matching to upper case letters,
+and C<< 'hex' >> only matches lower case letters.
+
+If C<< {-keep} >> is used, C<< $1 >> to C<< $9 >> will be set. C<< $1 >>
+will be set to the matched address, while C<< $2 >> to C<< $9 >> will be
+set to each matched group. If a group is omitted because it contains all
+zeros, its matching variable will be the empty string.
+
+Example:
+
+ "2001:db8:85a3::8a2e:370:7334" =~ /$RE{net}{IPv6}{-keep}/;
+ print $2; # '2001'
+ print $4; # '85a3'
+ print $6; # Empty string
+ print $8; # '370'
+
+Perl 5.10 (or later) is required for this pattern.
+
+=head2 C<$RE{net}{domain}>
Returns a pattern to match domains (and hosts) as defined in RFC 1035.
Under I{-keep} only the entire domain name is returned.
@@ -275,6 +370,13 @@
or use the C<{-nospace}> option (without an argument).
+RFC 1035 does B<not> allow host or domain names to start with a digits;
+however, this restriction is relaxed in RFC 1101; this RFC allows host
+and domain names to start with a digit, as long as the first part of
+a domain does not look like an IP address. If the C<< {-rfc1101} >> option
+is given (as in C<< $RE {net} {domain} {-rfc1101} >>), we will match using
+the relaxed rules.
+
=head1 REFERENCES
=over 4
@@ -284,6 +386,11 @@
Mockapetris, P.: I<DOMAIN NAMES - IMPLEMENTATION AND SPECIFICATION>.
November 1987.
+=item B<RFC 1101>
+
+Mockapetris, P.: I<DNS Encoding of Network Names and Other Types>.
+April 1987.
+
=back
=head1 SEE ALSO
@@ -307,7 +414,7 @@
=head1 LICENSE and COPYRIGHT
-This software is Copyright (c) 2001 - 2009, Damian Conway and Abigail.
+This software is Copyright (c) 2001 - 2013, Damian Conway and Abigail.
This module is free software, and maybe used under any of the following
licenses:
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Regexp-Common-2011121001/lib/Regexp/Common/number.pm
new/Regexp-Common-2013031301/lib/Regexp/Common/number.pm
--- old/Regexp-Common-2011121001/lib/Regexp/Common/number.pm 2011-04-16
15:49:55.000000000 +0200
+++ new/Regexp-Common-2013031301/lib/Regexp/Common/number.pm 2013-03-11
21:02:00.000000000 +0100
@@ -7,7 +7,7 @@
use warnings;
use vars qw /$VERSION/;
-$VERSION = '2010010201';
+$VERSION = '2013031101';
sub _croak {
@@ -19,8 +19,8 @@
sub int_creator {
my $flags = $_ [1];
- my ($sep, $group, $base, $places) =
- @{$flags} {qw /-sep -group -base -places/};
+ my ($sep, $group, $base, $places, $sign) =
+ @{$flags} {qw /-sep -group -base -places -sign/};
# Deal with the bases.
_croak "Base must be between 1 and 36" unless $base >= 1 &&
@@ -34,14 +34,14 @@
my $quant = $places ? "{$places}" : "+";
- return $sep ? qq {(?k:(?k:[+-]?)(?k:[$chars]{1,$max}} .
+ return $sep ? qq {(?k:(?k:$sign)(?k:[$chars]{1,$max}} .
qq {(?:$sep} . qq {[$chars]{$group})*))}
- : qq {(?k:(?k:[+-]?)(?k:[$chars]$quant))}
+ : qq {(?k:(?k:$sign)(?k:[$chars]$quant))}
}
sub real_creator {
- my ($base, $places, $radix, $sep, $group, $expon) =
- @{$_[1]}{-base, -places, -radix, -sep, -group, -expon};
+ my ($base, $places, $radix, $sep, $group, $expon, $sign) =
+ @{$_[1]}{-base, -places, -radix, -sep, -group, -expon, -sign};
_croak "Base must be between 1 and 36"
unless $base >= 1 && $base <= 36;
$sep = ',' if exists $_[1]->{-sep}
@@ -50,17 +50,17 @@
foreach ($radix, $sep, $expon) {$_ = "[$_]" if 1 == length}
my $chars = substr $digits, 0, $base;
return $sep
- ? qq {(?k:(?i)(?k:[+-]?)(?k:(?=$radix?[$chars])} .
+ ? qq {(?k:(?i)(?k:$sign)(?k:(?=$radix?[$chars])} .
qq {(?k:[$chars]{1,$group}(?:(?:$sep)[$chars]{$group})*)} .
qq {(?:(?k:$radix)(?k:[$chars]{$places}))?)} .
- qq {(?:(?k:$expon)(?k:(?k:[+-]?)(?k:[$chars]+))|))}
- : qq {(?k:(?i)(?k:[+-]?)(?k:(?=$radix?[$chars])} .
+ qq {(?:(?k:$expon)(?k:(?k:$sign)(?k:[$chars]+))|))}
+ : qq {(?k:(?i)(?k:$sign)(?k:(?=$radix?[$chars])} .
qq {(?k:[$chars]*)(?:(?k:$radix)(?k:[$chars]{$places}))?)} .
- qq {(?:(?k:$expon)(?k:(?k:[+-]?)(?k:[$chars]+))|))};
+ qq {(?:(?k:$expon)(?k:(?k:$sign)(?k:[$chars]+))|))};
}
sub decimal_creator {
- my ($base, $places, $radix, $sep, $group) =
- @{$_[1]}{-base, -places, -radix, -sep, -group};
+ my ($base, $places, $radix, $sep, $group, $sign) =
+ @{$_[1]}{-base, -places, -radix, -sep, -group, -sign};
_croak "Base must be between 1 and 36"
unless $base >= 1 && $base <= 36;
$sep = ',' if exists $_[1]->{-sep}
@@ -68,32 +68,32 @@
foreach ($radix, $sep) {$_ = "[$_]" if 1 == length}
my $chars = substr $digits, 0, $base;
return $sep
- ? qq {(?k:(?i)(?k:[+-]?)(?k:(?=$radix?[$chars])} .
+ ? qq {(?k:(?i)(?k:$sign)(?k:(?=$radix?[$chars])} .
qq {(?k:[$chars]{1,$group}(?:(?:$sep)[$chars]{$group})*)} .
qq {(?:(?k:$radix)(?k:[$chars]{$places}))?))}
- : qq {(?k:(?i)(?k:[+-]?)(?k:(?=$radix?[$chars])} .
+ : qq {(?k:(?i)(?k:$sign)(?k:(?=$radix?[$chars])} .
qq {(?k:[$chars]*)(?:(?k:$radix)(?k:[$chars]{$places}))?))}
}
-pattern name => [qw (num int -sep= -base=10 -group=3)],
+pattern name => [qw (num int -sep= -base=10 -group=3 -sign=[-+]?)],
create => \&int_creator,
;
pattern name => [qw (num real -base=10), '-places=0,',
- qw (-radix=[.] -sep= -group=3 -expon=E)],
+ qw (-radix=[.] -sep= -group=3 -expon=E -sign=[-+]?)],
create => \&real_creator,
;
pattern name => [qw (num decimal -base=10), '-places=0,',
- qw (-radix=[.] -sep= -group=3)],
+ qw (-radix=[.] -sep= -group=3 -sign=[-+]?)],
create => \&decimal_creator,
;
sub real_synonym {
my ($name, $base) = @_;
pattern name => ['num', $name, '-places=0,', '-radix=[.]',
- '-sep=', '-group=3', '-expon=E'],
+ '-sep=', '-group=3', '-expon=E', '-sign=[-+]?'],
create => sub {my %flags = (%{$_[1]}, -base => $base);
real_creator (undef, \%flags);
}
@@ -169,7 +169,7 @@
Do not use this module directly, but load it via I<Regexp::Common>.
-=head2 C<$RE{num}{int}{-base}{-sep}{-group}{-places}>
+=head2 C<$RE{num}{int}{-base}{-sep}{-group}{-places}{-sign}>
Returns a pattern that matches an integer.
@@ -194,6 +194,11 @@
is no default, which means that integers are unlimited in size. This
option is ignored if the C<< -sep >> option is used.
+If C<< -sign => I<P> >> is used, it's a pattern the leading sign has to
+match. This defaults to C<< [-+]? >>, which means the number is optionally
+preceded by a minus or a plus. If you want to match unsigned integers,
+use C<< $RE{num}{int}{-sign => ''} >>.
+
For example:
$RE{num}{int} # match 1234567
@@ -246,6 +251,10 @@
If C<-expon=I<P>> is specified, the pattern I<P> is used as the exponential
marker. The default value of I<P> is C<qr/[Ee]/>.
+If C<-sign=I<P>> is specified, the pattern I<P> is used to match the
+leading sign (and the sign of the exponent). This defaults to C<< [-+]? >>,
+means means that an optional plus or minus sign can be used.
+
For example:
$RE{num}{real} # matches 123.456 or -0.1234567
@@ -423,7 +432,7 @@
=head1 LICENSE and COPYRIGHT
-This software is Copyright (c) 2001 - 2009, Damian Conway and Abigail.
+This software is Copyright (c) 2001 - 2013, Damian Conway and Abigail.
This module is free software, and maybe used under any of the following
licenses:
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Regexp-Common-2011121001/lib/Regexp/Common.pm
new/Regexp-Common-2013031301/lib/Regexp/Common.pm
--- old/Regexp-Common-2011121001/lib/Regexp/Common.pm 2011-12-10
21:39:45.000000000 +0100
+++ new/Regexp-Common-2013031301/lib/Regexp/Common.pm 2013-03-13
12:45:56.000000000 +0100
@@ -18,7 +18,7 @@
use warnings;
use vars qw /$VERSION %RE %sub_interface $AUTOLOAD/;
-$VERSION = '2011121001';
+$VERSION = '2013031301';
sub _croak {
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Regexp-Common-2011121001/t/number/decimal.t
new/Regexp-Common-2013031301/t/number/decimal.t
--- old/Regexp-Common-2011121001/t/number/decimal.t 2011-04-16
15:38:39.000000000 +0200
+++ new/Regexp-Common-2013031301/t/number/decimal.t 2013-03-11
15:35:29.000000000 +0100
@@ -79,18 +79,41 @@
};
sub __ {
- map {;"${_}_int", "${_}_int_dot",
- "${_}_minus_int", "${_}_plus_int",
- "${_}_dot_frac", "${_}_minus_dot_frac", "${_}_plus_dot_frac",
+ map {;"${_}_int", "${_}_int_dot",
+ "${_}_minus_int", "${_}_plus_int",
+ "${_}_dot_frac", "${_}_minus_dot_frac", "${_}_plus_dot_frac",
} @_
}
-push @tests => {
- name => 'basic',
- re => $decimal,
- sub => \&RE_num_decimal,
- pass => [__ (grep {$_ <= 10} map {$$_ [0]} @data)],
- fail => [__ (grep {$_ > 10} map {$$_ [0]} @data), "dot"],
+sub _2 {
+ map {;"${_}_minus_int", "${_}_plus_int",
+ "${_}_minus_dot_frac", "${_}_plus_dot_frac",
+ } @_
+}
+
+sub _3 {
+ map {;"${_}_int", "${_}_int_dot",
+ "${_}_dot_frac",
+ } @_
+}
+
+push @tests => {
+ name => 'basic',
+ re => $decimal,
+ sub => \&RE_num_decimal,
+ pass => [__ (grep {$_ <= 10} map {$$_ [0]} @data)],
+ fail => [__ (grep {$_ > 10} map {$$_ [0]} @data), "dot"],
+};
+
+
+push @tests => {
+ name => 'basic -- signed',
+ re => $decimal -> {-sign => '[-+]'},
+ sub => \&RE_num_decimal,
+ sub_args => [-sign => '[-+]'],
+ pass => [ _2 (grep {$_ <= 10} map {$$_ [0]} @data)],
+ fail => [(_3 (grep {$_ <= 10} map {$$_ [0]} @data)),
+ __ (grep {$_ > 10} map {$$_ [0]} @data), "dot"],
};
foreach my $data (@data) {
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Regexp-Common-2011121001/t/number/integer.t
new/Regexp-Common-2013031301/t/number/integer.t
--- old/Regexp-Common-2011121001/t/number/integer.t 2011-12-10
21:26:55.000000000 +0100
+++ new/Regexp-Common-2013031301/t/number/integer.t 2013-03-11
18:31:30.000000000 +0100
@@ -206,15 +206,50 @@
};
-push @tests => {
- name => "integer",
- re => $RE {num} {int},
- sub => \&RE_num_int,
- pass => [ map {;"u$_", "+$_", "-$_"} grep {$_ && $_ <= 10} @bases],
- fail => [(map {;"u$_", "+$_", "-$_"} grep {$_ && $_ > 10} @bases),
+push @tests => {
+ name => "integer",
+ re => $RE {num} {int},
+ sub => \&RE_num_int,
+ pass => [ map {;"u$_", "+$_", "-$_"} grep {$_ && $_ <= 10} @bases],
+ fail => [(map {;"u$_", "+$_", "-$_"} grep {$_ && $_ > 10} @bases),
"words", "garbage", "dot10", "sign10"],
};
+push @tests => {
+ name => "unsigned",
+ re => $RE {num} {int} {-sign => ''},
+ sub => \&RE_num_int,
+ sub_args => [-sign => ''],
+ pass => [ map {;"u$_"} grep {$_ && $_ <= 10} @bases],
+ fail => [(map {;"+$_", "-$_"} grep {$_ && $_ <= 10} @bases),
+ (map {;"u$_", "+$_", "-$_"} grep {$_ && $_ > 10} @bases),
+ "words", "garbage", "dot10", "sign10"],
+};
+
+
+push @tests => {
+ name => "minus",
+ re => $RE {num} {int} {-sign => '-'},
+ sub => \&RE_num_int,
+ sub_args => [-sign => '-'],
+ pass => [ map {;"-$_"} grep {$_ && $_ <= 10} @bases],
+ fail => [(map {;"+$_", "u$_"} grep {$_ && $_ <= 10} @bases),
+ (map {;"u$_", "+$_", "-$_"} grep {$_ && $_ > 10} @bases),
+ "words", "garbage", "dot10", "sign10"],
+};
+
+
+push @tests => {
+ name => "signed",
+ re => $RE {num} {int} {-sign => '(?:-|\+)'},
+ sub => \&RE_num_int,
+ sub_args => [-sign => '(?:-|\+)'],
+ pass => [ map {;"-$_", "+$_"} grep {$_ && $_ <= 10} @bases],
+ fail => [(map {;"u$_"} grep {$_ && $_ <= 10} @bases),
+ (map {;"u$_", "+$_", "-$_"} grep {$_ && $_ > 10} @bases),
+ "words", "garbage", "dot10", "sign10"],
+};
+
my @pairs = map {my $n = $_; map {[$n, $_]} $n + 1 .. $max_length
} 1 .. $max_length;
@@ -233,6 +268,19 @@
"words", "garbage", "dot$base", "sign$base"],
};
+ push @tests => {
+ name => "-base=$base; signed",
+ re => $RE {num} {int} {-base => $base} {-sign => '[-+]'},
+ sub => \&RE_num_int,
+ sub_args => [-base => $base, -sign => '[-+]'],
+ pass => [ map {;"+$_", "-$_"}
+ grep {$_ && $_ <= $base} @bases],
+ fail => [(map {;"u$_"} grep {$_ && $_ <= $base} @bases),
+ (map {;"u$_", "+$_", "-$_"}
+ grep {$_ && $_ > $base} @bases),
+ "words", "garbage", "dot$base", "sign$base"],
+ };
+
foreach my $group (@group_sizes) {
push @tests => {
name => "-base=$base; -group=$group",
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Regexp-Common-2011121001/t/test_balanced.t
new/Regexp-Common-2013031301/t/test_balanced.t
--- old/Regexp-Common-2011121001/t/test_balanced.t 2010-02-23
17:59:52.000000000 +0100
+++ new/Regexp-Common-2013031301/t/test_balanced.t 2013-03-09
14:41:34.000000000 +0100
@@ -8,7 +8,7 @@
use Regexp::Common;
ok;
-exit unless $] >= 5.006;
+exit unless $] >= 5.010;
# SIMPLE BALANCING ACT
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Regexp-Common-2011121001/t/test_domain.t
new/Regexp-Common-2013031301/t/test_domain.t
--- old/Regexp-Common-2011121001/t/test_domain.t 2010-02-23
17:59:52.000000000 +0100
+++ new/Regexp-Common-2013031301/t/test_domain.t 2013-03-12
17:05:37.000000000 +0100
@@ -11,44 +11,73 @@
# Domains.
-try $RE{net}{domain};
+my @data = (
+ ['host.example.com' => 'PPPP'],
+ ['a.b.c.d.e.f.g.h.i.j.k.l.m.n.o.p.q.r.s.t.u.v.w.x.y.z' => 'PPPP'],
+ ['A.B.C.D.E.F.G.H.I.J.K.L.M.N.O.P.Q.R.S.T.U.V.W.X.Y.Z' => 'PPPP'],
+ ['host1.example.com' => 'PPPP'],
+ ['host-1.example.com' => 'PPPP'],
+ ['host' => 'PPPP'],
+ ['a-----------------1.example.com' => 'PPPP'],
+ ['a123456a.example.com' => 'PPPP'],
+ #
+ # 63 char limit
+ #
+ ['abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ-0123456789.com'
+ => 'PPPP'],
+ ['abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ-0123456789a.com'
+ => 'FFFF'],
+ #
+ # By default, we can match a single space, but not two
+ #
+ [' ', => 'PFPF'],
+ [' ' => 'FFFF'],
+ #
+ # Parts may only start with a number if -rfc1101 is given
+ #
+ ['123host.example.com' => 'FFPP'],
+ ['host.12example.com' => 'FFPP'],
+ #
+ # But it may not look it starts with an IP address
+ #
+ ['127.0.0.1' => 'FFFF'],
+ ['127.0.0.1.com' => 'FFFF'],
+ ['127.0.0.1333.com' => 'FFPP'],
+ #
+ # Parts may not end with a dash
+ #
+ ['host-.example.com' => 'FFFF'],
+ #
+ # May not end with a dot
+ #
+ ['host.example.com.' => 'FFFF'],
+ #
+ # Mind your dots and spaces
+ #
+ ['host. .example.com' => 'FFFF'],
+ ['host..example.com' => 'FFFF'],
+ ['host .example.com' => 'FFFF'],
+ ['ho st.example.com' => 'FFFF'],
+);
+
+my @pats = (
+ ['$RE {net} {domain}' => $RE {net} {domain}],
+ ['$RE {net} {domain} {-nospace}' => $RE {net} {domain} {-nospace}],
+ ['$RE {net} {domain} {-rfc1101}' => $RE {net} {domain} {-rfc1101}],
+ ['$RE {net} {domain} {-nospace} {-rfc1101}'
+ => $RE {net} {domain} {-nospace} {-rfc1101}],
+);
+
+
+foreach (my $i = 0; $i < @pats; $i ++) {
+ my ($name, $pat) = @{$pats [$i]};
+ try $pat;
+ $M .= "# Trying $name\n";
+ foreach my $entry (@data) {
+ my ($domain, $results) = @$entry;
+ my $entry = substr $results, $i, 1;
+ $entry eq 'P' ? pass $domain : fail $domain;
+ }
+}
+
-pass 'host.example.com';
-pass 'a.b.c.d.e.f.g.h.i.j.k.l.m.n.o.p.q.r.s.t.u.v.w.x.y.z';
-pass 'A.B.C.D.E.F.G.H.I.J.K.L.M.N.O.P.Q.R.S.T.U.V.W.X.Y.Z';
-pass 'host1.example.com';
-pass 'host-1.example.com';
-pass 'host';
-pass 'a-----------------1.example.com';
-pass 'a123456a.example.com';
-pass 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ-0123456789.com';
-pass ' ';
-fail '123host.example.com';
-fail 'host-.example.com';
-fail 'host.example.com.';
-fail 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ-0123456789a.com';
-fail ' ';
-fail 'host. .example.com';
-fail 'host .example.com';
-fail 'ho st.example.com';
-
-try $RE{net}{domain}{-nospace};
-
-pass 'host.example.com';
-pass 'a.b.c.d.e.f.g.h.i.j.k.l.m.n.o.p.q.r.s.t.u.v.w.x.y.z';
-pass 'A.B.C.D.E.F.G.H.I.J.K.L.M.N.O.P.Q.R.S.T.U.V.W.X.Y.Z';
-pass 'host1.example.com';
-pass 'host-1.example.com';
-pass 'host';
-pass 'a-----------------1.example.com';
-pass 'a123456a.example.com';
-pass 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ-0123456789.com';
-fail ' ';
-fail '123host.example.com';
-fail 'host-.example.com';
-fail 'host.example.com.';
-fail 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ-0123456789a.com';
-fail ' ';
-fail 'host. .example.com';
-fail 'host .example.com';
-fail 'ho st.example.com';
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Regexp-Common-2011121001/t/test_i.t
new/Regexp-Common-2013031301/t/test_i.t
--- old/Regexp-Common-2011121001/t/test_i.t 2010-02-23 17:59:52.000000000
+0100
+++ new/Regexp-Common-2013031301/t/test_i.t 2013-03-09 14:42:29.000000000
+0100
@@ -25,7 +25,7 @@
[[qw /num roman/] => [qw /I i II ii XvIiI CXxxVIiI MmclXXviI/]],
);
-if ($] >= 5.006) {
+if ($] >= 5.010) {
push @data => (
[[qw /balanced/] => ["()", "(a( )b)"]],
);
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Regexp-Common-2011121001/t/test_ipv6.t
new/Regexp-Common-2013031301/t/test_ipv6.t
--- old/Regexp-Common-2011121001/t/test_ipv6.t 1970-01-01 01:00:00.000000000
+0100
+++ new/Regexp-Common-2013031301/t/test_ipv6.t 2013-03-13 12:45:56.000000000
+0100
@@ -0,0 +1,154 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+no warnings 'syntax';
+
+BEGIN {
+ if ($] < 5.010) {
+ print "1..1\n";
+ print "ok 1 # \$RE {net} {IPv6} requires 5.010\n";
+ exit;
+ }
+}
+
+use Regexp::Common;
+
+my $count = 0;
+my $PAT;
+
+END {print "1..$count\n"}
+
+sub try {
+ $PAT = shift;
+ my $name = shift;
+ print "# $name\n";
+}
+
+sub pass {
+ my $address = shift;
+ my $r = $address =~ /^$PAT/ && $address eq $&;
+ printf "%s %d # Matching %s\n", $r ? "ok" : "not ok", ++ $count, $address;
+}
+
+sub fail {
+ my $address = shift;
+ my $r = $address !~ /^$PAT/ || $address ne $&;
+ printf "%s %d # Failing %s\n", $r ? "ok" : "not ok", ++ $count, $address;
+}
+
+sub match {
+ my $address = $_ [0];
+ my @matches = @_;
+
+ my $r = $address =~ /^$PAT/ && $address eq $&;
+ printf "%s %d # Matching %s\n", $r ? "ok" : "not ok", ++ $count, $address;
+
+ if (!$r) {
+ for my $i (0 .. @matches) {
+ printf "not ok %d # SKIP\n" => ++ $count;
+ }
+ return;
+ }
+
+ #
+ # Correct number of matches?
+ #
+ printf "%s %d # Number of matches\n" =>
+ @matches == @- - 1 ? "ok" : "not ok", ++ $count;
+
+ for (my $i = 0; $i < @matches; $i ++) {
+ no strict 'refs';
+ my $matched = ${$i + 1};
+ printf "%s %d # \$%d eq '%s'\n" =>
+ $matched eq $matches [$i] ? "ok" : "not ok",
+ ++ $count, $i + 1, $matches [$i];
+ }
+}
+
+
+
+try $RE {net} {IPv6} => '$RE {net} {IPv6}';
+
+pass "2001:0db8:85a3:0000:0000:8a2e:0370:7334";
+pass "2001:db8:85a3:0:0:8a2e:370:7334"; # Leading 0's removed
+pass "2001:DB8:85A3:0:0:8A2E:370:7334"; # Upper case allowed
+pass "2001:Db8:85A3:0:0:8a2E:370:7334"; # Mixed case allowed
+pass "2001:db8:85a3::8a2e:370:7334"; # Contractions
+pass "2001:db8::8a2e:370:7334";
+pass "2001::8a2e:370:7334";
+pass "::8a2e:370:7334";
+pass "::370:7334";
+pass "::7334";
+pass "::";
+
+fail "2001:0db8:85a3:0000:0000:8a2e:0370:7334:1234"; # Too many parts
+fail "2001:0db8:85a3:0000:0000:8a2e:0370"; # Not enough parts
+fail "20013:db8:85a3:0:0:8a2e:370:7334"; # Part too long
+fail "2001:0db8:85a3:0000:0000:8a2e:0370:7334:"; # Trailing separator
+fail ":2001:0db8:85a3:0000:0000:8a2e:0370:7334"; # Leading separator
+fail "2001:db8:85a3:0::8a2e:370:7334"; # Only one unit removed
+fail "2001::8a2e:370::7334"; # Two contractions
+fail "2001:::8a2e:370:7334"; # Three separators
+fail "2001.db8.85a3.0.0.8a2e.370.7334"; # Wrong separator
+
+try $RE {net} {IPv6} {-style => "hex"} => '$RE {net} {IPv6} {-style => "hex"}';
+
+pass "2001:db8:85a3:0:0:8a2e:370:7334"; # Lower case allowed
+fail "2001:DB8:85A3:0:0:8A2E:370:7334"; # Upper case not allowed
+fail "2001:Db8:85A3:0:0:8a2E:370:7334"; # Mixed case not allowed
+
+try $RE {net} {IPv6} {-style => "HEX"} => '$RE {net} {IPv6} {-style => "HEX"}';
+
+fail "2001:db8:85a3:0:0:8a2e:370:7334"; # Lower case allowed
+pass "2001:DB8:85A3:0:0:8A2E:370:7334"; # Upper case not allowed
+fail "2001:Db8:85A3:0:0:8a2E:370:7334"; # Mixed case not allowed
+
+try $RE {net} {IPv6} {-sep => "[.]"} => '$RE {net} {IPv6} {-sep => "[.]"}';
+
+pass "2001.db8.85a3.0.0.8a2e.370.7334"; # Lower case allowed
+pass "2001.DB8.85A3.0.0.8A2E.370.7334"; # Upper case allowed
+fail "2001:db8:85a3:0:0:8a2e:370:7334"; # Fail on default sep
+
+
+try $RE {net} {IPv6} {-keep} => '$RE {net} {IPv6} {-keep}';
+
+match "2001:0db8:85a3:0000:0000:8a2e:0370:7334" =>
+ "2001", "0db8", "85a3", "0000", "0000", "8a2e", "0370", "7334";
+match "2001:0db8:85a3:0:0:8a2e:0370:7334" =>
+ "2001", "0db8", "85a3", "0", "0", "8a2e", "0370", "7334";
+match "2001:db8:85a3:0:0:8a2e:370:7334" =>
+ "2001", "db8", "85a3", "0", "0", "8a2e", "370", "7334";
+match "2001:db8:85a3::8a2e:370:7334" =>
+ "2001", "db8", "85a3", "", "", "8a2e", "370", "7334";
+match "2001:db8::8a2e:370:7334" =>
+ "2001", "db8", "", "", "", "8a2e", "370", "7334";
+match "2001::8a2e:370:7334" =>
+ "2001", "", "", "", "", "8a2e", "370", "7334";
+match "::8a2e:370:7334" =>
+ "", "", "", "", "", "8a2e", "370", "7334";
+match "::370:7334" =>
+ "", "", "", "", "", "", "370", "7334";
+match "::7334" =>
+ "", "", "", "", "", "", "", "7334";
+match "::" =>
+ "", "", "", "", "", "", "", "";
+
+fail "2001:0db8:85a3:0000:0000:8a2e:0370:7334:1234"; # Too many parts
+fail "2001:0db8:85a3:0000:0000:8a2e:0370"; # Not enough parts
+fail "20013:db8:85a3:0:0:8a2e:370:7334"; # Part too long
+fail "2001:0db8:85a3:0000:0000:8a2e:0370:7334:"; # Trailing separator
+fail ":2001:0db8:85a3:0000:0000:8a2e:0370:7334"; # Leading separator
+fail "2001:db8:85a3:0::8a2e:370:7334"; # Only one unit removed
+fail "2001::8a2e:370::7334"; # Two contractions
+fail "2001:::8a2e:370:7334"; # Three separators
+fail "2001.db8.85a3.0.0.8a2e.370.7334"; # Wrong separator
+
+
+try $RE {net} {IPv6} {-style => 'HEX'} {-sep => '[.]'} {-keep} =>
+ q [$RE {net} {IPv6} {-style => 'HEX'} {-sep => '[.]'} {-keep}];
+
+match "2001.DB8.85A3..8A2E.370.7334" =>
+ "2001", "DB8", "85A3", "", "", "8A2E", "370", "7334";
+
+__END__
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Regexp-Common-2011121001/t/test_keep.t
new/Regexp-Common-2013031301/t/test_keep.t
--- old/Regexp-Common-2011121001/t/test_keep.t 2010-02-23 17:59:52.000000000
+0100
+++ new/Regexp-Common-2013031301/t/test_keep.t 2013-03-09 14:42:40.000000000
+0100
@@ -15,7 +15,7 @@
use Regexp::Common;
ok;
-if ($] >= 5.006) {
+if ($] >= 5.010) {
try $RE{balanced}{-keep};
pass '(a(b))';
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Regexp-Common-2011121001/t/test_sub.t
new/Regexp-Common-2013031301/t/test_sub.t
--- old/Regexp-Common-2011121001/t/test_sub.t 2005-10-08 23:59:59.000000000
+0200
+++ new/Regexp-Common-2013031301/t/test_sub.t 2013-03-09 14:43:50.000000000
+0100
@@ -9,7 +9,7 @@
use Regexp::Common 'RE_ALL';
ok;
-if ($] >= 5.006) {
+if ($] >= 5.010) {
try RE_balanced;
pass '(a(b))';
fail '(a(b)';
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Regexp-Common-2011121001/t/test_sub_named.t
new/Regexp-Common-2013031301/t/test_sub_named.t
--- old/Regexp-Common-2011121001/t/test_sub_named.t 2005-10-08
23:59:59.000000000 +0200
+++ new/Regexp-Common-2013031301/t/test_sub_named.t 2013-03-09
14:44:09.000000000 +0100
@@ -9,7 +9,7 @@
use Regexp::Common qw (RE_balanced RE_num_real);
ok;
-if ($] >= 5.006) {
+if ($] >= 5.010) {
try RE_balanced;
pass '(a(b))';
fail '(a(b)';
--
To unsubscribe, e-mail: [email protected]
For additional commands, e-mail: [email protected]
