X-Git-Url: http://git.jankratochvil.net/?p=MyWeb.git;a=blobdiff_plain;f=Web.pm;h=ffe48c55839b6a16435bc47bc8939d61bb58426d;hp=d31ef5ecc90d8056228b27155e195285f3971310;hb=refs%2Fheads%2Fmaster;hpb=077b23f760ba965c7bba3c71d429badacdf68538 diff --git a/Web.pm b/Web.pm index d31ef5e..ffe48c5 100644 --- 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#]*>##gi; @@ -829,8 +831,12 @@ my($in,$contents,%args)=@_; $r.='"'; do { $r.=" $_" if $_; } for ($args{"attr"}); $r.='>'.$contents.''; - 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.=' ('.size_display((stat($path_abs_disk))[7]).')'; } @@ -905,13 +911,13 @@ sub a_href_cc($$;%) { my($url,$contents,%args)=@_; - cluck if !$url->{""}; # A bit ineffective but we must process all the possibilities to get stable 'headers_in' hits! my %map=map(($_=>a_href($url->{$_},$contents,%args)),keys(%$url)); my $r; $r||=$map{_cc()}; $r||=$map{""}; - return $r; + return $r if $r; + return $contents; } # $tree={"JP"=>"specific",...}; @@ -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; }