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 af5e2c5c6a33d7b824bc2d8b1e9952615d1875b5..73238a5be3413f2b246867c3608f42e57e6da316 100644 (file)
--- a/ucw/perl/UCW/CGI.pm
+++ b/ucw/perl/UCW/CGI.pm
@@ -1,6 +1,6 @@
 #      Poor Man's CGI Module for Perl
 #
-#      (c) 2002--2009 Martin Mares <mj@ucw.cz>
+#      (c) 2002--2010 Martin Mares <mj@ucw.cz>
 #      Slightly modified by Tomas Valla <tom@ucw.cz>
 #
 #      This software may be freely distributed and used according to the terms
@@ -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;
 }
 
@@ -93,6 +99,7 @@ sub html_escape($) {
        $x =~ s/</&lt;/g;
        $x =~ s/>/&gt;/g;
        $x =~ s/"/&quot;/g;
+       $x =~ s/'/&#39;/g;
        return $x;
 }
 
@@ -133,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+//;
@@ -142,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, $_);
        }
 }
 
@@ -195,22 +208,24 @@ sub parse_args($) {                       # CAVEAT: attached files must be defined in the main arg t
                }
        }
 
-       for my $a (values %$args) {
-               defined($raw_args{$a}) or next;
-               $_ = $raw_args{$a};
-               $a->{'multiline'} or s/(\n|\t)/ /g;
-               s/^\s+//;
-               s/\s+$//;
-               if (my $rx = $a->{'check'}) {
-                       if (!/^$rx$/) { $_ = $a->{'default'}; }
-               }
+       for my $arg (keys %$args) {
+               my $a = $args->{$arg};
+               defined($raw_args{$arg}) or next;
+               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, $_;
+                       }
                }
        }
 }
@@ -367,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"}) {
@@ -400,7 +415,7 @@ sub parse_multipart_form_data() {
 
 sub make_out_args(@) {         # Usage: make_out_args([arg_table, ...] name => value, ...)
        my @arg_tables = ( $main_arg_table );
-       while (@_ && ref(@_) eq 'HASH') {
+       while (@_ && ref($_[0]) eq 'HASH') {
                push @arg_tables, shift @_;
        }
        my %overrides = @_;
@@ -410,12 +425,14 @@ sub make_out_args(@) {            # Usage: make_out_args([arg_table, ...] name => value, .
                        my $arg = $table->{$name};
                        defined($arg->{'var'}) || next;
                        defined($arg->{'pass'}) && !$arg->{'pass'} && !exists $overrides{$name} && next;
+                       defined $arg->{'default'} or $arg->{'default'} = "";
                        my $value;
                        if (!defined($value = $overrides{$name})) {
                                if (exists $overrides{$name}) {
                                        $value = $arg->{'default'};
                                } else {
                                        $value = ${$arg->{'var'}};
+                                       defined $value or $value = $arg->{'default'};
                                }
                        }
                        if ($value ne $arg->{'default'}) {