The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
Changes 011
URI/file.pm 128
URI.pm 11
t/heuristic.t 11
t/old-base.t 34
5 files changed (This is a version diff) 645
@@ -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' :