X-Git-Url: http://git.jankratochvil.net/?a=blobdiff_plain;f=Web.pm;h=0cf0d3c86a82bf96c78feede5c3c74e853eca885;hb=d352d10efbc9a65e73c0dbf60753558b1010dc63;hp=3d24a958edaa2f0454ad422e7a9593f9998fb7a3;hpb=ce244b8d7c56fbb7d4b1707ab13c8426eed57216;p=MyWeb.git

diff --git a/Web.pm b/Web.pm
index 3d24a95..0cf0d3c 100644
--- a/Web.pm
+++ b/Web.pm
@@ -36,6 +36,7 @@ our @EXPORT=qw(
 		&img &centerimg &rightimg
 		$W
 		&input_hidden_persistents
+		&escapeHTML
 		);
 our @ISA=qw(Tie::Handle Exporter);
 
@@ -134,6 +135,17 @@ my($apache_request)=@_;
 	return OK;
 }
 
+sub request_check(;$)
+{
+my($self)=@_;
+
+	# Use &eval to prevent: Global $r object is not available. Set:\n\tPerlOptions +GlobalRequest\nin ...
+	# CGI requires valid "r": check it beforehand here.
+	confess "Calling sensitive dynamic code from a static code" if !eval { Apache2::RequestUtil->request(); };
+	# Do not: confess "Calling sensitive dynamic code without My::Web::init" if !$W->{"__PACKAGE__"};
+	# as it is valid at least while preparing arguments to call: &project::Lib::init
+}
+
 sub init ($%)
 {
 my($class,%args)=@_;
@@ -155,6 +167,10 @@ my($class,%args)=@_;
 	# $Apache2::Registry::curstash is no longer supported.
 	do { cluck "No $_" if !$W->{$_}; } for "__PACKAGE__";
 
+	# See: &escapeHTML
+	do { cluck "charset==$_, expecting ISO-8859-1" if $_ ne "ISO-8859-1"; } for CGI::charset();
+	CGI::charset("utf-8");
+
 	do { $W->{$_}=0  if !defined $W->{$_}; } for ("detect_ent");
 	do { $W->{$_}=0  if !defined $W->{$_}; } for ("detect_js");
 	do { $W->{$_}=1  if !defined $W->{$_}; } for ("have_css");	# AFAIK it does not hurt anyone.
@@ -226,7 +242,7 @@ my($class,%args)=@_;
 		$W->{"head"}.='<script type="text/javascript" src="'.path_web('/have_js.pm').'"></script>'."\n";
 		}
 
-	do { args_check(%$_) if $_; } for ($W->{"args_check"});
+	do { _args_check(%$_) if $_; } for ($W->{"args_check"});
 
 	return bless $W,$class;
 }
@@ -250,12 +266,17 @@ sub escapeHTML($)
 {
 my($text)=@_;
 
-	# Use &eval to prevent: Global $r object is not available. Set:\n\tPerlOptions +GlobalRequest\nin ...
-	# CGI requires valid "r": check it beforehand here.
-	confess "Calling dynamic URL generator from a static code" if !eval { Apache2::RequestUtil->request(); };
 	# Prevent &CGI::escapeHTML breaking utf-8 strings like: \xC4\x9B eq \x{11B}
-	do { cluck "charset==$_" if $_ && $_ ne "utf-8"; } for CGI::charset();
+	# Prevent case if we run under mod_perl but still just initializing:
+	request_check() if $ENV{"MOD_PERL"};
+	# Generally we are initialized from &init but we may be used without it without mod_perl
+	# and in such case check the change on all non-first invocations.
+	our $init;
+	if (!$ENV{"MOD_PERL"} && $init++) {
+		do { cluck "charset==$_" if $_ ne "utf-8"; } for CGI::charset();
+		}
 	CGI::charset("utf-8");
+
 	return CGI::escapeHTML($text);
 }
 
@@ -301,6 +322,7 @@ sub dir_top_abs_disk()
 
 sub unparsed_uri()
 {
+	request_check();
 	if (!$W->{"unparsed_uri"}) {
 		# Do not: $W->{"r"}
 		# as we may be called before &init from: &My::Project::init
@@ -367,7 +389,7 @@ my($in,%args)=@_;
 
 sub fatal (;$);
 
-sub args_check (%)
+sub _args_check (%)
 {
 my(%tmpl)=@_;
 
@@ -528,6 +550,7 @@ my($uri)=@_;
 	cluck if !ref $uri;
 	my $urient=escapeHTML($uri);
 	return $uri    if $uri eq $urient;
+	request_check();
 	return $urient if uri_is_local $uri;
 	return $uri    if defined $W->{"have_ent"} && !$W->{"have_ent"};	# non-ent client
 	return $urient if $W->{"have_ent"};	# ent client
@@ -540,6 +563,7 @@ sub a_href($;$%)
 {
 my($in,$contents,%args)=@_;
 
+	request_check();
 	do { $$_=1 if !defined $$_; } for (\$args{"size"});
 	if (!defined $contents) {
 		$contents=$in;
@@ -575,6 +599,7 @@ my($self,$sub,@sub_args)=@_;
 
 sub input_hidden_persistents()
 {
+	request_check();
 	return join("",map({
 		my $key=$_;
 		my $val=$W->{"args"}{$key};
@@ -723,6 +748,7 @@ sub img ($$%)
 {
 my($in,$alt,%args)=@_;
 
+	request_check();
 	my($path_web,$path_abs_disk)=_img_src($in,%args);
 	my($width,$height)=Image::Size::imgsize($path_abs_disk);
 	$alt=~s/<[^>]*>//g;