&Wrequire &Wuse
&path_web &path_abs_disk
&uri_escaped
- &a_href &a_href_cz
+ &a_href &a_href_cc
&vskip
&img ¢erimg &rightimg
$W
use Data::Dumper;
require Encode;
use Apache2::Filter;
+use Apache2::Connection;
+require MIME::Base64;
#our $W;
$W->{"headers_in"}=My::Hash::Merge->new(
$W->{"headers_in"},
My::Hash::Sub->new({
- "_get_remote_host"=>sub { return $W->{"r"}->get_remote_host(); },
+ "_remote_ip"=>sub { return $W->{"r"}->connection()->remote_ip(); },
}),
);
+ Wrequire 'My::Hash::Readonly';
$W->{"headers_in"}=My::Hash::Readonly->new($W->{"headers_in"});
if ($W->{"r"}->method() eq "GET" || $W->{"r"}->method() eq "HEAD") {
for (\$W->{"http_safe"}) {
- # Extend the current ETag system instead if you would need it:
- cluck "Explicitely NOT HTTP-Safe for method \"".$W->{"r"}->method()."\"?!?"
- if defined($$_) && !$$_;
+ # Do not: # Extend the current ETag system instead if you would need it:
+ # cluck "Explicitely NOT HTTP-Safe for method \"".$W->{"r"}->method()."\"?!?"
+ # if defined($$_) && !$$_;
+ # as sometimes it just does not make sense to cache it.
$$_=1 if !defined $$_;
}
}
$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"});
delete $args{"undef"};
cluck join(" ","Invalid arguments:",keys(%args)) if keys(%args);
return if !defined $text;
- cluck "utf-8 untested" if Encode::is_utf8($text);
+ # Do not: cluck "utf-8 untested" if Encode::is_utf8($text);
+ # as it is valid here.
$W->{"r"}->puts($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()
{
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;
# As 'Apache2::ForwardedFor' takes the first of $ENV{"HTTP_X_FORWARDED_FOR"}
# while the contents is '127.0.0.1, 213.220.195.171' if client has its own proxy.
# We must take the last item ourselves.
- my $r=$W->{"headers_in"}{"X-Forwarded-For"} || $W->{"headers_in"}{"_get_remote_host"};
- $r=~s/^.*,\s*//;
+ # Be VERY sure you always retrieve all the headers unconditionally to hit: My::Hash::RecordKeys
+ my $x_forwarded_for=$W->{"headers_in"}{"X-Forwarded-For"};
+ $x_forwarded_for=~s/^.*,\s*// if $x_forwarded_for;
+ my $remote_ip=$W->{"headers_in"}{"_remote_ip"};
+ my $r;
+ $r||=$x_forwarded_for;
+ $r||=$remote_ip;
return $r;
}
-sub is_cz ()
-{
- return 0 if !$have_Geo_IP;
- return "CZ" eq Geo::IP->new()->country_code_by_addr(remote_ip());
-}
-
-sub a_href_cz ($$;%)
+# $url={"JP"=>"http://specific",...};
+# $url={""=>"http://default",...};
+sub a_href_cc($$;%)
{
my($url,$contents,%args)=@_;
- return a_href $url,$contents,%args if is_cz();
+ # 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};
+ return $r if $r;
return $contents;
}
# Prepare 'headers_out' for the future reusal:
my %headers_out;
- $headers_out{"Content-MD5"}=$W->{"digest-md5"}->b64digest();
+ # Do not: $W->{"digest-md5"}->b64digest();
+ # as it will not provide the trailing filling '='s.
+ # RFC 1864 is not clear but the same provides them.
+ # FIXME: Should we somehow provide "\r\n" newlines for the text data? Which content is "text"?
+ # ',""' to avoid breaking the headers by its default "\n".
+ $headers_out{"Content-MD5"}=MIME::Base64::encode_base64($W->{"digest-md5"}->digest(),"");
# In fact we could also use MD5 for ETag as if we know ETag we also know MD5.
# But this way we do not need to calculate MD5 and we still can provide such ETag. So.
# $W->{"r"}->set_etag() ?