X-Git-Url: http://git.jankratochvil.net/?p=MyWeb.git;a=blobdiff_plain;f=Web.pm;h=ffe48c55839b6a16435bc47bc8939d61bb58426d;hp=3ef46cf8884f1d5baa77d5698106d900ae20e606;hb=cd3a6f6c4bc2eb6d904f38b814be21c46d9e67b0;hpb=2cef9aaaf5f11580cc136731902d5947a4d48d48

diff --git a/Web.pm b/Web.pm
index 3ef46cf..ffe48c5 100644
--- a/Web.pm
+++ b/Web.pm
@@ -31,7 +31,7 @@ our @EXPORT=qw(
 		&Wrequire &Wuse
 		&path_web &path_abs_disk
 		&uri_escaped
-		&a_href &a_href_cc
+		&a_href &a_href_cc &text_cc
 		&vskip
 		&img &centerimg &rightimg &leftimg
 		$W
@@ -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]).')';
 		}
@@ -891,6 +897,14 @@ sub remote_ip ()
 	return $r;
 }
 
+sub _cc()
+{
+	my $r;
+	$r||=Geo::IP->new()->country_code_by_addr(remote_ip()) if $have_Geo_IP;
+	$r||="";
+	return $r;
+}
+
 # $url={"JP"=>"http://specific",...};
 # $url={""=>"http://default",...};
 sub a_href_cc($$;%)
@@ -899,14 +913,26 @@ my($url,$contents,%args)=@_;
 
 	# 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 $cc;
-	$cc||=Geo::IP->new()->country_code_by_addr(remote_ip()) if $have_Geo_IP;
-	$cc||="";
-	my $r=$map{$cc};
+	my $r;
+	$r||=$map{_cc()};
+	$r||=$map{""};
 	return $r if $r;
 	return $contents;
 }
 
+# $tree={"JP"=>"specific",...};
+# $tree={""=>"default",...};
+sub text_cc($)
+{
+my($tree)=@_;
+
+	cluck if !$tree->{""};
+	my $r;
+	$r||=$tree->{_cc()};
+	$r||=$tree->{""};
+	return $r;
+}
+
 sub make ($)
 {
 my($cmd)=@_;
@@ -914,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;
 }