+&text_cc: Country-dependent static text chooser.
authorshort <>
Thu, 15 Dec 2005 09:45:50 +0000 (09:45 +0000)
committershort <>
Thu, 15 Dec 2005 09:45:50 +0000 (09:45 +0000)
Web.pm

diff --git a/Web.pm b/Web.pm
index 3ef46cf..d84cadc 100644 (file)
--- a/Web.pm
+++ b/Web.pm
@@ -31,7 +31,7 @@ our @EXPORT=qw(
                &Wrequire &Wuse
                &path_web &path_abs_disk
                &uri_escaped
                &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
                &vskip
                &img &centerimg &rightimg &leftimg
                $W
@@ -891,6 +891,14 @@ sub remote_ip ()
        return $r;
 }
 
        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($$;%)
 # $url={"JP"=>"http://specific",...};
 # $url={""=>"http://default",...};
 sub a_href_cc($$;%)
@@ -899,14 +907,20 @@ 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));
 
        # 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=$map{_cc()};
        return $r if $r;
        return $contents;
 }
 
        return $r if $r;
        return $contents;
 }
 
+# $tree={"JP"=>"specific",...};
+# $tree={""=>"default",...};
+sub text_cc($)
+{
+my($tree)=@_;
+
+       return $tree->{_cc()};
+}
+
 sub make ($)
 {
 my($cmd)=@_;
 sub make ($)
 {
 my($cmd)=@_;