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.20';
3 8     8   31 use strict;
  8         9  
  8         258  
4 8     8   34 use base 'HTTP::Body';
  8         9  
  8         615  
5 8     8   36 use bytes;
  8         9  
  8         38  
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 11 my $self = shift;
38              
39 15 100       30 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         30 $self->{buffer} =~ s/\+/ /g;
47              
48 6         38 for my $pair ( split( /[&;](?:\s+)?/, $self->{buffer} ) ) {
49              
50 20         40 my ( $name, $value ) = split( /=/, $pair , 2 );
51              
52 20 50       28 next unless defined $name;
53 20 50       23 next unless defined $value;
54            
55 20         38 $name =~ s/$DECODE/$hex_chr{$1}/gs;
56 20         67 $value =~ s/$DECODE/$hex_chr{$1}/gs;
57              
58 20         38 $self->param( $name, $value );
59             }
60              
61 6         8 $self->{buffer} = '';
62 6         14 $self->{state} = 'done';
63             }
64              
65             =back
66              
67             =head1 AUTHORS
68              
69             Christian Hansen, C
70              
71             Andy Grundman, C
72              
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              
80             1;