fixed fragment normalization bugs in Mojo::URL

mojolicious · Dec 29, 2014 · 1679faf · 1679faf
1 parent bdd3e3c
commit 1679faf
Show file tree

Hide file tree

Showing 3 changed files with 19 additions and 13 deletions.
diff --git a/Changes b/Changes
@@ -2,7 +2,7 @@
 5.71  2014-12-29
   - Updated Net::DNS::Native requirement to 0.15 for some important bug fixes.
   - Updated jQuery to version 2.1.3.
-  - Fixed userinfo normalization bugs in Mojo::URL.
+  - Fixed fragment and userinfo normalization bugs in Mojo::URL.
 
 5.70  2014-12-18
   - Improved Mojo::Template performance.

diff --git a/lib/Mojo/URL.pm b/lib/Mojo/URL.pm
@@ -18,10 +18,7 @@ sub authority {
     return $self unless defined(my $authority = shift);
 
     # Userinfo
-    if ($authority =~ s/^([^\@]+)\@//) {
-      my $info = url_unescape $1;
-      $self->userinfo(decode('UTF-8', $info) // $info);
-    }
+    $self->userinfo(_decode(url_unescape $1)) if $authority =~ s/^([^\@]+)\@//;
 
     # Port
     $authority =~ s/:(\d+)$// and $self->port($1);
@@ -80,7 +77,8 @@ sub parse {
 
   # Official regex from RFC 3986
   $url =~ m!^(([^:/?#]+):)?(//([^/?#]*))?([^?#]*)(\?([^#]*))?(#(.*))?!;
-  return $self->scheme($2)->authority($4)->path($5)->query($7)->fragment($9);
+  $self->scheme($2)->authority($4)->path($5)->query($7);
+  return defined $9 ? $self->fragment(_decode(url_unescape $9)) : $self;
 }
 
 sub path {
@@ -184,9 +182,12 @@ sub to_string {
 
   # Fragment
   return $url unless defined(my $fragment = $self->fragment);
-  return $url . '#' . url_escape $fragment, '^A-Za-z0-9\-._~!$&\'()*+,;=%:@/?';
+  return $url . '#' . url_escape encode('UTF-8', $fragment),
+    '^A-Za-z0-9\-._~!$&\'()*+,;=%:@/?';
 }
 
+sub _decode { decode('UTF-8', $_[0]) // $_[0] }
+
 1;
 
 =encoding utf8
@@ -243,7 +244,7 @@ Base of this URL, defaults to a L<Mojo::URL> object.
 =head2 fragment
 
   my $fragment = $url->fragment;
-  $url         = $url->fragment('foo');
+  $url         = $url->fragment('♥mojolicious♥');
 
 Fragment part of this URL.
 

diff --git a/t/mojo/url.t b/t/mojo/url.t
@@ -348,14 +348,18 @@ is $url->port,     3000,               'right port';
 is "$url", 'https://%E2%99%A5:%E2%99%A5@xn--krih-moa.com:3000', 'right format';
 
 # IDNA (snowman)
-$url = Mojo::URL->new('http://☃:☃@☃.net/');
+$url = Mojo::URL->new('http://☃:☃@☃.net/☃?☃#☃');
 ok $url->is_abs,   'is absolute';
 is $url->scheme,   'http', 'right scheme';
 is $url->userinfo, '☃:☃', 'right userinfo';
 is $url->host,     '☃.net', 'right host';
 is $url->ihost,    'xn--n3h.net', 'right internationalized host';
-is $url->path,     '/', 'right path';
-is "$url", 'http://%E2%98%83:%E2%98%83@xn--n3h.net/', 'right format';
+is $url->path,     '/%E2%98%83', 'right path';
+is $url->query,    '%E2%98%83', 'right query';
+is $url->fragment, '☃', 'right fragment';
+is "$url",
+  'http://%E2%98%83:%E2%98%83@xn--n3h.net/%E2%98%83?%E2%98%83#%E2%98%83',
+  'right format';
 
 # IRI/IDNA
 $url = Mojo::URL->new('http://☃.net/♥/?q=♥☃');
@@ -390,11 +394,12 @@ $url = Mojo::URL->new('http://foo.com/');
 is $url->to_abs, 'http://foo.com/', 'right absolute version';
 
 # "0"
-$url = Mojo::URL->new('http://0@foo.com');
+$url = Mojo::URL->new('http://0@foo.com#0');
 is $url->scheme,   'http',    'right scheme';
 is $url->userinfo, '0',       'right userinfo';
 is $url->host,     'foo.com', 'right host';
-is "$url", 'http://0@foo.com', 'right format';
+is $url->fragment, '0',       'right fragment';
+is "$url", 'http://0@foo.com#0', 'right format';
 
 # Empty path elements
 $url = Mojo::URL->new('http://example.com/foo//bar/23/');