From d352d10efbc9a65e73c0dbf60753558b1010dc63 Mon Sep 17 00:00:00 2001
From: short <>
Date: Sat, 10 Sep 2005 08:26:54 +0000
Subject: [PATCH] Cleanups of request checks, mod_perl checks and all around:
 &escapeHTML

---
 Web.pm | 28 +++++++++++++++++++++-------
 1 file changed, 21 insertions(+), 7 deletions(-)

diff --git a/Web.pm b/Web.pm
index 599005f..0cf0d3c 100644
--- a/Web.pm
+++ b/Web.pm
@@ -135,14 +135,15 @@ my($apache_request)=@_;
 	return OK;
 }
 
-sub W_check(;$)
+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(); };
-	confess "Calling sensitive dynamic code without My::Web::init" if !$W->{"__PACKAGE__"};
+	# 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 ($%)
@@ -166,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.
@@ -262,8 +267,16 @@ sub escapeHTML($)
 my($text)=@_;
 
 	# 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);
 }
 
@@ -309,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
@@ -534,9 +548,9 @@ sub uri_escaped($)
 my($uri)=@_;
 
 	cluck if !ref $uri;
-	W_check();
 	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
@@ -549,7 +563,7 @@ sub a_href($;$%)
 {
 my($in,$contents,%args)=@_;
 
-	W_check();
+	request_check();
 	do { $$_=1 if !defined $$_; } for (\$args{"size"});
 	if (!defined $contents) {
 		$contents=$in;
@@ -585,7 +599,7 @@ my($self,$sub,@sub_args)=@_;
 
 sub input_hidden_persistents()
 {
-	W_check();
+	request_check();
 	return join("",map({
 		my $key=$_;
 		my $val=$W->{"args"}{$key};
@@ -734,7 +748,7 @@ sub img ($$%)
 {
 my($in,$alt,%args)=@_;
 
-	W_check();
+	request_check();
 	my($path_web,$path_abs_disk)=_img_src($in,%args);
 	my($width,$height)=Image::Size::imgsize($path_abs_disk);
 	$alt=~s/<[^>]*>//g;
-- 
1.8.3.1