File Coverage

blib/lib/HTTP/Body/UrlEncoded.pm
Criterion Covered Total %
statement 21 21 100.0
branch 4 6 66.6
condition n/a
subroutine 4 4 100.0
pod 1 1 100.0
total 30 32 93.7


line stmt bran cond sub pod time code
1             package HTTP::Body::UrlEncoded;
2             $HTTP::Body::UrlEncoded::VERSION = '1.23';
3 10     10   67 use strict;
  10         23  
  10         493  
4 10     10   67 use base 'HTTP::Body';
  10         24  
  10         1642  
5 10     10   108 use bytes;
  10         23  
  10         90  
6              
7             our $DECODE = qr/%([0-9a-fA-F]{2})/;
8              
9             our %hex_chr;
10              
11             for my $num ( 0 .. 255 ) {
12             my $h = sprintf "%02X", $num;
13             $hex_chr{ lc $h } = $hex_chr{ uc $h } = chr $num;
14             }
15              
16             =head1 NAME
17              
18             HTTP::Body::UrlEncoded - HTTP Body UrlEncoded Parser
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              
36             sub spin {
37 15     15 1 15 my $self = shift;
38              
39 15 100       69 return unless $self->length == $self->content_length;
40            
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 6         46 $self->{buffer} =~ s/\+/ /g;
47              
48 6         83 for my $pair ( split( /[&;](?:\s+)?/, $self->{buffer} ) ) {
49              
50 20         48 my ( $name, $value ) = split( /=/, $pair , 2 );
51              
52 20 50       29 next unless defined $name;
53 20 50       28 next unless defined $value;
54            
55 20         58 $name =~ s/$DECODE/$hex_chr{$1}/gs;
56 20         89 $value =~ s/$DECODE/$hex_chr{$1}/gs;
57              
58 20         34 $self->param( $name, $value );
59             }
60              
61 6         13 $self->{buffer} = '';
62 6         17 $self->{state} = 'done';
63             }
64              
65             =back
66              
67             =head1 SUPPORT
68              
69             See L<HTTP::Body>
70              
71             =head1 AUTHORS
72              
73             Christian Hansen, C<ch@ngmedia.com>
74              
75             Andy Grundman, C<andy@hybridized.org>
76              
77             =head1 LICENSE
78              
79             This library is free software . You can redistribute it and/or modify
80             it under the same terms as perl itself.
81              
82             =cut
83              
84             1;