UCW::CGI: Implemented UTF-8 mode (compatible with `use utf8')

[libucw.git] / ucw / perl / UCW / CGI.pm

diff --git a/ucw/perl/UCW/CGI.pm b/ucw/perl/UCW/CGI.pm
index d3325b9ffdd04be507e315f498abb65088bf474e..73238a5be3413f2b246867c3608f42e57e6da316 100644 (file)
--- a/ucw/perl/UCW/CGI.pm
+++ b/ucw/perl/UCW/CGI.pm
@@ -60,17 +60,23 @@ our @ISA = qw(Exporter);
 our @EXPORT = qw(&html_escape &url_escape &url_deescape &url_param_escape &url_param_deescape &self_ref &self_form &http_get);
 our @EXPORT_OK = qw();
 
+our $utf8_mode = 0;
+
 ### Escaping ###
 
 sub url_escape($) {
        my $x = shift @_;
+       utf8::encode($x) if $utf8_mode;
        $x =~ s/([^-\$_.!*'(),0-9A-Za-z\x80-\xff])/"%".unpack('H2',$1)/ge;
+       utf8::decode($x) if $utf8_mode;
        return $x;
 }
 
 sub url_deescape($) {
        my $x = shift @_;
+       utf8::encode($x) if $utf8_mode;
        $x =~ s/%(..)/pack("H2",$1)/ge;
+       utf8::decode($x) if $utf8_mode;
        return $x;
 }
 
@@ -134,6 +140,14 @@ sub http_get($) {
 my $main_arg_table;
 my %raw_args;
 
+sub parse_raw_args_ll($$) {
+       my ($arg, $s) = @_;
+       $s =~ s/\r\n/\n/g;
+       $s =~ s/\r/\n/g;
+       utf8::decode($s) if $utf8_mode;
+       push @{$raw_args{$arg}}, $s;
+}
+
 sub parse_raw_args($) {
        my ($s) = @_;
        $s =~ s/\s+//;
@@ -143,9 +157,7 @@ sub parse_raw_args($) {
                $_ = $2;
                s/\+/ /g;
                s/%(..)/pack("H2",$1)/eg;
-               s/\r\n/\n/g;
-               s/\r/\n/g;
-               $raw_args{$arg} = $_;
+               parse_raw_args_ll($arg, $_);
        }
 }
 
@@ -199,20 +211,21 @@ sub parse_args($) {                       # CAVEAT: attached files must be defined in the main arg t
        for my $arg (keys %$args) {
                my $a = $args->{$arg};
                defined($raw_args{$arg}) or next;
-               $_ = $raw_args{$arg};
-               $a->{'multiline'} or s/(\n|\t)/ /g;
-               s/^\s+//;
-               s/\s+$//;
-               if (my $rx = $a->{'check'}) {
-                       if (!/^$rx$/) { $_ = $a->{'default'}; }
-               }
+               for (@{$raw_args{$arg}}) {
+                       $a->{'multiline'} or s/(\n|\t)/ /g;
+                       s/^\s+//;
+                       s/\s+$//;
+                       if (my $rx = $a->{'check'}) {
+                               if (!/^$rx$/) { $_ = $a->{'default'}; }
+                       }
 
-               my $v = $a->{'var'};
-               my $r = ref($v);
-               if ($r eq 'SCALAR') {
-                       $$v = $_;
-               } elsif ($r eq 'ARRAY') {
-                       push @$v, $_;
+                       my $v = $a->{'var'};
+                       my $r = ref($v);
+                       if ($r eq 'SCALAR') {
+                               $$v = $_;
+                       } elsif ($r eq 'ARRAY') {
+                               push @$v, $_;
+                       }
                }
        }
 }
@@ -369,7 +382,7 @@ sub parse_multipart_form_data() {
                        if (defined $a->{"var"}) {
                                while (defined (my $l = get_mp_line(1))) {
                                        print STDERR "VALUE $l\n" if $debug;
-                                       parse_raw_args("$field=$l");
+                                       parse_raw_args_ll($field, $l);
                                }
                                next PART;
                        } elsif (defined $a->{"file"}) {