From: short <>
Date: Sun, 12 Oct 2003 05:55:43 +0000 (+0000)
Subject: URL relativization.
X-Git-Url: http://git.jankratochvil.net/?p=MyWeb.git;a=commitdiff_plain;h=aba10a49c1e0d87b131388fe7b7342bf87a6a539
URL relativization.
---
diff --git a/Project.pm b/Project.pm
index 2226a64..13a8d95 100644
--- a/Project.pm
+++ b/Project.pm
@@ -113,7 +113,7 @@ my($class,$ListItem)=@_;
["Download CVS snapshot" ,
$W->{"project_viewcvs"}.$val."/".File::Basename::basename($val).".tar.gz?tarball=1"
.(!$branch ? "" : '&only_with_tag='.$branch)],
- ["CVS ChangeLog" ,top_dir()."/project/ChangeLog.txt.pl?cvs=$val"])));
+ ["CVS ChangeLog" ,"/project/ChangeLog.txt.pl?cvs=$val"])));
}},
{"key"=>"ownership","text"=>"Ownership"},
{"key"=>"sponsorship","text"=>"Sponsorship"},
@@ -247,10 +247,10 @@ my($class,$view_selected)=@_;
Project List of @{[ a_href 'http://www.jankratochvil.net/','Jan Kratochvil' ]}
- - @{[ &{$view}('Detailed' ,top_dir().'/project/','Detailed project listing per platform') ]}
- - @{[ &{$view}('BriefPlatform',top_dir().'/project/List.html.pl?platform=platform',
+
- @{[ &{$view}('Detailed' ,'/project/','Detailed project listing per platform') ]}
+ - @{[ &{$view}('BriefPlatform','/project/List.html.pl?platform=platform',
'Brief project listing per platform') ]}
- - @{[ &{$view}('BriefUnified' ,top_dir().'/project/List.html.pl',
+
- @{[ &{$view}('BriefUnified' ,'/project/List.html.pl',
'Unified brief project listing') ]}
@{[ vskip "1ex" ]}
@@ -273,7 +273,7 @@ my($class,$platform_selected)=@_;
my $platform_name=shift @platforms;
my $chosen=($platform_selected && $platform_selected eq $platform_sym);
$r.='';
- $r.=a_href((!$platform_selected ? "" : top_dir()."/project/").'#'.$platform_sym,$platform_name,
+ $r.=a_href((!$platform_selected ? "" : "/project/").'#'.$platform_sym,$platform_name,
"attr"=>($chosen
? 'style="text-decoration: underline; font-weight: bold;"'
: 'style="text-decoration: inherit; /* revoke underline */"'));
diff --git a/Web.pm b/Web.pm
index 885620d..35bdb38 100644
--- a/Web.pm
+++ b/Web.pm
@@ -156,7 +156,7 @@ my($class,%args)=@_;
$W->{"have_js"}=($W->{"args"}{"have_js"} ? 1 : 0);
if ($W->{"detect_js"} && !$W->{"have_js"}) {
- $W->{"head"}.=''."\n";
+ $W->{"head"}.=''."\n";
}
do { args_check(%$_) if $_; } for ($W->{"args_check"});
@@ -170,16 +170,33 @@ sub top_dir_disk ()
return $INC[0]; # fallback
}
-sub top_dir ()
+sub top_dir (;$)
{
+my($in)=@_;
+
if (my $uri=$ENV{"REQUEST_URI"}) {
$uri.="Index" if $uri=~m#/$#;
+ if (defined $in) {
+ my($inpath,$inquery)=split /[?]/,$in,2;
+ $inpath=~tr///cs;
+ $uri=~tr///cs;
+ for (;;) {
+ my($in1 ,$in2 )=($in =~m#^(/[^/]+)(/.*)$#);
+ my($uri1,$uri2)=($uri=~m#^(/[^/]+)(/.*)$#);
+ last if !defined $in1 || !defined $uri1 || $in1 ne $uri1;
+ $in=$in2;
+ $uri=$uri2;
+ }
+ }
$uri=~s#^/*##;
$uri=~s#[^/]+#..#g;
$uri=File::Basename::dirname($uri);
- return $uri;
+ my $r=$uri.(defined $in ? $in : "");
+# 1 while $r=~s#^[.]/##;
+# $r="./$r" if $r=~m#^(?:?.*)$#; # empty pathname?
+ return $r;
}
- return top_dir_disk();
+ return top_dir_disk().$in;
}
sub fatal (;$);
@@ -228,7 +245,7 @@ sub footer (;$)
print " \n" if $W->{"footer"};
if ($W->{"footer_mailme"}) {
- print ' |