X-Git-Url: http://git.jankratochvil.net/?a=blobdiff_plain;f=Web.pm;h=2a93ce16fccabf37a24c5b251b6247855bc32ee1;hb=8c80926a8d815836ff9bc26740751cd1780fd045;hp=13e397c17a74509b25da4b339129063abd519194;hpb=4b4554f24cc005a4c1f97e8b4f73693702284731;p=MyWeb.git diff --git a/Web.pm b/Web.pm index 13e397c..2a93ce1 100644 --- a/Web.pm +++ b/Web.pm @@ -27,7 +27,7 @@ use Exporter; sub Wrequire ($); sub Wuse ($@); our $W; -our @EXPORT=qw(&Wrequire &Wuse &a_href &a_href_cz &vskip &img $W &top_dir); +our @EXPORT=qw(&Wrequire &Wuse &a_href &a_href_cz &vskip &img $W &top_dir &top_dir_disk); our @ISA=qw(Exporter); BEGIN @@ -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"}); @@ -164,12 +164,41 @@ my($class,%args)=@_; return $W; } -sub top_dir () +sub top_dir_disk () { 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; +} + sub fatal (;$); sub args_check (%) @@ -177,13 +206,13 @@ sub args_check (%) my(%tmpl)=@_; while (my($name,$regex)=each(%tmpl)) { - my $name_html="Parametr ".CGI::escapeHTML($name).""; + my $name_html="Parameter ".CGI::escapeHTML($name).""; + $W->{"args"}{$name}="" if !defined $W->{"args"}{$name}; my $val=$W->{"args"}{$name}; + $val="" if !defined $val; fatal "$name_html ".CGI::escapeHTML($val)."" - ." does not match required regex ".CGI::escapeHTML($regex)."" - if defined $val && $val!~/$regex/; - fatal "$name_html is required" - if !defined $val; + ." does not match required regex ".CGI::escapeHTML($regex)." " + if $regex ne "" && $val!~/$regex/; } } @@ -216,7 +245,7 @@ sub footer (;$) print "