From 7a1abd7bc09d5e5ad21ac56271d84b16f7b3bc84 Mon Sep 17 00:00:00 2001
From: Colin Kuskie <colink@perldreamer.com>
Date: Fri, 30 Jul 2010 16:25:58 -0700
Subject: [PATCH] Alter URL permutations to handle the cases when there is a
 leading / in the URL.  Add the dispatch subroutine.

---
 lib/WebGUI/Content/Asset.pm | 34 ++++++++++++++++++++++++++--------
 1 file changed, 26 insertions(+), 8 deletions(-)

diff --git a/lib/WebGUI/Content/Asset.pm b/lib/WebGUI/Content/Asset.pm
index 6a227714b..16b53328c 100644
--- a/lib/WebGUI/Content/Asset.pm
+++ b/lib/WebGUI/Content/Asset.pm
@@ -46,14 +46,33 @@ These subroutines are available from this package:
 
 =head2 dispatch ( $session, $assetUrl )
 
-Returns the output from an asset.
+Attempts to return the output from an asset, based on its url.  All permutations of the
+URL are tried, to find an asset that matches.
+
+=head3 $session
+
+A WebGUI::Session object.
+
+=head4 $assetUrl
+
+The URL for this request.
 
 =cut
 
 sub dispatch {
-    my $session = shift;
-	my $assetUrl = shift;
-    return;
+    my $session      = shift;
+	my $assetUrl     = shift;
+    return undef unless $assetUrl;
+    my $permutations = getUrlPermutations($assetUrl);
+    foreach my $url (@{ $permutations }) {
+        if (my $asset = getAsset($session, $url)) {
+            my $fragment = $assetUrl;
+            $fragment =~ s/$url//;
+            my $output = $asset->dispatch($fragment);
+            return $output if defined $output;
+        }
+    }
+    return undef;
 }
 
 #-------------------------------------------------------------------
@@ -104,15 +123,14 @@ sub getUrlPermutations {
     my $url          = shift;
     my @permutations = ();
     return \@permutations if !$url;
-    push @permutations, $url;
     if ($url =~ /\.\w+$/) {
-        $url =~ s/\.\w+$//;
         push @permutations, $url;
+        $url =~ s/\.\w+$//;
     }
     my $uri       = URI->new($url);
     my @fragments = $uri->path_segments();
-    pop @fragments;
-    while (@fragments > 1) {
+    FRAG: while (@fragments) {
+        last FRAG if $fragments[-1] eq '';
         push @permutations, join "/", @fragments;
         pop @fragments;
     }