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' ]}

@{[ 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 '
]*>##gi; $contents=~s###gi; + $url=top_dir($url) if url_is_local $url && $url=~m#^/#; + my $r=''; if ($args{"size"} && url_is_local($url) && $url=~/[.](?:gz|Z|rpm|zip|deb|lha)/) { # Downloadable? + $url=top_dir_disk().$url if $url=~m#^/#; if (!-r $url) { cluck "File not readable: $url"; } else { @@ -419,13 +439,26 @@ sub img_src ($) { my($file_base)=@_; - return $file_base if !url_is_local($file_base) + if (!url_is_local($file_base) # Known image extension? - || $file_base=~m#$img_variants_re#o; + || $file_base=~m#$img_variants_re#o) { + return $file_base if !wantarray(); + return ($file_base,$file_base); + } + + my $file_base_disk; + my $file_base_uri; + if ($file_base!~m#^/#) { + $file_base_disk=$file_base_uri=$file_base; + } + else { + $file_base_disk=top_dir_disk().$file_base; + $file_base_uri=top_dir($file_base); + } my @nego_variants; for my $var (@img_variants) { - my $file=$file_base.".".$var->{"id"}; + my $file=$file_base_disk.".".$var->{"id"}; # TODO: Somehow quickly check dependencies? system 'make >&2 -s --no-print-directory' .' -C '."'".File::Basename::dirname($file)."' '".File::Basename::basename($file)."'" @@ -439,18 +472,20 @@ my($file_base)=@_; # but should we provide somehow either 'HTTP::Headers' or 'HTTP::Request' ? my $ext=HTTP::Negotiate::choose(\@nego_variants); $ext||=$img_variants[0]->{"id"}; # &HTTP::Negotiate::choose failed? - return $file_base.".".$ext; + + return $file_base_uri.".".$ext if !wantarray(); + return ($file_base_uri.".".$ext,$file_base_disk.".".$ext); } sub img ($$;$) { my($file_base,$alt,$attrs)=@_; - my $file=img_src $file_base; - my($width,$height)=Image::Size::imgsize($file); + my($file_uri,$file_disk)=img_src $file_base; + my($width,$height)=Image::Size::imgsize($file_disk); $alt=~s/<[^>]*>//g; $alt=CGI::escapeHTML($alt); - return "\"$alt\""; }