fixed clone bugs in Mojo::URL

mojolicious · Nov 25, 2012 · 84b1d53 · 84b1d53
1 parent c9f0b6c
commit 84b1d53
Show file tree

Hide file tree

Showing 3 changed files with 20 additions and 5 deletions.
diff --git a/Changes b/Changes
@@ -1,6 +1,7 @@
 
 3.62  2012-11-26
   - Improved tests.
+  - Fixed clone bugs in Mojo::URL.
 
 3.61  2012-11-25
   - Added protocol method to Mojo::URL.

diff --git a/lib/Mojo/URL.pm b/lib/Mojo/URL.pm
@@ -136,12 +136,14 @@ sub query {
 
 sub to_abs {
   my $self = shift;
-  my $base = shift || $self->base->clone;
 
-  # Scheme
+  # Already absolute
   my $abs = $self->clone;
   return $abs if $abs->is_abs;
-  $abs->scheme($base->scheme);
+
+  # Scheme
+  my $base = shift || $abs->base;
+  $abs->base($base)->scheme($base->scheme);
 
   # Authority
   return $abs if $abs->authority;
@@ -170,10 +172,14 @@ sub to_abs {
 
 sub to_rel {
   my $self = shift;
-  my $base = shift || $self->base->clone;
+
+  # Already relative
+  my $rel = $self->clone;
+  return $rel unless $rel->is_abs;
 
   # Scheme and authority
-  my $rel = $self->clone->base($base)->scheme(undef);
+  my $base = shift || $rel->base;
+  $rel->base($base)->scheme(undef);
   $rel->userinfo(undef)->host(undef)->port(undef) if $base->authority;
 
   # Path

diff --git a/t/mojo/url.t b/t/mojo/url.t
@@ -202,6 +202,14 @@ is $rel, 'c/d/index.html', 'right relative version';
 is $rel->to_abs, 'http://kraih.com/a/b/c/d/index.html',
   'right absolute version';
 is $rel->to_abs->to_rel, 'c/d/index.html', 'right relative version';
+$url = Mojo::URL->new('/foo');
+ok !$url->base->is_abs, 'right base';
+ok $url->to_abs(Mojo::URL->new('http://kraih.com'))->base->is_abs,
+  'right base';
+$url = Mojo::URL->new('http://kraih.com/foo');
+ok !$url->base->is_abs, 'right base';
+ok $url->to_rel(Mojo::URL->new('http://kraih.com'))->base->is_abs,
+  'right base';
 
 # Relative path
 $url = Mojo::URL->new('http://kraih.com/foo/?foo=bar#23');