X-Git-Url: http://mj.ucw.cz/gitweb/?a=blobdiff_plain;f=lib%2Fperl%2FCGI.pm;h=aeb6c50504a52a4c8bdda50fa4e11cd1d087ebd5;hb=b42162f5526360acc6930e3d2e296af1fef08e63;hp=286bca52f7a4fa0c5636de9be6891b3b68e8fcd2;hpb=b0e111a2b5c5ebcb15e71359e4c5775d0d6a1fcc;p=libucw.git diff --git a/lib/perl/CGI.pm b/lib/perl/CGI.pm index 286bca52..aeb6c505 100644 --- 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 +# Slightly modified by Tomas Valla # # 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(@) {