r47597 - in /trunk/liburi-perl: ./ URI/ debian/ t/
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Sun Nov 22 01:47:38 UTC 2009
Author: jawnsy-guest
Date: Sun Nov 22 01:47:32 2009
New Revision: 47597
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=47597
Log:
* New upstream release
* Add myself to Uploaders and Copyright
* Remove repackaging since RFC has been removed
* Remove outdated README.debian; especially since repacking isn't
needed anymore, and the previous entry was from 1999
* Rewrote control description
* Update debhelper rules file using new short format
Added:
trunk/liburi-perl/URI/IRI.pm
- copied unchanged from r47595, branches/upstream/liburi-perl/current/URI/IRI.pm
trunk/liburi-perl/URI/_idna.pm
- copied unchanged from r47595, branches/upstream/liburi-perl/current/URI/_idna.pm
trunk/liburi-perl/URI/_punycode.pm
- copied unchanged from r47595, branches/upstream/liburi-perl/current/URI/_punycode.pm
trunk/liburi-perl/t/idna.t
- copied unchanged from r47595, branches/upstream/liburi-perl/current/t/idna.t
trunk/liburi-perl/t/iri.t
- copied unchanged from r47595, branches/upstream/liburi-perl/current/t/iri.t
trunk/liburi-perl/t/num_eq.t
- copied unchanged from r47595, branches/upstream/liburi-perl/current/t/num_eq.t
trunk/liburi-perl/t/punycode.t
- copied unchanged from r47595, branches/upstream/liburi-perl/current/t/punycode.t
Removed:
trunk/liburi-perl/debian/README.debian
trunk/liburi-perl/debian/README.source
trunk/liburi-perl/debian/repack.local
trunk/liburi-perl/debian/repack.stub
Modified:
trunk/liburi-perl/Changes
trunk/liburi-perl/MANIFEST
trunk/liburi-perl/META.yml
trunk/liburi-perl/README
trunk/liburi-perl/URI.pm
trunk/liburi-perl/URI/_server.pm
trunk/liburi-perl/debian/changelog
trunk/liburi-perl/debian/control
trunk/liburi-perl/debian/copyright
trunk/liburi-perl/debian/rules
trunk/liburi-perl/t/old-base.t
trunk/liburi-perl/t/rfc2732.t
Modified: trunk/liburi-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liburi-perl/Changes?rev=47597&op=diff
==============================================================================
--- trunk/liburi-perl/Changes (original)
+++ trunk/liburi-perl/Changes Sun Nov 22 01:47:32 2009
@@ -1,3 +1,47 @@
+2009-11-21 Gisle Aas <gisle at ActiveState.com>
+
+ Release 1.50
+
+ The main news in this release is the initial attempt at providing
+ support to IRIs. URI objects now support the 'as_iri' and 'ihost'
+ methods.
+
+ Gisle Aas (28):
+ Added more tests for setting IPv6 addresses using the host method
+ Document how the host methods deal with IPv6 addresses
+ A "test case" to start IDNA prototype from
+ Escape IDNA hostnames
+ Introduce the as_unicode method
+ Make as_unicode undo punycode for server URLs
+ An IRI class might be helpful (RFC 3987)
+ Must punycode each part of the domain name separately
+ Include initial private Punycode module
+ Get URI::_punycode working
+ punycode of plain ascii should not edit with "-"
+ Some more tests from RFC 3492
+ Add private URI::_idna module based on encodings/idna.py
+ Start using URI::_idna for encoding of URIs
+ Avoid various use of undef warnings
+ Fix test affected by IDNA
+ Keep reference to IDNA::Punycode in the URI::_punycode docs
+ Ensure upgraded strings as input
+ Update manifest with the new idna/punycode files
+ Rename as_unicde to as_iri
+ draft-duerst-iri-bis-07: The proposed RFC 3987 update
+ Load Encode when its used
+ Rename host_unicode as ihost
+ Add basic iri test
+ Hack to make as_iri turn A-labels into U-labels
+ Make as_iri leave escapes not forming valid UTF-8 sequences
+ Merge branch 'iri'
+ Don't include RFCs in the cpan tarball
+
+ Michael G. Schwern (3):
+ Fix != overloading to match ==
+ Note that mailto does not contain a host() and this is not a bug.
+ Strip brackets off IPv6 hosts [RT#34309]
+
+
2009-08-14 Gisle Aas <gisle at ActiveState.com>
Release 1.40
Modified: trunk/liburi-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liburi-perl/MANIFEST?rev=47597&op=diff
==============================================================================
--- trunk/liburi-perl/MANIFEST (original)
+++ trunk/liburi-perl/MANIFEST Sun Nov 22 01:47:32 2009
@@ -5,14 +5,17 @@
URI.pm
URI/Escape.pm
URI/Heuristic.pm
+URI/IRI.pm
URI/QueryParam.pm
URI/Split.pm
URI/URL.pm
URI/WithBase.pm
URI/_foreign.pm
URI/_generic.pm
+URI/_idna.pm
URI/_ldap.pm
URI/_login.pm
+URI/_punycode.pm
URI/_query.pm
URI/_segment.pm
URI/_server.pm
@@ -62,16 +65,20 @@
t/gopher.t
t/heuristic.t
t/http.t
+t/idna.t
+t/iri.t
t/ldap.t
t/mailto.t
t/mix.t
t/mms.t
t/news.t
+t/num_eq.t
t/old-absconf.t
t/old-base.t
t/old-file.t
t/old-relbase.t
t/pop.t
+t/punycode.t
t/query.t
t/query-param.t
t/rel.t
Modified: trunk/liburi-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liburi-perl/META.yml?rev=47597&op=diff
==============================================================================
--- trunk/liburi-perl/META.yml (original)
+++ trunk/liburi-perl/META.yml Sun Nov 22 01:47:32 2009
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: URI
-version: 1.40
+version: 1.50
abstract: Uniform Resource Identifiers (absolute and relative)
author:
- Gisle Aas <gisle at activestate.com>
Modified: trunk/liburi-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liburi-perl/README?rev=47597&op=diff
==============================================================================
--- trunk/liburi-perl/README (original)
+++ trunk/liburi-perl/README Sun Nov 22 01:47:32 2009
@@ -23,7 +23,7 @@
comp.lang.perl.modules USENET Newsgroup. Bug reports and suggestions
for improvements can be sent to the <libwww at perl.org> mailing list.
-Copyright 1998-2004,2008 Gisle Aas.
+Copyright 1998-2009 Gisle Aas.
Copyright 1998 Graham Barr.
This library is free software; you can redistribute it and/or modify
Modified: trunk/liburi-perl/URI.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liburi-perl/URI.pm?rev=47597&op=diff
==============================================================================
--- trunk/liburi-perl/URI.pm (original)
+++ trunk/liburi-perl/URI.pm Sun Nov 22 01:47:32 2009
@@ -2,7 +2,7 @@
use strict;
use vars qw($VERSION);
-$VERSION = "1.40";
+$VERSION = "1.50";
use vars qw($ABS_REMOTE_LEADING_DOTS $ABS_ALLOW_RELATIVE_SCHEME $DEFAULT_QUERY_FORM_DELIMITER);
@@ -22,11 +22,15 @@
use URI::Escape ();
use overload ('""' => sub { ${$_[0]} },
- '==' => sub { overload::StrVal($_[0]) eq
- overload::StrVal($_[1])
- },
+ '==' => sub { _obj_eq(@_) },
+ '!=' => sub { !_obj_eq(@_) },
fallback => 1,
);
+
+# Check if two objects are the same object
+sub _obj_eq {
+ return overload::StrVal($_[0]) eq overload::StrVal($_[1]);
+}
sub new
{
@@ -74,11 +78,19 @@
my $class = shift;
my($str, $scheme) = @_;
# find all funny characters and encode the bytes.
- $str =~ s*([^$uric\#])* URI::Escape::escape_char($1) *ego;
+ $str = $class->_uric_escape($str);
$str = "$scheme:$str" unless $str =~ /^$scheme_re:/o ||
$class->_no_scheme_ok;
my $self = bless \$str, $class;
$self;
+}
+
+
+sub _uric_escape
+{
+ my($class, $str) = @_;
+ $str =~ s*([^$uric\#])* URI::Escape::escape_char($1) *ego;
+ return $str;
}
@@ -241,6 +253,43 @@
{
my $self = shift;
$$self;
+}
+
+
+sub as_iri
+{
+ my $self = shift;
+ my $str = $$self;
+ if ($str =~ /\bxn--/ && $self->can("ihost")) {
+ my $ihost = $self->ihost;
+ if ($ihost) {
+ my $u = $self->clone;
+ $u->host("%%host%%");
+ $str = $u->as_string;
+ $str =~ s/%%host%%/$ihost/;
+ }
+ }
+ if ($str =~ s/%([89A-F][0-9A-F])/chr(hex($1))/eg) {
+ # All this crap because the more obvious:
+ #
+ # Encode::decode("UTF-8", $str, sub { sprintf "%%%02X", shift })
+ #
+ # doesn't work. Apparently passing a sub as CHECK only works
+ # for 'ascii' and similar direct encodings.
+
+ require Encode;
+ my $enc = Encode::find_encoding("UTF-8");
+ my $u = "";
+ while (length $str) {
+ $u .= $enc->decode($str, Encode::FB_QUIET());
+ if (length $str) {
+ # escape next char
+ $u .= URI::Escape::escape_char(substr($str, 0, 1, ""));
+ }
+ }
+ $str = $u;
+ }
+ return $str;
}
@@ -481,10 +530,16 @@
=item $uri->as_string
-Returns a URI object to a plain string. URI objects are
+Returns a URI object to a plain ASCII string. URI objects are
also converted to plain strings automatically by overloading. This
means that $uri objects can be used as plain strings in most Perl
constructs.
+
+=item $uri->as_iri
+
+Returns a Unicode string representing the URI. Escaped UTF-8 sequences
+representing non-ASCII characters are turned into their corresponding Unicode
+code point.
=item $uri->canonical
@@ -676,6 +731,15 @@
If the $new_host string ends with a colon and a number, then this
number also sets the port.
+For IPv6 addresses the brackets around the raw address is removed in the return
+value from $uri->host. When setting the host attribute to an IPv6 address you
+can use a raw address or one enclosed in brackets. The address needs to be
+enclosed in brackets if you want to pass in a new port value as well.
+
+=item $uri->ihost
+
+Returns the host in Unicode form. Any IDNA A-labels are turned into U-labels.
+
=item $uri->port
=item $uri->port( $new_port )
@@ -695,6 +759,10 @@
unit. The returned value includes a port, even if it matches the
default port. The host part and the port part are separated by a
colon: ":".
+
+For IPv6 addresses the bracketing is preserved; thus
+URI->new("http://[::1]/")->host_port returns "[::1]:80". Contrast this with
+$uri->host which will remove the brackets.
=item $uri->default_port
@@ -806,6 +874,10 @@
C<URI> objects belonging to the mailto scheme support the common
methods and the generic query methods. In addition, they support the
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.
=item B<mms>:
@@ -1015,7 +1087,7 @@
=head1 COPYRIGHT
-Copyright 1995-2004,2008 Gisle Aas.
+Copyright 1995-2009 Gisle Aas.
Copyright 1995 Martijn Koster.
Modified: trunk/liburi-perl/URI/_server.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liburi-perl/URI/_server.pm?rev=47597&op=diff
==============================================================================
--- trunk/liburi-perl/URI/_server.pm (original)
+++ trunk/liburi-perl/URI/_server.pm Sun Nov 22 01:47:32 2009
@@ -4,6 +4,42 @@
use strict;
use URI::Escape qw(uri_unescape);
+
+sub _uric_escape {
+ my($class, $str) = @_;
+ if ($str =~ m,^((?:$URI::scheme_re:)?)//([^/?\#]*)(.*)$,os) {
+ my($scheme, $host, $rest) = ($1, $2, $3);
+ my $ui = $host =~ s/(.*@)// ? $1 : "";
+ my $port = $host =~ s/(:\d+)\z// ? $1 : "";
+ if (_host_escape($host)) {
+ $str = "$scheme//$ui$host$port$rest";
+ }
+ }
+ return $class->SUPER::_uric_escape($str);
+}
+
+sub _host_escape {
+ return unless $_[0] =~ /[^URI::uric]/;
+ require URI::_idna;
+ $_[0] = URI::_idna::encode($_[0]);
+ return 1;
+}
+
+sub as_iri {
+ my $self = shift;
+ my $str = $self->SUPER::as_iri;
+ if ($str =~ /\bxn--/) {
+ if ($str =~ m,^((?:$URI::scheme_re:)?)//([^/?\#]*)(.*)$,os) {
+ my($scheme, $host, $rest) = ($1, $2, $3);
+ my $ui = $host =~ s/(.*@)// ? $1 : "";
+ my $port = $host =~ s/(:\d+)\z// ? $1 : "";
+ require URI::_idna;
+ $host = URI::_idna::encode($host);
+ $str = "$scheme//$ui$host$port$rest";
+ }
+ }
+ return $str;
+}
sub userinfo
{
@@ -38,14 +74,31 @@
$new = "" unless defined $new;
if (length $new) {
$new =~ s/[@]/%40/g; # protect @
- $port = $1 if $new =~ s/(:\d+)$//;
+ if ($new =~ /^[^:]*:\d*\z/ || $new =~ /]:\d*\z/) {
+ $new =~ s/(:\d*)\z// || die "Assert";
+ $port = $1;
+ }
+ $new = "[$new]" if $new =~ /:/ && $new !~ /^\[/; # IPv6 address
+ _host_escape($new);
}
$self->authority("$ui$new$port");
}
return undef unless defined $old;
$old =~ s/.*@//;
- $old =~ s/:\d+$//;
+ $old =~ s/:\d+$//; # remove the port
+ $old =~ s{^\[(.*)\]$}{$1}; # remove brackets around IPv6 (RFC 3986 3.2.2)
return uri_unescape($old);
+}
+
+sub ihost
+{
+ my $self = shift;
+ my $old = $self->host(@_);
+ if ($old =~ /(^|\.)xn--/) {
+ require URI::_idna;
+ $old = URI::_idna::decode($old);
+ }
+ return $old;
}
sub _port
@@ -78,8 +131,8 @@
$self->host(shift) if @_;
return undef unless defined $old;
$old =~ s/.*@//; # zap userinfo
- $old =~ s/:$//; # empty port does not could
- $old .= ":" . $self->port unless $old =~ /:/;
+ $old =~ s/:$//; # empty port should be treated the same a no port
+ $old .= ":" . $self->port unless $old =~ /:\d+$/;
$old;
}
Modified: trunk/liburi-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liburi-perl/debian/changelog?rev=47597&op=diff
==============================================================================
--- trunk/liburi-perl/debian/changelog (original)
+++ trunk/liburi-perl/debian/changelog Sun Nov 22 01:47:32 2009
@@ -1,7 +1,13 @@
-liburi-perl (1.40+dfsg-1) UNRELEASED; urgency=low
-
- IGNORE-VERSION: 1.40+dfsg-1
- no need to upload
+liburi-perl (1.50-1) UNRELEASED; urgency=low
+
+ [ Jonathan Yu ]
+ * New upstream release
+ * Add myself to Uploaders and Copyright
+ * Remove repackaging since RFC has been removed
+ * Remove outdated README.debian; especially since repacking isn't
+ needed anymore, and the previous entry was from 1999
+ * Rewrote control description
+ * Update debhelper rules file using new short format
[ Ryan Niebur ]
* New upstream release
@@ -25,7 +31,7 @@
- Update to new format
(http://wiki.debian.org/Proposals/CopyrightFormat?action=recall&rev=196).
- -- Ryan Niebur <ryan at debian.org> Fri, 25 Sep 2009 00:26:53 -0700
+ -- Jonathan Yu <jawnsy at cpan.org> Sat, 21 Nov 2009 17:16:37 -0500
liburi-perl (1.37+dfsg-1) unstable; urgency=low
Modified: trunk/liburi-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liburi-perl/debian/control?rev=47597&op=diff
==============================================================================
--- trunk/liburi-perl/debian/control (original)
+++ trunk/liburi-perl/debian/control Sun Nov 22 01:47:32 2009
@@ -1,12 +1,13 @@
Source: liburi-perl
Section: perl
Priority: optional
-Build-Depends: debhelper (>= 7), quilt
+Build-Depends: debhelper (>= 7.0.8), quilt (>= 0.46-7)
Build-Depends-Indep: perl, libbusiness-isbn-perl
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
Uploaders: Stefan Hornburg (Racke) <racke at linuxia.de>,
Kees Cook <kees at outflux.net>, Rene Mayorga <rmayorga at debian.org.sv>,
- Ryan Niebur <ryan at debian.org>, Iulian Udrea <iulian at ubuntu.com>
+ Ryan Niebur <ryan at debian.org>, Iulian Udrea <iulian at ubuntu.com>,
+ Jonathan Yu <jawnsy at cpan.org>
Standards-Version: 3.8.3
Homepage: http://search.cpan.org/dist/URI/
Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/liburi-perl/
@@ -14,19 +15,18 @@
Package: liburi-perl
Architecture: all
-Depends: ${misc:Depends}, ${perl:Depends}, libmime-base64-perl, libnet-perl, data-dumper
+Depends: ${misc:Depends}, ${perl:Depends}, libmime-base64-perl, libnet-perl,
+ data-dumper
Suggests: libwww-perl (>= 5.41)
Conflicts: libwww-perl (<< 5.41)
-Description: Perl module to manipulate and access URI strings
- This package contains the URI.pm module with friends. The module
- implements the URI class. Objects of this class represent Uniform
+Description: module to manipulate and access URI strings
+ URI is a collection of Perl modules that represent and manipulate Uniform
Resource Identifier (URI) references as specified in RFC 2396.
.
- URI objects can be used to access and manipulate the various
- components that make up these strings. There are also methods to
- combine URIs in various ways.
+ URI objects can be used to access and manipulate the various components
+ that make up these strings. There are also methods to combine URIs in
+ various ways.
.
- The URI class replace the URI::URL class that used to be distributed
- with libwww-perl. This package contains an emulation of the old
- URI::URL interface. The emulated URI::URL implement both the old and
- the new interface.
+ The URI class replaces the URI::URL class that used to be distributed with
+ libwww-perl. This package also includes an emulation of the old URI::URL
+ interface, which implements both the old and the new interface.
Modified: trunk/liburi-perl/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liburi-perl/debian/copyright?rev=47597&op=diff
==============================================================================
--- trunk/liburi-perl/debian/copyright (original)
+++ trunk/liburi-perl/debian/copyright Sun Nov 22 01:47:32 2009
@@ -5,17 +5,18 @@
Upstream-Name: URI
Files: *
-Copyright: 1995-2004, 2008, Gisle Aas <gisle at activestate.com>
- 1998 Graham Barr.
- 1995 Martijn Koster.
+Copyright: 1995-2008, Gisle Aas <gisle at activestate.com>
+ 1998, Graham Barr <gbarr at pobox.com>
+ 1995, Martijn Koster <mak at surfski.webcrawler.com>
License-Alias: Perl
License: Artistic | GPL-1+
Files: debian/*
-Copyright: 1999-2001, John Goerzen <jgoerzen at complete.org>
+Copyright: 2009, Jonathan Yu <jawnsy at cpan.org>
+ 2009, Iulian Udrea <iulian at ubuntu.com>
+ 2008, Kees Cook <kees at outflux.net>
2001-2007, Stefan Hornburg (Racke) <racke at linuxia.de>
- 2008, Kees Cook <kees at outflux.net>
- 2009, Iulian Udrea <iulian at ubuntu.com>
+ 1999-2001, John Goerzen <jgoerzen at complete.org>
License: Artistic | GPL-1+
License: Artistic
Modified: trunk/liburi-perl/debian/rules
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liburi-perl/debian/rules?rev=47597&op=diff
==============================================================================
--- trunk/liburi-perl/debian/rules (original)
+++ trunk/liburi-perl/debian/rules Sun Nov 22 01:47:32 2009
@@ -1,28 +1,4 @@
#!/usr/bin/make -f
-include /usr/share/quilt/quilt.make
-
-build: build-stamp
-build-stamp: $(QUILT_STAMPFN)
- dh build
- touch $@
-
-clean: unpatch
- dh $@
-
-install: install-stamp
-install-stamp: build-stamp
- dh install
- touch $@
-
-binary-arch:
-
-binary-indep: install
- dh $@
-
-binary: binary-arch binary-indep
-
-get-orig-source:
- uscan --verbose --force-download
-
-.PHONY: binary binary-arch binary-indep install clean build
+%:
+ dh --with quilt $@
Modified: trunk/liburi-perl/t/old-base.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liburi-perl/t/old-base.t?rev=47597&op=diff
==============================================================================
--- trunk/liburi-perl/t/old-base.t (original)
+++ trunk/liburi-perl/t/old-base.t Sun Nov 22 01:47:32 2009
@@ -477,11 +477,11 @@
my $url = new URI::URL 'ftp://anonymous:p%61ss@håst:12345';
$url->_expect('user', 'anonymous');
$url->_expect('password', 'pass');
- $url->_expect('host', 'håst');
+ $url->_expect('host', 'xn--hst-ula');
$url->_expect('port', 12345);
# Can't really know how netloc is represented since it is partially escaped
#$url->_expect('netloc', 'anonymous:pass at hst:12345');
- $url->_expect('as_string' => 'ftp://anonymous:pass@h%E5st:12345');
+ $url->_expect('as_string' => 'ftp://anonymous:pass@xn--hst-ula:12345');
# The '0' is sometimes tricky to get right
$url->user(0);
Modified: trunk/liburi-perl/t/rfc2732.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/liburi-perl/t/rfc2732.t?rev=47597&op=diff
==============================================================================
--- trunk/liburi-perl/t/rfc2732.t (original)
+++ trunk/liburi-perl/t/rfc2732.t Sun Nov 22 01:47:32 2009
@@ -1,39 +1,52 @@
#!perl -w
-print "1..9\n";
+# Test URIs containing IPv6 addresses
use strict;
+use Test::More tests => 19;
+
use URI;
my $uri = URI->new("http://[FEDC:BA98:7654:3210:FEDC:BA98:7654:3210]:80/index.html");
-print "not " unless $uri->as_string eq "http://[FEDC:BA98:7654:3210:FEDC:BA98:7654:3210]:80/index.html";
-print "ok 1\n";
+is $uri->as_string, "http://[FEDC:BA98:7654:3210:FEDC:BA98:7654:3210]:80/index.html";
+is $uri->host, "FEDC:BA98:7654:3210:FEDC:BA98:7654:3210";
+is $uri->host_port, "[FEDC:BA98:7654:3210:FEDC:BA98:7654:3210]:80";
+is $uri->port, "80";
-print "not " unless $uri->host eq "[FEDC:BA98:7654:3210:FEDC:BA98:7654:3210]";
-print "ok 2\n";
-
-print "not " unless $uri->host_port eq "[FEDC:BA98:7654:3210:FEDC:BA98:7654:3210]:80";
-print "ok 3\n";
-
-print "not " unless $uri->port eq "80";
-print "ok 4\n";
+$uri->port(undef);
+is $uri->as_string, "http://[FEDC:BA98:7654:3210:FEDC:BA98:7654:3210]/index.html";
+is $uri->host_port, "[FEDC:BA98:7654:3210:FEDC:BA98:7654:3210]:80";
+$uri->port(80);
$uri->host("host");
-print "not " unless $uri->as_string eq "http://host:80/index.html";
-print "ok 5\n";
+is $uri->as_string, "http://host:80/index.html";
+
+$uri->host("FEDC:BA98:7654:3210:FEDC:BA98:7654:3210");
+is $uri->as_string, "http://[FEDC:BA98:7654:3210:FEDC:BA98:7654:3210]:80/index.html";
+$uri->host_port("[FEDC:BA98:7654:3210:FEDC:BA98:7654:3210]:88");
+is $uri->as_string, "http://[FEDC:BA98:7654:3210:FEDC:BA98:7654:3210]:88/index.html";
+$uri->host_port("[::1]:80");
+is $uri->as_string, "http://[::1]:80/index.html";
+$uri->host("::1:80");
+is $uri->as_string, "http://[::1:80]:80/index.html";
+$uri->host("[::1:80]");
+is $uri->as_string, "http://[::1:80]:80/index.html";
+$uri->host("[::1]:88");
+is $uri->as_string, "http://[::1]:88/index.html";
+
$uri = URI->new("ftp://ftp:@[3ffe:2a00:100:7031::1]");
-print "not " unless $uri->as_string eq "ftp://ftp:@[3ffe:2a00:100:7031::1]";
-print "ok 6\n";
+is $uri->as_string, "ftp://ftp:@[3ffe:2a00:100:7031::1]";
-print "not " unless $uri->port eq "21" && !$uri->_port;
-print "ok 7\n";
+is $uri->port, "21";
+ok !$uri->_port;
-print "not " unless $uri->host("ftp") eq "[3ffe:2a00:100:7031::1]";
-print "ok 8\n";
+is $uri->host("ftp"), "3ffe:2a00:100:7031::1";
-print "not " unless $uri eq "ftp://ftp:\@ftp";
-print "ok 9\n";
+is $uri, "ftp://ftp:\@ftp";
+
+$uri = URI->new("http://[::1]");
+is $uri->host, "::1";
__END__
More information about the Pkg-perl-cvs-commits
mailing list