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     $self->body(IO::Handle::Util::io_from_any($self->{buffer}));
  45
  46     # I tested parsing this using APR::Request, but perl is faster
  47     # Pure-Perl    2560/s
  48     # APR::Request 2305/s
  49
  50     # Note: s/// appears faster than tr///
  51     $self->{buffer} =~ s/\+/ /g;
  52
  53     for my $pair ( split( /[&;](?:\s+)?/, $self->{buffer} ) ) {
  54
  55         my ( $name, $value ) = split( /=/, $pair , 2 );
  56
  57         next unless defined $name;
  58         next unless defined $value;
  59
  60         $name  =~ s/$DECODE/$hex_chr{$1}/gs;
  61         $value =~ s/$DECODE/$hex_chr{$1}/gs;
  62
  63         $self->param( $name, $value );
  64     }
  65
  66     $self->{buffer} = '';
  67     $self->{state}  = 'done';
  68 }
  69
  70 =back
  71
  72 =head1 AUTHORS
  73
  74 Christian Hansen, C<ch@ngmedia.com>
  75
  76 Andy Grundman, C<andy@hybridized.org>
  77
  78 =head1 LICENSE
  79
  80 This library is free software . You can redistribute it and/or modify
  81 it under the same terms as perl itself.
  82
  83 =cut
  84
  85 1;