-my($file)=@_;
-
- $file=~s#/#::#g;
- $file=~s/[.]pm$//;
- my $class=$file;
- $file=~s#::#/#g;
- $file.=".pm";
- my $aref=($W->{"packages_used"}{$Apache::Registry::curstash}||=[]);
- push @$aref,$class
- if !{ map(($_=>1),@$aref) }->{$class}; # Prevent duplicated entries.
- CORE::require $file;
- 1; # Otherwise 'require' would already file above.
+ do { return $_ if $_; } for ($W->{"top_dir"});
+ return $INC[0]; # fallback
+}
+
+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);
+ my $r=$uri.(defined $in ? $in : "");
+# 1 while $r=~s#^[.]/##;
+# $r="./$r" if $r=~m#^(?:?.*)$#; # empty pathname?
+ return $r;
+ }
+ return top_dir_disk().$in;