Fixed some (Linux kernel?) compatibility problem of flock(1) of a directory.

[MyWeb.git] / Web.pm

diff --git a/Web.pm b/Web.pm
index 5bc71e0..ffe48c5 100644 (file)
--- a/Web.pm
+++ b/Web.pm
@@ -570,7 +570,7 @@ my($in)=@_;
 }
 
 # $args{"uri_as_in"}=1 to permit passing URI objects as: $in
-# $args{"abs"}=1;
+# $args{"abs"}=0 || 1; # overrides: $W->{"args"}{"Wabs"}
 sub path_web($%)
 {
 my($in,%args)=@_;
@@ -589,7 +589,9 @@ my($in,%args)=@_;
                                %{$uri->query_form_hash()},
                                });
                }
-       return $uri->abs(unparsed_uri()) if $W->{"args"}{"Wabs"} || $args{"abs"};
+       my $abs;
+       do { $abs=$_ if defined; } for $W->{"args"}{"Wabs"},$args{"abs"};
+       return $uri->abs(unparsed_uri()) if $abs;
        return $uri->rel(unparsed_uri());
 }
 
@@ -815,7 +817,7 @@ my($in,$contents,%args)=@_;
        if (!defined $contents) {
                $contents=$in;
                $contents=File::Basename::basename($contents) if $args{"basename"};
-               $contents=~s/^mailto:([-.\w]+@[-.\w]+)$/$1/;
+               $contents=~s/^mailto:([-.\w]+(?:@|\Q(at)\E)[-.\w]+)$/$1/;
                $contents=escapeHTML($contents);
                }
        $contents=~s#<a\b[^>]*>##gi;
@@ -829,8 +831,12 @@ my($in,$contents,%args)=@_;
        $r.='"';
        do { $r.=" $_" if $_; } for ($args{"attr"});
        $r.='>'.$contents.'</a>';
-       if ($args{"size"} && uri_is_local($in) && ($args{"size"}>=2 || $in=~/[.](?:gz|Z|rpm|zip|deb|lha)/)) {   # Downloadable?
-               my $path_abs_disk=path_abs_disk $in,%args;
+       my $size_in=$in;
+       do { $size_in=$_ if $_ && !/^\d+$/; } for $args{"size"};
+       if ($args{"size"} && uri_is_local($size_in)
+                       && (($args{"size"} && $args{"size"}=~/^\d+$/ && $args{"size"}>=2)
+                                       || $size_in=~/[.](?:gz|Z|rpm|zip|deb|lha)/)) {  # Downloadable?
+               my $path_abs_disk=path_abs_disk $size_in,%args;
                cluck "File not readable: $path_abs_disk" if !-r $path_abs_disk;
                $r.='&nbsp;('.size_display((stat($path_abs_disk))[7]).')';
                }
@@ -934,7 +940,9 @@ my($cmd)=@_;
        # FIXME: &alarm, --timeout is now infinite.
        # FIXME: Try to remove bash(1).
        # FIXME: Use: @PATH_FLOCK@
-       my @argv=('flock',dir_top_abs_disk(),'bash','-c',$cmd.' >&2');
+       # Do not: dir_top_abs_disk(),
+       # to prevent: flock: cannot open lock file /home/lace/www/www.jankratochvil.net: Is a directory
+       my @argv=('flock',dir_top_abs_disk()."/WebConfig.pm",'bash','-c',$cmd.' >&2');
        print STDERR join(" ","SPAWN:",@argv)."\n";
        system @argv;
 }