r54346 - in /branches/upstream/liburi-perl/current: ./ URI/ t/

jawnsy-guest at users.alioth.debian.org jawnsy-guest at users.alioth.debian.org
Sun Mar 14 22:52:38 UTC 2010


Author: jawnsy-guest
Date: Sun Mar 14 22:52:32 2010
New Revision: 54346

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=54346
Log:
[svn-upgrade] Integrating new upstream version, liburi-perl (1.53)

Modified:
    branches/upstream/liburi-perl/current/Changes
    branches/upstream/liburi-perl/current/META.yml
    branches/upstream/liburi-perl/current/Makefile.PL
    branches/upstream/liburi-perl/current/README
    branches/upstream/liburi-perl/current/URI.pm
    branches/upstream/liburi-perl/current/URI/Escape.pm
    branches/upstream/liburi-perl/current/URI/Heuristic.pm
    branches/upstream/liburi-perl/current/URI/_generic.pm
    branches/upstream/liburi-perl/current/URI/_ldap.pm
    branches/upstream/liburi-perl/current/URI/_punycode.pm
    branches/upstream/liburi-perl/current/URI/https.pm
    branches/upstream/liburi-perl/current/URI/ldap.pm
    branches/upstream/liburi-perl/current/URI/ldaps.pm
    branches/upstream/liburi-perl/current/URI/sips.pm
    branches/upstream/liburi-perl/current/URI/snews.pm
    branches/upstream/liburi-perl/current/URI/ssh.pm
    branches/upstream/liburi-perl/current/t/escape.t
    branches/upstream/liburi-perl/current/t/heuristic.t
    branches/upstream/liburi-perl/current/t/http.t
    branches/upstream/liburi-perl/current/t/iri.t
    branches/upstream/liburi-perl/current/t/ldap.t

