X-Git-Url: http://git.jankratochvil.net/?p=MyWeb.git;a=blobdiff_plain;f=Web.pm;h=e41a314f3d09e47f2d524abca9ba690d5df97d32;hp=885620df5ae3b0ee530d2e735e54a8f1f9c784c1;hb=refs%2Fheads%2Fmodperl;hpb=6a26dcbc13f70543517060e58e0eaced7847a535 diff --git a/Web.pm b/Web.pm index 885620d..e41a314 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 &top_dir_disk); +our @EXPORT=qw(&Wrequire &Wuse &a_href &a_href_cz &vskip &img ¢erimg &rightimg $W &top_dir &top_dir_disk); our @ISA=qw(Exporter); BEGIN @@ -134,7 +134,7 @@ my($class,%args)=@_; { delete $W->{"have_ent"}; } if ($W->{"detect_ent"} && !defined $W->{"have_ent"} && $W->{"r"}->method() eq "GET") { $W->{"head"}.='{"r"}->hostname()."/".($W->{"r"}->uri()=~m#^/*(.*)$#)[0] + .CGI::escapeHTML("http://".&{$W->{"web_hostname_sub"}}()."/".($W->{"r"}->uri()=~m#^/*(.*)$#)[0] ."?".($W->{"QUERY_STRING"} || "detect_ent_glue=1").'&have_ent=detect') .'" />'."\n"; } @@ -142,8 +142,13 @@ my($class,%args)=@_; $W->{"r"}->args($W->{"QUERY_STRING"}); $ENV{"QUERY_STRING"}=$W->{"QUERY_STRING"}; # Do not: $W->{"r"}->args() - # as it parses only QUERY_STRING (not POST data). + # as it parses only QUERY_STRING (not POST data). $W->{"args"}={ CGI->new()->Vars() }; + for (keys(%{$W->{"args"}})) { + my @vals=split /\x00/,$W->{"args"}{$_}; + next if @vals<=1; + $W->{"args"}{$_}=[@vals]; + } do { $W->{$_}=$ENV{"HTTP_ACCEPT"} if !defined $W->{$_}; } for ("accept"); do { $W->{$_}=$ENV{"HTTP_USER_AGENT"} if !defined $W->{$_}; } for ("user_agent"); @@ -156,7 +161,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 +175,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 (;$); @@ -191,11 +213,16 @@ my(%tmpl)=@_; while (my($name,$regex)=each(%tmpl)) { 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 $regex ne "" && $val!~/$regex/; + $W->{"args"}{$name}=[ $W->{"args"}{$name} ] if !ref $W->{"args"}{$name} && ref $regex; + fatal "$name_html passed as multivar although singlevar expected" + if ref $W->{"args"}{$name} && !ref $regex; + $regex=${$regex}[0] if ref $regex; + for my $val (!ref $W->{"args"}{$name} ? $W->{"args"}{$name} : @{$W->{"args"}{$name}}) { + $val="" if !defined $val; + fatal "$name_html ".CGI::escapeHTML($val)."" + ." does not match the required regex ".CGI::escapeHTML($regex)." " + if $regex ne "" && $val!~/$regex/; + } } } @@ -212,7 +239,8 @@ my($msg)=@_; $msg="UNKNOWN" if !$msg; -# heading(false/*title*/,false/*indexme*/); # notitle is always safe, don't index the error message + $W->{"indexme"}=0; # For the case no heading was sent yet. + My::Web->heading(); print "\n".vskip("3ex")."
You can report this problem's details to" ." ".a_href("mailto:".$W->{"admin_mail"},"admin of this website").".
\n"; @@ -225,10 +253,14 @@ sub footer (;$) print vskip if $W->{"footer_delimit"}; + if ($W->{"heading"}) { + do { &{$_}() if $_; } for ($W->{"footing_delimit"}); + } + print "