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