+CGI argument 'Wabs' to produce absolute HREFs/SRCs.
authorshort <>
Wed, 19 Nov 2003 14:49:16 +0000 (14:49 +0000)
committershort <>
Wed, 19 Nov 2003 14:49:16 +0000 (14:49 +0000)
Web.pm

diff --git a/Web.pm b/Web.pm
index 8073616..1292afc 100644 (file)
--- a/Web.pm
+++ b/Web.pm
@@ -182,6 +182,17 @@ sub top_dir (;$)
 my($in)=@_;
 
        if (my $uri=$ENV{"REQUEST_URI"}) {
+               if ($W->{"args"}{"Wabs"}) {
+                       if ($in=~m#^/#) {
+                               $in=~s#^/*##;
+                               }
+                       else {
+                               $in=$ENV{"REQUEST_URI"}."/".$in;
+                               $in=~tr#/#/#s;
+                               1 while $in=~s#/(?:[^/]+)/\Q..\E/#/#g
+                               }
+                       return "http://".&{$W->{"web_hostname_sub"}}()."/".(defined $in ? $in : "");
+                       }
                $uri.="Index" if $uri=~m#/$#;
                if (defined $in) {
                        my($inpath,$inquery)=split /[?]/,$in,2;