lib/HTTP/Body/UrlEncoded.pm

   1 package HTTP::Body::UrlEncoded;
   2
   3 use strict;
   4 use base 'HTTP::Body';
   5 use bytes;
   6 use IO::Handle::Util;
   7
   8 our $DECODE = qr/%([0-9a-fA-F]{2})/;
   9
  10 our %hex_chr;
  11
  12 for my $num ( 0 .. 255 ) {
  13     my $h = sprintf "%02X", $num;
  14     $hex_chr{ lc $h } = $hex_chr{ uc $h } = chr $num;
  15 }
  16
  17 =head1 NAME
  18
  19 HTTP::Body::UrlEncoded - HTTP Body UrlEncoded Parser
  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
  37 sub spin {
  38     my $self = shift;
  39
  40     return unless $self->length == $self->content_length;
  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));
  46
  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;
  53
  54     for my $pair ( split( /[&;](?:\s+)?/, $self->{buffer} ) ) {
  55
  56         my ( $name, $value ) = split( /=/, $pair , 2 );
  57
  58         next unless defined $name;
  59         next unless defined $value;
  60
  61         $name  =~ s/$DECODE/$hex_chr{$1}/gs;
  62         $value =~ s/$DECODE/$hex_chr{$1}/gs;
  63
  64         $self->param( $name, $value );
  65     }
  66
  67     $self->{buffer} = '';
  68     $self->{state}  = 'done';
  69 }
  70
  71 =back
  72
  73 =head1 AUTHORS
  74
  75 Christian Hansen, C<ch@ngmedia.com>
  76
  77 Andy Grundman, C<andy@hybridized.org>
  78
  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
  86 1;