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