Added REV_COMPARE(x,y) which is equivalent to COMPARE(y,x), but it's

[libucw.git] / lib / perl / CGI.pm

diff --git a/lib/perl/CGI.pm b/lib/perl/CGI.pm
index 286bca52f7a4fa0c5636de9be6891b3b68e8fcd2..aeb6c50504a52a4c8bdda50fa4e11cd1d087ebd5 100644 (file)
--- a/lib/perl/CGI.pm
+++ b/lib/perl/CGI.pm
@@ -1,6 +1,7 @@
 #      Poor Man's CGI Module for Perl
 #
 #      (c) 2002 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
 #      of the GNU Lesser General Public License.
@@ -23,8 +24,7 @@ BEGIN {
 
 sub url_escape($) {
        my $x = shift @_;
-       $x =~ s/([^-\$_.+!*'(),0-9A-Za-z\x80-\xff ])/"%".unpack('H2',$1)/ge;
-       $x =~ s/ /+/g;
+       $x =~ s/([^-\$_.!*'(),0-9A-Za-z\x80-\xff])/"%".unpack('H2',$1)/ge;
        return $x;
 }
 
@@ -42,7 +42,7 @@ our $arg_table;
 sub parse_arg_string($) {
        my ($s) = @_;
        $s =~ s/\s+//;
-       foreach $_ (split /&/,$s) {
+       foreach $_ (split /[&:]/,$s) {
                (/^([^=]+)=(.*)$/) or next;
                my $arg = $arg_table->{$1} or next;
                $_ = $2;
@@ -54,15 +54,26 @@ sub parse_arg_string($) {
                if (my $rx = $arg->{'check'}) {
                        if (!/^$rx$/) { $_ = $arg->{'default'}; }
                }
-               ${$arg->{'var'}} = $_;
+               
+               my $r = ref($arg->{'var'});
+               if ($r eq 'SCALAR') {
+                       ${$arg->{'var'}} = $_;
+               } elsif ($r eq 'ARRAY') {
+                       push @{$arg->{'var'}}, $_;
+               }
        }
 }
 
 sub parse_args($) {
        $arg_table = shift @_;
        foreach my $a (values %$arg_table) {
+               my $r = ref($a->{'var'});
                defined($a->{'default'}) or $a->{'default'}="";
-               ${$a->{'var'}} = $a->{'default'};
+               if ($r eq 'SCALAR') {
+                       ${$a->{'var'}} = $a->{'default'};
+               } elsif ($r eq 'ARRAY') {
+                       @{$a->{'var'}} = ();
+               }
        }
        defined $ENV{"GATEWAY_INTERFACE"} or die "Not called as a CGI script";
        my $method = $ENV{"REQUEST_METHOD"};
@@ -106,7 +117,7 @@ sub make_out_args($) {
 sub self_ref(@) {
        my %h = @_;
        my $out = make_out_args(\%h);
-       return "?" . join('&', map { "$_=" . url_escape($out->{$_}) } sort keys %$out);
+       return "?" . join(':', map { "$_=" . url_escape($out->{$_}) } sort keys %$out);
 }
 
 sub self_form(@) {