@@ -1,3 +1,14 @@
+2004-09-19 Gisle Aas <gisle@ActiveState.com>
+
+ Release 1.33
+
+ URI::file->canonical will now try to change the 'authority'
+ to the default one.
+
+ Fix heuristic test. Apparently www.perl.co.uk is no more.
+
+
+
2004-09-07 Gisle Aas <gisle@ActiveState.com>
Release 1.32
@@ -5,7 +5,7 @@ use vars qw(@ISA $VERSION $DEFAULT_AUTHORITY %OS_CLASS);
require URI::_generic;
@ISA = qw(URI::_generic);
-$VERSION = sprintf("%d.%02d", q$Revision: 4.18 $ =~ /(\d+)\.(\d+)/);
+$VERSION = sprintf("%d.%02d", q$Revision: 4.19 $ =~ /(\d+)\.(\d+)/);
use URI::Escape qw(uri_unescape);
@@ -65,6 +65,33 @@ sub cwd
$cwd;
}
+sub canonical {
+ my $self = shift;
+ my $other = $self->SUPER::canonical;
+
+ my $scheme = $other->scheme;
+ my $auth = $other->authority;
+ return $other if !defined($scheme) && !defined($auth); # relative
+
+ if (!defined($auth) ||
+ $auth eq "" ||
+ lc($auth) eq "localhost" ||
+ (defined($DEFAULT_AUTHORITY) && lc($auth) eq lc($DEFAULT_AUTHORITY))
+ )
+ {
+ # avoid cloning if $auth already match
+ if ((defined($auth) || defined($DEFAULT_AUTHORITY)) &&
+ (!defined($auth) || !defined($DEFAULT_AUTHORITY) || $auth ne $DEFAULT_AUTHORITY)
+ )
+ {
+ $other = $other->clone if $self == $other;
+ $other->authority($DEFAULT_AUTHORITY);
+ }
+ }
+
+ $other;
+}
+
sub file
{
my($self, $os) = @_;
@@ -2,7 +2,7 @@ package URI;
use strict;
use vars qw($VERSION);
-$VERSION = "1.32"; # $Date: 2004/09/07 09:13:20 $
+$VERSION = "1.33"; # $Date: 2004/09/19 05:55:05 $
use vars qw($ABS_REMOTE_LEADING_DOTS $ABS_ALLOW_RELATIVE_SCHEME);
@@ -49,7 +49,7 @@ if (gethostbyname("www.netscape.com")) {
print "ok 6\n";
$URI::Heuristic::MY_COUNTRY = "uk";
- print "not " unless uf_urlstr("perl/camel.gif") eq "http://www.perl.co.uk/camel.gif";
+ print "not " unless uf_urlstr("perl/camel.gif") =~ m,^http://www\.perl\.(org|co)\.uk/camel\.gif$,;
print "ok 7\n";
$ENV{URL_GUESS_PATTERN} = "www.ACME.org www.ACME.com";
@@ -3,6 +3,10 @@
use URI::URL qw(url);
use URI::Escape qw(uri_escape uri_unescape);
+# want compatiblity
+use URI::file;
+$URI::file::DEFAULT_AUTHORITY = undef;
+
# _expect()
#
# Handy low-level object method tester which we insert as a method
@@ -644,9 +648,6 @@ sub escape_test {
sub newlocal_test {
return 1 if $^O eq "MacOS";
- require URI::file;
- $URI::file::DEFAULT_AUTHORITY = $URI::file::DEFAULT_AUTHORITY = undef;
-
print "newlocal_test:\n";
my $isMSWin32 = ($^O =~ /MSWin32/i);
my $pwd = ($isMSWin32 ? 'cd' :