&a_href_cc: Stabilize 'headers_in' hits at the expense of CPU burden.

[MyWeb.git] / Web.pm

diff --git a/Web.pm b/Web.pm
index 33cd6d9..6b76695 100644 (file)
--- a/Web.pm
+++ b/Web.pm
@@ -272,7 +272,7 @@ my($class,%args)=@_;
 
        $W->{"have_js"}=($W->{"args"}{"have_js"} ? 1 : 0);
        if ($W->{"detect_js"} && !$W->{"have_js"}) {
-               $W->{"head"}.='<script type="text/javascript" src="'.uri_escaped(path_web('/have_js.pm')).'"></script>'."\n";
+               $W->{"head"}.='<script type="text/javascript" src="'.uri_escaped(path_web('/My/HaveJS.pm')).'"></script>'."\n";
                }
 
        do { _args_check(%$_) if $_; } for ($W->{"args_check"});
@@ -315,24 +315,6 @@ my($text)=@_;
        return CGI::escapeHTML($text);
 }
 
-# local *FH;
-# tie *FH,ref($W),$W;
-sub TIEHANDLE($)
-{
-my($class,$W)=@_;
-
-       my $self={};
-       $self->{"W"}=$W or confess "Missing W";
-       return bless $self,$class;
-}
-
-sub WRITE
-{
-my($self,$scalar,$length,$offset)=@_;
-
-       Wprint substr($scalar,0,$length);
-}
-
 # /home/user/www/webdir
 sub dir_top_abs_disk()
 {
@@ -596,7 +578,7 @@ my($uri)=@_;
        return $uri    if defined $W->{"have_ent"} && !$W->{"have_ent"};        # non-ent client
        return $urient if $W->{"have_ent"};     # ent client
        # Unknown client, &escapeHTML should not be needed here:
-       return escapeHTML(path_web('/Redirect.pm?location='.uri_escape($uri->abs(unparsed_uri()))));
+       return escapeHTML(path_web('/My/Redirect.pm?location='.uri_escape($uri->abs(unparsed_uri()))));
 }
 
 our $a_href_inhibited;
@@ -688,12 +670,14 @@ sub a_href_cc($$;%)
 {
 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||="";
-       $url=$url->{$cc};
-       return $contents if !$url;
-       return a_href $url,$contents,%args;
+       my $r=$map{$cc};
+       return $r if $r;
+       return $contents;
 }
 
 sub make ($)