Commit | Line | Data |
---|---|---|
4f5db602 | 1 | package HTTP::Body::UrlEncoded; |
32b29b79 | 2 | |
3 | use strict; | |
4 | use base 'HTTP::Body'; | |
5 | use bytes; | |
2ec96b56 | 6 | use IO::Handle::Util; |
32b29b79 | 7 | |
f4600b8f | 8 | our $DECODE = qr/%([0-9a-fA-F]{2})/; |
7e2df1d9 | 9 | |
dd70a428 | 10 | our %hex_chr; |
11 | ||
2d423a7b | 12 | for my $num ( 0 .. 255 ) { |
13 | my $h = sprintf "%02X", $num; | |
14 | $hex_chr{ lc $h } = $hex_chr{ uc $h } = chr $num; | |
dd70a428 | 15 | } |
16 | ||
aac7ca02 | 17 | =head1 NAME |
18 | ||
38ad3df8 | 19 | HTTP::Body::UrlEncoded - HTTP Body UrlEncoded Parser |
aac7ca02 | 20 | |
21 | =head1 SYNOPSIS | |
22 | ||
23 | use HTTP::Body::UrlEncoded; | |
24 | ||
25 | =head1 DESCRIPTION | |
26 | ||
27 | HTTP Body UrlEncoded Parser. | |
28 | ||
29 | =head1 METHODS | |
30 | ||
31 | =over 4 | |
32 | ||
33 | =item spin | |
34 | ||
35 | =cut | |
36 | ||
58050177 | 37 | sub spin { |
38 | my $self = shift; | |
aac7ca02 | 39 | |
7e2df1d9 | 40 | return unless $self->length == $self->content_length; |
2ec96b56 | 41 | |
42 | # Store a copy of the raw request that the body() method can return | |
43 | # see RT #111876 | |
44 | my $body_content = $self->{buffer}; | |
45 | $self->body(IO::Handle::Util::io_from_any($body_content)); | |
dd70a428 | 46 | |
2d423a7b | 47 | # I tested parsing this using APR::Request, but perl is faster |
48 | # Pure-Perl 2560/s | |
49 | # APR::Request 2305/s | |
50 | ||
51 | # Note: s/// appears faster than tr/// | |
52 | $self->{buffer} =~ s/\+/ /g; | |
7e2df1d9 | 53 | |
5a1e3a8d | 54 | for my $pair ( split( /[&;](?:\s+)?/, $self->{buffer} ) ) { |
aac7ca02 | 55 | |
25f2a981 | 56 | my ( $name, $value ) = split( /=/, $pair , 2 ); |
aac7ca02 | 57 | |
7e2df1d9 | 58 | next unless defined $name; |
59 | next unless defined $value; | |
dd70a428 | 60 | |
61 | $name =~ s/$DECODE/$hex_chr{$1}/gs; | |
62 | $value =~ s/$DECODE/$hex_chr{$1}/gs; | |
aac7ca02 | 63 | |
7e2df1d9 | 64 | $self->param( $name, $value ); |
65 | } | |
aac7ca02 | 66 | |
67 | $self->{buffer} = ''; | |
f4600b8f | 68 | $self->{state} = 'done'; |
58050177 | 69 | } |
70 | ||
aac7ca02 | 71 | =back |
72 | ||
2d423a7b | 73 | =head1 AUTHORS |
aac7ca02 | 74 | |
75 | Christian Hansen, C<ch@ngmedia.com> | |
76 | ||
2d423a7b | 77 | Andy Grundman, C<andy@hybridized.org> |
78 | ||
aac7ca02 | 79 | =head1 LICENSE |
80 | ||
81 | This library is free software . You can redistribute it and/or modify | |
82 | it under the same terms as perl itself. | |
83 | ||
84 | =cut | |
85 | ||
32b29b79 | 86 | 1; |