Revert "closes #57 (canonical always clones)"

This reverts commit c77b2bc35d8bb6f469851f97ec0354c67f0228fe.

This was breaking tests for HTTP::Config. See
https://github.com/libwww-perl/HTTP-Message/issues/121

2 files changed, 14 insertions, 25 deletions

diff --git a/lib/URI.pm b/lib/URI.pm
index 031699b..7d259c7 100644
--- a/lib/URI.pm
+++ b/lib/URI.pm
@@ -302,22 +302,21 @@ sub canonical
     # Make sure scheme is lowercased, that we don't escape unreserved chars,
     # and that we use upcase escape sequences.
 
-    # We now clone unconditionally; see
-    # https://github.com/libwww-perl/URI/issues/57
-
-    my $other = $_[0]->clone;
-    my $scheme = $other->_scheme || "";
+    my $self = shift;
+    my $scheme = $self->_scheme || "";
     my $uc_scheme = $scheme =~ /[A-Z]/;
-    my $esc = $$other =~ /%[a-fA-F0-9]{2}/;
-    return $other unless $uc_scheme || $esc;
-
-    $other->_scheme(lc $scheme) if $uc_scheme;
+    my $esc = $$self =~ /%[a-fA-F0-9]{2}/;
+    return $self unless $uc_scheme || $esc;
 
+    my $other = $self->clone;
+    if ($uc_scheme) {
+	$other->_scheme(lc $scheme);
+    }
     if ($esc) {
-        $$other =~ s{%([0-9a-fA-F]{2})}
-                    { my $a = chr(hex($1));
+	$$other =~ s{%([0-9a-fA-F]{2})}
+	            { my $a = chr(hex($1));
                       $a =~ /^[$unreserved]\z/o ? $a : "%\U$1"
-                  }ge;
+                    }ge;
     }
     return $other;
 }
@@ -572,12 +571,8 @@ removing the explicit port specification if it matches the default port,
 uppercasing all escape sequences, and unescaping octets that can be
 better represented as plain characters.
 
-Before version 1.75, this method would return the original unchanged
-C<$uri> object if it detected nothing to change. To make the return
-value consistent (and since the efficiency gains from this behaviour
-were marginal), this method now unconditionally returns a clone. This
-means idioms like C<< $uri->clone->canonical >> are no longer
-necessary.
+For efficiency reasons, if the $uri is already in normalized form,
+then a reference to it is returned instead of a copy.
 
 =item $uri->eq( $other_uri )
 
diff --git a/t/generic.t b/t/generic.t
index 0d8f529..e2f7b97 100644
--- a/t/generic.t
+++ b/t/generic.t
@@ -1,10 +1,9 @@
 use strict;
 use warnings;
 
-print "1..49\n";
+print "1..48\n";
 
 use URI;
-use Scalar::Util qw(refaddr);
 
 my $foo = URI->new("Foo:opaque#frag");
 
@@ -218,8 +217,3 @@ $old = $foo->query("q");
 print "not " unless !defined($old) && $foo eq "?q";
 print "ok 48\n";
 
-# canonical must always be a clone
-my $c1 = $foo->canonical; # canonicalize first
-my $c2 = $c1->canonical;  # canonicalize again
-print 'not ' if refaddr($c1) == refaddr($c2) or $$c1 ne $$c2;
-print "ok 49\n";