X-Git-Url: http://mj.ucw.cz/gitweb/?a=blobdiff_plain;f=lib%2Fperl%2FCGI.pm;h=55e76e1c7fb4b56a79ad20148a80b10b47cb4f11;hb=65ee3e5922412b6a09e6feddb55418bd8edfbbb9;hp=e909308752d3d1e2b8525bdfff8bd9e31810401b;hpb=c637d3753d07466477a83df4cc632baf097cc376;p=libucw.git diff --git a/lib/perl/CGI.pm b/lib/perl/CGI.pm index e9093087..55e76e1c 100644 --- a/lib/perl/CGI.pm +++ b/lib/perl/CGI.pm @@ -17,17 +17,26 @@ BEGIN { our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); $VERSION = 1.0; @ISA = qw(Exporter); - @EXPORT = qw(&html_escape &url_escape &self_ref &self_form); + @EXPORT = qw(&html_escape &url_escape &url_param_escape &self_ref &self_form); @EXPORT_OK = qw(); %EXPORT_TAGS = (); } +### Escaping ### + sub url_escape($) { my $x = shift @_; $x =~ s/([^-\$_.!*'(),0-9A-Za-z\x80-\xff])/"%".unpack('H2',$1)/ge; return $x; } +sub url_param_escape($) { + my $x = shift @_; + $x = url_escape($x); + $x =~ s/%20/+/g; + return $x; +} + sub html_escape($) { my $x = shift @_; $x =~ s/&/&/g; @@ -82,8 +91,10 @@ sub parse_arg_string($) { my $arg = $arg_table->{$1} or next; $_ = $2; s/\+/ /g; - s/%(..)/pack("c",hex $1)/eg; - s/(\r|\n|\t)/ /g; + s/%(..)/pack("H2",$1)/eg; + s/\r\n/\n/g; + s/\r/\n/g; + $arg->{'multiline'} || s/(\n|\t)/ /g; s/^\s+//; s/\s+$//; if (my $rx = $arg->{'check'}) { @@ -128,12 +139,15 @@ sub parse_args($) { } } +### Generating Self-ref URL's ### + sub make_out_args($) { my ($overrides) = @_; my $out = {}; foreach my $name (keys %$arg_table) { my $arg = $arg_table->{$name}; - defined $arg->{'pass'} && !$arg->{'pass'} && !exists $overrides->{$name} && next; + defined($arg->{'var'}) || next; + defined($arg->{'pass'}) && !$arg->{'pass'} && !exists $overrides->{$name} && next; my $value; if (!defined($value = $overrides->{$name})) { if (exists $overrides->{$name}) { @@ -152,7 +166,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_param_escape($out->{$_}) } sort keys %$out); } sub self_form(@) {