Permalink
Browse files

Fix contributed by Christian Carey <christianc@sitesell.com> to handle

utf8 strings correctly in perl 5.8.0 and 5.8.1.
  • Loading branch information...
1 parent cf78743 commit 2efd2056aef3d935e0b84c938532e466d7ca3fef Lincoln Stein committed Jan 29, 2010
Showing with 28 additions and 1 deletion.
  1. +28 −1 lib/CGI/Util.pm
View
@@ -244,11 +244,38 @@ sub unescape {
# was always so and cannot be fixed without breaking the binary data case.
# -- Stepan Kasal <skasal@redhat.com>
#
+if ($] == 5.008) {
+ package utf8;
+
+ no warnings 'redefine'; # needed for Perl 5.8.1+
+
+ my $is_utf8_redefinition = <<'EOR';
+ sub is_utf8 {
+ my ($text) = @_;
+
+ my $ctext = pack q{C0a*}, $text;
+
+ return ($text ne $ctext) && ($ctext =~ m/^(
+ [\x09\x0A\x0D\x20-\x7E]
+ | [\xC2-\xDF][\x80-\xBF]
+ | \xE0[\xA0-\xBF][\x80-\xBF]
+ | [\xE1-\xEC\xEE\xEF][\x80-\xBF]{2}
+ | \xED[\x80-\x9F][\x80-\xBF]
+ | \xF0[\x90-\xBF][\x80-\xBF]{2}
+ | [\xF1-\xF3][\x80-\xBF]{3}
+ | \xF4[\x80-\x8F][\x80-\xBF]{2}
+ )*$/xo);
+ }
+EOR
+
+ eval $is_utf8_redefinition;
+}
+
sub escape {
shift() if @_ > 1 and ( ref($_[0]) || (defined $_[1] && $_[0] eq $CGI::DefaultClass));
my $toencode = shift;
return undef unless defined($toencode);
- utf8::encode($toencode) if ($] > 5.008001 && utf8::is_utf8($toencode));
+ utf8::encode($toencode) if ($] >= 5.008 && utf8::is_utf8($toencode));
if ($EBCDIC) {
$toencode=~s/([^a-zA-Z0-9_.~-])/uc sprintf("%%%02x",$E2A[ord($1)])/eg;
} else {

0 comments on commit 2efd205

Please sign in to comment.