Modified: branches/upstream/liburi-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liburi-perl/current/Changes?rev=54346&op=diff
==============================================================================
--- branches/upstream/liburi-perl/current/Changes (original)
+++ branches/upstream/liburi-perl/current/Changes Sun Mar 14 22:52:32 2010
@@ -1,3 +1,27 @@
+2010-03-14   Gisle Aas <gisle at ActiveState.com>
+
+   Release 1.53
+
+   Ville Skyttä (6):
+      Remove unneeded execute permissions.
+      Add $uri->secure() method.
+      Documentation and comment spelling fixes.
+      Fix heuristics when COUNTRY is set to "gb".
+      Use HTTP_ACCEPT_LANGUAGE, LC_ALL, and LANG in country heuristics.
+      POD linking improvements.
+
+   Michael G. Schwern (2):
+      Rewrite the URI::Escape tests with Test::More
+      Update URI::Escape for RFC 3986
+
+   Gisle Aas (1):
+      Bump MIN_PERL_VERSION to 5.6.1 [RT#54078]
+
+   Salvatore Bonaccorso (1):
+      Suppress wide caracters warnings in iri.t [RT#53737]
+
+
+
 2009-12-30   Gisle Aas <gisle at ActiveState.com>
 
    Release 1.52

Modified: branches/upstream/liburi-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liburi-perl/current/META.yml?rev=54346&op=diff
==============================================================================
--- branches/upstream/liburi-perl/current/META.yml (original)
+++ branches/upstream/liburi-perl/current/META.yml Sun Mar 14 22:52:32 2010
@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name:               URI
-version:            1.52
+version:            1.53
 abstract:           Uniform Resource Identifiers (absolute and relative)
 author:
     - Gisle Aas <gisle at activestate.com>
@@ -12,7 +12,7 @@
     ExtUtils::MakeMaker:  0
 requires:
     MIME::Base64:  2
-    perl:          5.004
+    perl:          5.006001
 resources:
     MailingList:  mailto:libwww at perl.org
     repository:   http://gitorious.org/projects/perl-uri

Modified: branches/upstream/liburi-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liburi-perl/current/Makefile.PL?rev=54346&op=diff
==============================================================================
--- branches/upstream/liburi-perl/current/Makefile.PL (original)
+++ branches/upstream/liburi-perl/current/Makefile.PL Sun Mar 14 22:52:32 2010
@@ -1,4 +1,4 @@
-require 5.004;
+require 5.006001;
 use ExtUtils::MakeMaker;
 
 if ("foo" !~ /\Afoo\z/) {
@@ -22,7 +22,7 @@
     'ABSTRACT'     => 'Uniform Resource Identifiers (absolute and relative)',
     'AUTHOR'       => 'Gisle Aas <gisle at activestate.com>',
     'LICENSE'      => 'perl',
-    'MIN_PERL_VERSION' => 5.004,
+    'MIN_PERL_VERSION' => 5.006001,
     'PREREQ_PM'    => {	
 	'MIME::Base64' => 2,
     },

Modified: branches/upstream/liburi-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liburi-perl/current/README?rev=54346&op=diff
==============================================================================
--- branches/upstream/liburi-perl/current/README (original)
+++ branches/upstream/liburi-perl/current/README Sun Mar 14 22:52:32 2010
@@ -10,7 +10,7 @@
 Some tests require an Internet connection to work and are skipped if
 one is not active.
 
-You need perl5.004 or better to install this package.  You should also
+You need perl-5.6.1 or better to install this package.  You should also
 have the MIME::Base64 module installed.  Installation is otherwise as
 usual:
 

Modified: branches/upstream/liburi-perl/current/URI.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liburi-perl/current/URI.pm?rev=54346&op=diff
==============================================================================
--- branches/upstream/liburi-perl/current/URI.pm (original)
+++ branches/upstream/liburi-perl/current/URI.pm Sun Mar 14 22:52:32 2010
@@ -2,7 +2,7 @@
 
 use strict;
 use vars qw($VERSION);
-$VERSION = "1.52";
+$VERSION = "1.53";
 
 use vars qw($ABS_REMOTE_LEADING_DOTS $ABS_ALLOW_RELATIVE_SCHEME $DEFAULT_QUERY_FORM_DELIMITER);
 
@@ -320,6 +320,8 @@
 # generic-URI transformation methods
 sub abs { $_[0]; }
 sub rel { $_[0]; }
+
+sub secure { 0 }
 
 # help out Storable
 sub STORABLE_freeze {
@@ -569,6 +571,11 @@
 make one that denotes the same resource relative to $base_uri.
 If not, then $uri is simply returned.
 
+=item $uri->secure
+
+Returns a TRUE value if the URI is considered to point to a resource on
+a secure channel, such as an SSL or TLS encrypted one.
+
 =back
 
 =head1 GENERIC METHODS
@@ -867,12 +874,12 @@
 following mailto-specific methods: $uri->to, $uri->headers.
 
 Note that the "foo at example.com" part of a mailto is I<not> the
-C<userinfo> and C<host> but instead the C<path>.  This allowed a
-mailto to contain multiple comma-seperated email addresses.
+C<userinfo> and C<host> but instead the C<path>.  This allows a
+mailto URI to contain multiple comma separated email addresses.
 
 =item B<mms>:
 
-The I<mms> URL specification can be found at L<http://sdp.ppona.com/>
+The I<mms> URL specification can be found at L<http://sdp.ppona.com/>.
 C<URI> objects belonging to the mms scheme support the common,
 generic, and server methods, with the exception of userinfo and
 query-related sub-components.
@@ -920,7 +927,7 @@
 
 =item B<rsync>:
 
-Information about rsync is available from http://rsync.samba.org.
+Information about rsync is available from L<http://rsync.samba.org/>.
 C<URI> objects belonging to the rsync scheme support the common,
 generic and server methods.  In addition, they provide methods to
 access the userinfo sub-components: $uri->user and $uri->password.
@@ -957,7 +964,7 @@
 
 =item B<ssh>:
 
-Information about ssh is available at http://www.openssh.com/.
+Information about ssh is available at L<http://www.openssh.com/>.
 C<URI> objects belonging to the ssh scheme support the common,
 generic and server methods. In addition, they provide methods to
 access the userinfo sub-components: $uri->user and $uri->password.
@@ -972,7 +979,7 @@
 The Namespace Identifier basically works like the Scheme identifier of
 URIs, and further divides the URN namespace.  Namespace Identifier
 assignments are maintained at
-<http://www.iana.org/assignments/urn-namespaces>.
+L<http://www.iana.org/assignments/urn-namespaces>.
 
 Letter case is not significant for the Namespace Identifier.  It is
 always returned in lower case by the $uri->nid method.  The $uri->_nid
@@ -1070,11 +1077,11 @@
 RFC 2396: "Uniform Resource Identifiers (URI): Generic Syntax",
 Berners-Lee, Fielding, Masinter, August 1998.
 
-http://www.iana.org/assignments/uri-schemes
-
-http://www.iana.org/assignments/urn-namespaces
-
-http://www.w3.org/Addressing/
+L<http://www.iana.org/assignments/uri-schemes>
+
+L<http://www.iana.org/assignments/urn-namespaces>
+
+L<http://www.w3.org/Addressing/>
 
 =head1 COPYRIGHT
 

Modified: branches/upstream/liburi-perl/current/URI/Escape.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liburi-perl/current/URI/Escape.pm?rev=54346&op=diff
==============================================================================
--- branches/upstream/liburi-perl/current/URI/Escape.pm (original)
+++ branches/upstream/liburi-perl/current/URI/Escape.pm Sun Mar 14 22:52:32 2010
@@ -15,26 +15,27 @@
 =head1 DESCRIPTION
 
 This module provides functions to escape and unescape URI strings as
-defined by RFC 2396 (and updated by RFC 2732).
-A URI consists of a restricted set of characters,
-denoted as C<uric> in RFC 2396.  The restricted set of characters
-consists of digits, letters, and a few graphic symbols chosen from
-those common to most of the character encodings and input facilities
-available to Internet users:
-
-  "A" .. "Z", "a" .. "z", "0" .. "9",
-  ";", "/", "?", ":", "@", "&", "=", "+", "$", ",", "[", "]",   # reserved
-  "-", "_", ".", "!", "~", "*", "'", "(", ")"
+defined by RFC 3986.
+
+A URI consists of a restricted set of characters.  The restricted set
+of characters consists of digits, letters, and a few graphic symbols
+chosen from those common to most of the character encodings and input
+facilities available to Internet users.  They are made up of the
+"unreserved" and "reserved" character sets as defined in RFC 3986.
+
+   unreserved    = ALPHA / DIGIT / "-" / "." / "_" / "~"
+   reserved      = ":" / "/" / "?" / "#" / "[" / "]" / "@"
+                   "!" / "$" / "&" / "'" / "(" / ")"
+                 / "*" / "+" / "," / ";" / "="
 
 In addition, any byte (octet) can be represented in a URI by an escape
 sequence: a triplet consisting of the character "%" followed by two
 hexadecimal digits.  A byte can also be represented directly by a
-character, using the US-ASCII character for that octet (iff the
-character is part of C<uric>).
-
-Some of the C<uric> characters are I<reserved> for use as delimiters
-or as part of certain URI components.  These must be escaped if they are
-to be treated as ordinary data.  Read RFC 2396 for further details.
+character, using the US-ASCII character for that octet.
+
+Some of the characters are I<reserved> for use as delimiters or as
+part of certain URI components.  These must be escaped if they are to
+be treated as ordinary data.  Read RFC 3986 for further details.
 
 The functions provided (and exported by default) from this module are:
 
@@ -61,10 +62,10 @@
   "^A-Za-z"                     # everything not a letter
 
 The default set of characters to be escaped is all those which are
-I<not> part of the C<uric> character class shown above as well as the
-reserved characters.  I.e. the default is:
-
-  "^A-Za-z0-9\-_.!~*'()"
+I<not> part of the C<unreserved> character class shown above as well
+as the reserved characters.  I.e. the default is:
+
+    "^A-Za-z0-9\-\._~"
 
 =item uri_escape_utf8( $string )
 
@@ -88,7 +89,7 @@
 
 but will even work for perl-5.6 for chars in the 128 .. 255 range.
 
-Note: Javascript has a function called escape() that produces the
+Note: JavaScript has a function called escape() that produces the
 sequence "%uXXXX" for chars in the 256 .. 65535 range.  This function
 has really nothing to do with URI escaping but some folks got confused
 since it "does the right thing" in the 0 .. 255 range.  Because of
@@ -145,7 +146,7 @@
 @ISA = qw(Exporter);
 @EXPORT = qw(uri_escape uri_unescape uri_escape_utf8);
 @EXPORT_OK = qw(%escapes);
-$VERSION = "3.29";
+$VERSION = "3.30";
 
 use Carp ();
 
@@ -154,7 +155,12 @@
     $escapes{chr($_)} = sprintf("%%%02X", $_);
 }
 
-my %subst;  # compiled patternes
+my %subst;  # compiled patterns
+
+my %Unsafe = (
+    RFC2732 => qr/[^A-Za-z0-9\-_.!~*'()]/,
+    RFC3986 => qr/[^A-Za-z0-9\-\._~"]/,
+);
 
 sub uri_escape
 {
@@ -169,8 +175,7 @@
 	}
 	&{$subst{$patn}}($text);
     } else {
-	# Default unsafe characters.  RFC 2732 ^(uric - reserved)
-	$text =~ s/([^A-Za-z0-9\-_.!~*'()])/$escapes{$1} || _fail_hi($1)/ge;
+	$text =~ s/($Unsafe{RFC3986})/$escapes{$1} || _fail_hi($1)/ge;
     }
     $text;
 }

Modified: branches/upstream/liburi-perl/current/URI/Heuristic.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liburi-perl/current/URI/Heuristic.pm?rev=54346&op=diff
==============================================================================
--- branches/upstream/liburi-perl/current/URI/Heuristic.pm (original)
+++ branches/upstream/liburi-perl/current/URI/Heuristic.pm Sun Mar 14 22:52:32 2010
@@ -46,7 +46,7 @@
 
 If the hostname portion of a URI does not contain any dots, then
 certain qualified guesses are made.  These guesses are governed by
-the following two environment variables:
+the following environment variables:
 
 =over 10
 
@@ -56,6 +56,12 @@
 the domain name of your host ends with two letters, then it is taken
 to be the default country. See also L<Locale::Country>.
 
+=item HTTP_ACCEPT_LANGUAGE, LC_ALL, LANG
+
+If COUNTRY is not set, these standard environment variables are
+examined and country (not language) information possibly found in them
+is used as the default country.
+
 =item URL_GUESS_PATTERN
 
 Contains a space-separated list of URL patterns to try.  The string
@@ -87,7 +93,7 @@
 require Exporter;
 *import = \&Exporter::import;
 @EXPORT_OK = qw(uf_uri uf_uristr uf_url uf_urlstr);
-$VERSION = "4.18";
+$VERSION = "4.19";
 
 sub MY_COUNTRY() {
     for ($MY_COUNTRY) {
@@ -97,9 +103,22 @@
 	$_ = $ENV{COUNTRY};
 	return $_ if defined;
 
-	# Could use LANG, LC_ALL, etc at this point, but probably too
-	# much of a wild guess.  (Catalan != Canada, etc.)
-	#
+	# Try the country part of LC_ALL and LANG from environment
+	my @srcs = ($ENV{LC_ALL}, $ENV{LANG});
+	# ...and HTTP_ACCEPT_LANGUAGE before those if present
+	if (my $httplang = $ENV{HTTP_ACCEPT_LANGUAGE}) {
+	    # TODO: q-value processing/ordering
+	    for $httplang (split(/\s*,\s*/, $httplang)) {
+		if ($httplang =~ /^\s*([a-zA-Z]+)[_-]([a-zA-Z]{2})\s*$/) {
+		    unshift(@srcs, "${1}_${2}");
+		    last;
+		}
+	    }
+	}
+	for (@srcs) {
+	    next unless defined;
+	    return lc($1) if /^[a-zA-Z]+_([a-zA-Z]{2})(?:[.@]|$)/;
+	}
 
 	# Last bit of domain name.  This may access the network.
 	require Net::Domain;
@@ -115,11 +134,13 @@
 %LOCAL_GUESSING =
 (
  'us' => [qw(www.ACME.gov www.ACME.mil)],
- 'uk' => [qw(www.ACME.co.uk www.ACME.org.uk www.ACME.ac.uk)],
+ 'gb' => [qw(www.ACME.co.uk www.ACME.org.uk www.ACME.ac.uk)],
  'au' => [qw(www.ACME.com.au www.ACME.org.au www.ACME.edu.au)],
  'il' => [qw(www.ACME.co.il www.ACME.org.il www.ACME.net.il)],
  # send corrections and new entries to <gisle at aas.no>
 );
+# Backwards compatibility; uk != United Kingdom in ISO 3166
+$LOCAL_GUESSING{uk} = $LOCAL_GUESSING{gb};
 
 
 sub uf_uristr ($)

Modified: branches/upstream/liburi-perl/current/URI/_generic.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liburi-perl/current/URI/_generic.pm?rev=54346&op=diff
==============================================================================
--- branches/upstream/liburi-perl/current/URI/_generic.pm (original)
+++ branches/upstream/liburi-perl/current/URI/_generic.pm Sun Mar 14 22:52:32 2010
@@ -180,7 +180,7 @@
     $abs;
 }
 
-# The oposite of $url->abs.  Return a URI which is as relative as possible
+# The opposite of $url->abs.  Return a URI which is as relative as possible
 sub rel {
     my $self = shift;
     my $base = shift || Carp::croak("Missing base argument");

Modified: branches/upstream/liburi-perl/current/URI/_ldap.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liburi-perl/current/URI/_ldap.pm?rev=54346&op=diff
==============================================================================
--- branches/upstream/liburi-perl/current/URI/_ldap.pm (original)
+++ branches/upstream/liburi-perl/current/URI/_ldap.pm Sun Mar 14 22:52:32 2010
@@ -7,7 +7,7 @@
 use strict;
 
 use vars qw($VERSION);
-$VERSION = "1.10";
+$VERSION = "1.11";
 
 use URI::Escape qw(uri_unescape);
 
@@ -98,7 +98,7 @@
     # Should really know about mixed case "postalAddress", etc...
     $other->attributes(map lc, $other->attributes);
 
-    # Lowecase scope, remove default
+    # Lowercase scope, remove default
     my $old_scope = $other->scope;
     my $new_scope = lc($old_scope);
     $new_scope = "" if $new_scope eq "base";

Modified: branches/upstream/liburi-perl/current/URI/_punycode.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liburi-perl/current/URI/_punycode.pm?rev=54346&op=diff
==============================================================================
--- branches/upstream/liburi-perl/current/URI/_punycode.pm (original)
+++ branches/upstream/liburi-perl/current/URI/_punycode.pm Sun Mar 14 22:52:32 2010
@@ -1,7 +1,7 @@
 package URI::_punycode;
 
 use strict;
-our $VERSION = 0.02;
+our $VERSION = "0.03";
 
 require Exporter;
 our @ISA    = qw(Exporter);
@@ -185,7 +185,7 @@
 
 =back
 
-These functions throws exceptionsn on failure. You can catch 'em via
+These functions throw exceptions on failure. You can catch 'em via
 C<eval>.
 
 =head1 AUTHOR

Modified: branches/upstream/liburi-perl/current/URI/https.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liburi-perl/current/URI/https.pm?rev=54346&op=diff
==============================================================================
--- branches/upstream/liburi-perl/current/URI/https.pm (original)
+++ branches/upstream/liburi-perl/current/URI/https.pm Sun Mar 14 22:52:32 2010
@@ -4,4 +4,6 @@
 
 sub default_port { 443 }
 
+sub secure { 1 }
+
 1;

Modified: branches/upstream/liburi-perl/current/URI/ldap.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liburi-perl/current/URI/ldap.pm?rev=54346&op=diff
==============================================================================
--- branches/upstream/liburi-perl/current/URI/ldap.pm (original)
+++ branches/upstream/liburi-perl/current/URI/ldap.pm Sun Mar 14 22:52:32 2010
@@ -105,7 +105,7 @@
 
 =head1 SEE ALSO
 
-L<RFC-2255|http://www.cis.ohio-state.edu/htbin/rfc/rfc2255.html>
+L<http://tools.ietf.org/html/rfc2255>
 
 =head1 AUTHOR
 

Modified: branches/upstream/liburi-perl/current/URI/ldaps.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liburi-perl/current/URI/ldaps.pm?rev=54346&op=diff
==============================================================================
--- branches/upstream/liburi-perl/current/URI/ldaps.pm (original)
+++ branches/upstream/liburi-perl/current/URI/ldaps.pm Sun Mar 14 22:52:32 2010
@@ -4,4 +4,6 @@
 
 sub default_port { 636 }
 
+sub secure { 1 }
+
 1;

Modified: branches/upstream/liburi-perl/current/URI/sips.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liburi-perl/current/URI/sips.pm?rev=54346&op=diff
==============================================================================
--- branches/upstream/liburi-perl/current/URI/sips.pm (original)
+++ branches/upstream/liburi-perl/current/URI/sips.pm Sun Mar 14 22:52:32 2010
@@ -4,4 +4,6 @@
 
 sub default_port { 5061 }
 
+sub secure { 1 }
+
 1;

Modified: branches/upstream/liburi-perl/current/URI/snews.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liburi-perl/current/URI/snews.pm?rev=54346&op=diff
==============================================================================
--- branches/upstream/liburi-perl/current/URI/snews.pm (original)
+++ branches/upstream/liburi-perl/current/URI/snews.pm Sun Mar 14 22:52:32 2010
@@ -5,4 +5,6 @@
 
 sub default_port { 563 }
 
+sub secure { 1 }
+
 1;

Modified: branches/upstream/liburi-perl/current/URI/ssh.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liburi-perl/current/URI/ssh.pm?rev=54346&op=diff
==============================================================================
--- branches/upstream/liburi-perl/current/URI/ssh.pm (original)
+++ branches/upstream/liburi-perl/current/URI/ssh.pm Sun Mar 14 22:52:32 2010
@@ -6,4 +6,6 @@
 
 sub default_port { 22 }
 
+sub secure { 1 }
+
 1;

Modified: branches/upstream/liburi-perl/current/t/escape.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liburi-perl/current/t/escape.t?rev=54346&op=diff
==============================================================================
--- branches/upstream/liburi-perl/current/t/escape.t (original)
+++ branches/upstream/liburi-perl/current/t/escape.t Sun Mar 14 22:52:32 2010
@@ -1,48 +1,40 @@
 #!perl -w
 
-print "1..9\n";
+use strict;
+use warnings;
+
+use Test::More tests => 11;
 
 use URI::Escape;
 
-print "not " unless uri_escape("|abcå") eq "%7Cabc%E5";
-print "ok 1\n";
+is uri_escape("|abcå"), "%7Cabc%E5";
 
-print "not " unless uri_escape("abc", "b-d") eq "a%62%63";
-print "ok 2\n";
+is uri_escape("abc", "b-d"), "a%62%63";
 
-print "not " if defined(uri_escape(undef));
-print "ok 3\n";
+# New escapes in RFC 3986
+is uri_escape("~*'()"), "~%2A%27%28%29";
 
-print "not " unless uri_unescape("%7Cabc%e5") eq "|abcå";
-print "ok 4\n";
+is uri_escape(undef), undef;
 
-print "not " unless join(":", uri_unescape("%40A%42", "CDE", "F%47H")) eq
-                    '@AB:CDE:FGH';
-print "ok 5\n";
+is uri_unescape("%7Cabc%e5"), "|abcå";
+
+is_deeply [uri_unescape("%40A%42", "CDE", "F%47H")], [qw(@AB CDE FGH)];
 
 
 use URI::Escape qw(%escapes);
 
-print "not" unless $escapes{"%"} eq "%25";
-print "ok 6\n";
+is $escapes{"%"}, "%25";
 
 
 use URI::Escape qw(uri_escape_utf8);
 
-print "not " unless uri_escape_utf8("|abcå") eq "%7Cabc%C3%A5";
-print "ok 7\n";
+is uri_escape_utf8("|abcå"), "%7Cabc%C3%A5";
 
-if ($] < 5.008) {
-    print "ok 8  # skip perl-5.8 required\n";
-    print "ok 9  # skip perl-5.8 required\n";
+SKIP: {
+    skip "Perl 5.8.0 or higher required", 3 if $] < 5.008;
+
+    ok !eval { print uri_escape("abc" . chr(300)); 1 };
+    like $@, qr/^Can\'t escape \\x{012C}, try uri_escape_utf8\(\) instead/;
+
+    is uri_escape_utf8(chr(0xFFF)), "%E0%BF%BF";
 }
-else {
-    eval { print uri_escape("abc" . chr(300)) };
-    print "not " unless $@ && $@ =~ /^Can\'t escape \\x{012C}, try uri_escape_utf8\(\) instead/;
-    print "ok 8\n";
-
-    print "not " unless uri_escape_utf8(chr(0xFFF)) eq "%E0%BF%BF";
-    print "ok 9\n";
-}
-
-

Modified: branches/upstream/liburi-perl/current/t/heuristic.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liburi-perl/current/t/heuristic.t?rev=54346&op=diff
==============================================================================
--- branches/upstream/liburi-perl/current/t/heuristic.t (original)
+++ branches/upstream/liburi-perl/current/t/heuristic.t Sun Mar 14 22:52:32 2010
@@ -5,7 +5,7 @@
    exit;
 }
 
-print "1..15\n";
+print "1..19\n";
 
 use URI::Heuristic qw(uf_urlstr uf_url);
 if (shift) {
@@ -42,49 +42,75 @@
 print "ok 5\n";
 
 if (gethostbyname("www.perl.com") && gethostbyname("www.perl.co.uk") && !gethostbyname("www.perl.bv")) {
-    # DNS work, lets run test 6..8
+    # DNS works, let's run tests 6..12
+
+    {
+        local $ENV{LC_ALL} = "";
+        local $ENV{LANG} = "";
+        local $ENV{HTTP_ACCEPT_LANGUAGE} = "";
+
+        $ENV{LC_ALL} = "en_GB.UTF-8";
+        undef $URI::Heuristic::MY_COUNTRY;
+        print "not " unless uf_urlstr("perl/camel.gif") =~ m,^http://www\.perl\.(org|co)\.uk/camel\.gif$,;
+        print "ok 6\n";
+
+        $ENV{LC_ALL} = "C";
+        undef $URI::Heuristic::MY_COUNTRY;
+        print "not " unless uf_urlstr("perl/camel.gif") =~ m,^http://www\.perl\.(com|org)/camel\.gif$,;
+        print "ok 7\n";
+
+        $ENV{HTTP_ACCEPT_LANGUAGE} = "en-ca";
+        undef $URI::Heuristic::MY_COUNTRY;
+        print "not " unless uf_urlstr("perl/camel.gif") eq "http://www.perl.ca/camel.gif";
+        print "ok 8\n";
+    }
 
     $URI::Heuristic::MY_COUNTRY = "bv";
     print "not " unless uf_urlstr("perl/camel.gif") =~ m,^http://www\.perl\.(com|org)/camel\.gif$,;
-    print "ok 6\n";
+    print "ok 9\n";
 
+    # Backwards compatibility; uk != United Kingdom in ISO 3166
     $URI::Heuristic::MY_COUNTRY = "uk";
     print "not " unless uf_urlstr("perl/camel.gif") =~ m,^http://www\.perl\.(org|co)\.uk/camel\.gif$,;
-    print "ok 7\n";
-   
+    print "ok 10\n";
+
+    $URI::Heuristic::MY_COUNTRY = "gb";
+    print "not " unless uf_urlstr("perl/camel.gif") =~ m,^http://www\.perl\.(org|co)\.uk/camel\.gif$,;
+    print "ok 11\n";
+
     $ENV{URL_GUESS_PATTERN} = "www.ACME.org www.ACME.com";
     print "not " unless uf_urlstr("perl") eq "http://www.perl.org";
-    print "ok 8\n";
+    print "ok 12\n";
 
 } else {
-    # don't make the inocent worry
-    print "Skipping test 6-8 because DNS does not work\n";
-    for (6..8) { print "ok $_\n"; }
+    # don't make the innocent worry
+    print "Skipping test 6-12 because DNS does not work\n";
+    for (6..12) { print "ok $_\n"; }
 
 }
 
 {
 local $ENV{URL_GUESS_PATTERN} = "";
 print "not " unless uf_urlstr("perl") eq "http://perl";
-print "ok 9\n";
+print "ok 13\n";
 
 print "not " unless uf_urlstr("http:80") eq "http:80";
-print "ok 10\n";
+print "ok 14\n";
 
 print "not " unless uf_urlstr("mailto:gisle\@aas.no") eq "mailto:gisle\@aas.no";
-print "ok 11\n";
+print "ok 15\n";
 
 print "not " unless uf_urlstr("gisle\@aas.no") eq "mailto:gisle\@aas.no";
-print "ok 12\n";
+print "ok 16\n";
 
 print "not " unless uf_urlstr("Gisle.Aas\@aas.perl.org") eq "mailto:Gisle.Aas\@aas.perl.org";
-print "ok 13\n";
+print "ok 17\n";
 
 print "not " unless uf_url("gopher.sn.no")->scheme eq "gopher";
-print "ok 14\n";
+print "ok 18\n";
 
 print "not " unless uf_urlstr("123.3.3.3:8080/foo") eq "http://123.3.3.3:8080/foo";
-print "ok 15\n";
+print "ok 19\n";
 }
 
 #

Modified: branches/upstream/liburi-perl/current/t/http.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liburi-perl/current/t/http.t?rev=54346&op=diff
==============================================================================
--- branches/upstream/liburi-perl/current/t/http.t (original)
+++ branches/upstream/liburi-perl/current/t/http.t Sun Mar 14 22:52:32 2010
@@ -1,6 +1,6 @@
 #!perl -w
 
-print "1..13\n";
+print "1..15\n";
 
 use URI;
 
@@ -44,14 +44,20 @@
 print "not " unless $u->path eq "/path";
 print "ok 10\n";
 
+print "not " if $u->secure;
+print "ok 11\n";
+
 $u->scheme("https");
 print "not " unless $u->port == 443;
-print "ok 11\n";
+print "ok 12\n";
 
 print "not " unless $u eq "https://www.perl.com/path?foo=bar&bar=baz";
-print "ok 12\n";
+print "ok 13\n";
+
+print "not " unless $u->secure;
+print "ok 14\n";
 
 $u = URI->new("http://%77%77%77%2e%70%65%72%6c%2e%63%6f%6d/%70%75%62/%61/%32%30%30%31/%30%38/%32%37/%62%6a%6f%72%6e%73%74%61%64%2e%68%74%6d%6c");
 print "not " unless $u->canonical eq "http://www.perl.com/pub/a/2001/08/27/bjornstad.html";
-print "ok 13\n";
+print "ok 15\n";
 

Modified: branches/upstream/liburi-perl/current/t/iri.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liburi-perl/current/t/iri.t?rev=54346&op=diff
==============================================================================
--- branches/upstream/liburi-perl/current/t/iri.t (original)
+++ branches/upstream/liburi-perl/current/t/iri.t Sun Mar 14 22:52:32 2010
@@ -8,6 +8,9 @@
 use URI::IRI;
 
 my $u;
+
+binmode Test::More->builder->output, ":utf8";
+binmode Test::More->builder->failure_output, ":utf8";
 
 $u = URI->new("http://Bücher.ch");
 is $u, "http://xn--bcher-kva.ch";

Modified: branches/upstream/liburi-perl/current/t/ldap.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liburi-perl/current/t/ldap.t?rev=54346&op=diff
==============================================================================
--- branches/upstream/liburi-perl/current/t/ldap.t (original)
+++ branches/upstream/liburi-perl/current/t/ldap.t Sun Mar 14 22:52:32 2010
@@ -1,6 +1,6 @@
 #!perl -w
 
-print "1..22\n";
+print "1..24\n";
 
 use strict;
 use URI;
@@ -89,26 +89,31 @@
 print "$uri\n";
 print $uri->canonical, "\n";
 
+print "not " if $uri->secure;
+print "ok 16\n";
+
 $uri = URI->new("ldaps://host/dn=base?cn,sn?sub?objectClass=*");
 
 print "not " unless $uri->host eq "host";
-print "ok 16\n";
+print "ok 17\n";
 print "not " unless $uri->port eq 636;
-print "ok 17\n";
+print "ok 18\n";
 print "not " unless $uri->dn eq "dn=base";
-print "ok 18\n";
+print "ok 19\n";
+print "not " unless $uri->secure;
+print "ok 20\n";
 
 $uri = URI->new("ldapi://%2Ftmp%2Fldap.sock/????x-mod=-w--w----");
 print "not " unless $uri->authority eq "%2Ftmp%2Fldap.sock";
-print "ok 19\n";
+print "ok 21\n";
 print "not " unless $uri->un_path eq "/tmp/ldap.sock";
-print "ok 20\n";
+print "ok 22\n";
 
 $uri->un_path("/var/x\@foo:bar/");
 print "not " unless $uri eq "ldapi://%2Fvar%2Fx%40foo%3Abar%2F/????x-mod=-w--w----";
-print "ok 21\n";
+print "ok 23\n";
 
 %ext = $uri->extensions;
 print "not " unless $ext{"x-mod"} eq "-w--w----";
-print "ok 22\n";
+print "ok 24\n";
 




More information about the Pkg-perl-cvs-commits mailing list