[Rt-commit] r13840 - in rt/3.8/trunk: sbin

[sartak at bestpractical.com]

Author: sartak
Date: Mon Jul  7 15:22:30 2008
New Revision: 13840

Modified:
   rt/3.8/trunk/   (props changed)
   rt/3.8/trunk/sbin/rt-email-dashboards.in

Log:
 r63790 at onn:  sartak | 2008-07-07 15:21:31 -0400
 email-dashboards: Instead of relying on WebURL, pick apart the URI the right way


Modified: rt/3.8/trunk/sbin/rt-email-dashboards.in
==============================================================================
--- rt/3.8/trunk/sbin/rt-email-dashboards.in	(original)
+++ rt/3.8/trunk/sbin/rt-email-dashboards.in	Mon Jul  7 15:22:30 2008
@@ -399,48 +399,47 @@
 }
 
 sub get_resource {
-    my $uri = shift;
+    my $uri = URI->new(shift);
     my ($content, $filename, $mimetype, $encoding);
 
-    my $original_uri = $uri;
-    verbose "Getting resource [_1]", $original_uri;
+    verbose "Getting resource [_1]", $uri;
 
-    # strip out WebURL, mason doesn't want it
-    my $weburl = RT->Config->Get('WebURL');
-    $uri =~ s/^\Q$weburl//;
+    # strip out the equivalent of WebURL, so we start at the correct /
+    my $path = $uri->path;
+    my $webpath = RT->Config->Get('WebPath');
+    $path =~ s/^\Q$webpath//;
 
     # add a leading / if needed
-    $uri = "/$uri"
-        unless $uri =~ m{^/};
+    $path = "/$path"
+        unless $path =~ m{^/};
 
+    # grab the query arguments
     my %args;
-    if ($uri =~ s/\?(.*)//) {
-        for (split /&/, ($1||'')) {
-            my ($k, $v) = /^(.*?)=(.*)$/
-                or die "Unable to parse query parameter '$_'";
-
-            for ($k, $v) { s/%(..)/chr hex $1/ge }
-
-            # no value yet, simple key=value
-            if (!exists $args{$k}) {
-                $args{$k} = $v;
-            }
-            # already have key=value, need to upgrade it to key=[value1, value2]
-            elsif (!ref($args{$k})) {
-                $args{$k} = [$args{$k}, $v];
-            }
-            # already key=[value1, value2], just add the new value
-            else {
-                push @{ $args{$k} }, $v;
-            }
+    for (split /&/, ($uri->query||'')) {
+        my ($k, $v) = /^(.*?)=(.*)$/
+            or die "Unable to parse query parameter '$_'";
+
+        for ($k, $v) { s/%(..)/chr hex $1/ge }
+
+        # no value yet, simple key=value
+        if (!exists $args{$k}) {
+            $args{$k} = $v;
+        }
+        # already have key=value, need to upgrade it to key=[value1, value2]
+        elsif (!ref($args{$k})) {
+            $args{$k} = [$args{$k}, $v];
+        }
+        # already key=[value1, value2], just add the new value
+        else {
+            push @{ $args{$k} }, $v;
         }
     }
 
-    debug "Running component '[_1]'", $uri;
-    $content = run_component($uri, %args);
+    debug "Running component '[_1]'", $path;
+    $content = run_component($path, %args);
 
-    $uri =~ s{^(.*/)(.*?)$}{$1};
-    $filename = $2;
+    # guess at the filename from the component name
+    $filename = $2 if $path =~ m{^.*/(.*?)$};
 
     # the rest of this was taken from Email::MIME::CreateHTML::Resolver::LWP
     ($mimetype, $encoding) = MIME::Types::by_suffix($filename);
@@ -458,7 +457,7 @@
     $encoding ||= 'base64';
 
     debug "Resource [_1]: length=[_2] filename='[_3]' mimetype='[_4]', encoding='[_5]'",
-        $original_uri,
+        $uri,
         length($content),
         $filename,
         $mimetype,