From: short <>
Date: Wed, 19 Nov 2003 14:49:16 +0000 (+0000)
Subject: +CGI argument 'Wabs' to produce absolute HREFs/SRCs.
X-Git-Tag: bp_apache2~7
X-Git-Url: http://git.jankratochvil.net/?p=MyWeb.git;a=commitdiff_plain;h=b13343a93caa63ef5bc5d01a2f34c6508edcfa25

+CGI argument 'Wabs' to produce absolute HREFs/SRCs.
---

diff --git a/Web.pm b/Web.pm
index 8073616..1292afc 100644
--- 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;