[dw-free] create_url needs fragment after args

[fu]

[commit: http://hg.dwscoalition.org/dw-free/rev/03734ee4a739]

http://bugs.dwscoalition.org/show_bug.cgi?id=3248

Fragment goes at the end of the URL.

Patch by exor674.

Files modified:

• cgi-bin/weblib.pl
• t/create-url.t

--------------------------------------------------------------------------------
diff -r 037560b72db0 -r 03734ee4a739 cgi-bin/weblib.pl
--- a/cgi-bin/weblib.pl	Wed Nov 24 19:24:30 2010 +0800
+++ b/cgi-bin/weblib.pl	Wed Nov 24 19:31:51 2010 +0800
@@ -999,7 +999,6 @@ sub create_url {
     $opts{ssl} = $LJ::IS_SSL unless $opts{host} || exists $opts{ssl};
 
     my $url = ( $opts{ssl} ? "https" : "http" ) . "://$host$path";
-    $url .= "#" . $opts{fragment} if $opts{fragment};
 
     my $orig_args = $opts{cur_args} || DW::Request->get->get_args;
 
@@ -1023,6 +1022,7 @@ sub create_url {
     my $args = encode_url_string( \%out_args );
 
     $url .= "?$args" if $args;
+    $url .= "#" . $opts{fragment} if $opts{fragment};
 
     return $url;
 }
diff -r 037560b72db0 -r 03734ee4a739 t/create-url.t
--- a/t/create-url.t	Wed Nov 24 19:24:30 2010 +0800
+++ b/t/create-url.t	Wed Nov 24 19:31:51 2010 +0800
@@ -1,6 +1,6 @@
 # -*-perl-*-
 use strict;
-use Test::More tests => 5 * 14; # replace last number with the number of check_req calls
+use Test::More tests => 5 * 15; # replace last number with the number of check_req calls
 use lib "$ENV{LJHOME}/cgi-bin";
 
 require 'ljlib.pl';
@@ -27,6 +27,22 @@ check_req(
         keep_args => [ 'bar' ],
     },
     { ssl => 0, host => "www.example.com", uri=>"/", },
+    {
+        foo => "bar",
+        bar => "baz",
+    },
+);
+
+check_req(
+    "http://www.example.com/?bar=baz",
+    undef, {
+        args => {
+            foo => 'bar',
+        },
+        keep_args => [ 'bar' ],
+        fragment => 'yay',
+    },
+    { ssl => 0, host => "www.example.com", uri=>"/", fragment=>"yay" },
     {
         foo => "bar",
         bar => "baz",
@@ -186,7 +202,7 @@ sub validate_req {
 sub validate_req {
     my ( $url, $eopts, $expected ) = @_;
 
-    my ( $https, $host, $blah, $fragment, $blah2 ) = $url =~ m!^(http(?:s)?)://(.+?)/(.*?)((?:#.+?)?)((?:\?.+?)?)$!;
+    my ( $https, $host, $blah, $blah2, $fragment ) = $url =~ m!^(http(?:s)?)://(.+?)/(.*?)((?:\?.+?)?)((?:#.+?)?)$!;
     my $ssl = ( $https eq 'https' ) ? 1 : 0;
     my $rq = HTTP::Request->new(GET => $url);
 
@@ -218,4 +234,4 @@ sub validate_req {
     $fail .= " -- missing: " . join(",", keys %$expected) if ( %$expected );
 
     ok( ! $fail, "args mismatch: $fail");
-}
\ No newline at end of file
+}
--------------------------------------------------------------------------------