diff options
| -rw-r--r-- | lib/URI.pm | 31 | ||||
| -rw-r--r-- | t/generic.t | 8 |
2 files changed, 25 insertions, 14 deletions
@@ -302,21 +302,22 @@ sub canonical # Make sure scheme is lowercased, that we don't escape unreserved chars, # and that we use upcase escape sequences. - my $self = shift; - my $scheme = $self->_scheme || ""; + # We now clone unconditionally; see + # https://github.com/libwww-perl/URI/issues/57 + + my $other = $_[0]->clone; + my $scheme = $other->_scheme || ""; my $uc_scheme = $scheme =~ /[A-Z]/; - my $esc = $$self =~ /%[a-fA-F0-9]{2}/; - return $self unless $uc_scheme || $esc; + my $esc = $$other =~ /%[a-fA-F0-9]{2}/; + return $other unless $uc_scheme || $esc; + + $other->_scheme(lc $scheme) if $uc_scheme; - 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; } @@ -571,8 +572,12 @@ 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. -For efficiency reasons, if the $uri is already in normalized form, -then a reference to it is returned instead of a copy. +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. =item $uri->eq( $other_uri ) diff --git a/t/generic.t b/t/generic.t index e2f7b97..0d8f529 100644 --- a/t/generic.t +++ b/t/generic.t @@ -1,9 +1,10 @@ use strict; use warnings; -print "1..48\n"; +print "1..49\n"; use URI; +use Scalar::Util qw(refaddr); my $foo = URI->new("Foo:opaque#frag"); @@ -217,3 +218,8 @@ $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"; |