menu

[MyWeb.git] / Web.pm

diff --git a/Web.pm b/Web.pm
index 13e397c..885620d 100644 (file)
--- 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
@@ -164,12 +164,24 @@ 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 ()
+{
+       if (my $uri=$ENV{"REQUEST_URI"}) {
+               $uri.="Index" if $uri=~m#/$#;
+               $uri=~s#^/*##;
+               $uri=~s#[^/]+#..#g;
+               $uri=File::Basename::dirname($uri);
+               return $uri;
+               }
+       return top_dir_disk();
+}
+
 sub fatal (;$);
 
 sub args_check (%)
@@ -177,13 +189,13 @@ sub args_check (%)
 my(%tmpl)=@_;
 
        while (my($name,$regex)=each(%tmpl)) {
-               my $name_html="Parametr <span class=\"quote\">".CGI::escapeHTML($name)."</span>";
+               my $name_html="Parameter <span class=\"quote\">".CGI::escapeHTML($name)."</span>";
+               $W->{"args"}{$name}="" if !defined $W->{"args"}{$name};
                my $val=$W->{"args"}{$name};
+               $val="" if !defined $val;
                fatal "$name_html <span class=\"quote\">".CGI::escapeHTML($val)."</span>"
-                                               ." does not match required regex <span class=\"quote\">".CGI::escapeHTML($regex)."</span>"
-                               if defined $val && $val!~/$regex/;
-               fatal "$name_html is required"
-                               if !defined $val;
+                                               ." does not match required regex <span class=\"quote\">".CGI::escapeHTML($regex)."</span> "
+                               if $regex ne "" && $val!~/$regex/;
                }
 }