lib/HTTP/Body.pm

   1 package HTTP::Body;
   2
   3 use strict;
   4 use warnings;
   5 use base 'Class::Accessor::Fast';
   6
   7 use Params::Validate    qw[];
   8 use HTTP::Body::Context qw[];
   9 use HTTP::Body::Parser  qw[];
  10
  11 __PACKAGE__->mk_accessors( qw[ context parser ] );
  12
  13 our $VERSION = 0.7;
  14
  15 =head1 NAME
  16
  17 HTTP::Body - HTTP Body Parser
  18
  19 =head1 SYNOPSIS
  20
  21  use HTTP::Body;
  22
  23  sub handler : method {
  24      my ( $class, $r ) = @_;
  25
  26      my $content_type   = $r->headers_in->get('Content-Type');
  27      my $content_length = $r->headers_in->get('Content-Length');
  28
  29      my $body   = HTTP::Body->new( $content_type, $content_length );
  30      my $length = $content_length;
  31
  32      while ( $length ) {
  33
  34          $r->read( my $buffer, ( $length < 8192 ) ? $length : 8192 );
  35
  36          $length -= length($buffer);
  37
  38          $body->add($buffer);
  39      }
  40
  41      my $uploads = $body->upload; # hashref
  42      my $params  = $body->param;  # hashref
  43      my $body    = $body->body;   # IO::Handle
  44  }
  45
  46 =head1 DESCRIPTION
  47
  48 HTTP Body Parser.
  49
  50 =head1 METHODS
  51
  52 =over 4
  53
  54 =item new($hashref)
  55
  56 Constructor taking arugments as a hashref. Requires a C<context> argument which
  57 isa L<HTTP::Body::Context> object, and optional C<bufsize> (integer) and
  58 C<parser> (L<HTTP::Body::Parser>) arguments.
  59
  60 If called with two arguments C<($content_type, $content_length),
  61 L<HTTP::Body::Compat> will be used instead to maintain compatability with
  62 versions <= 0.6
  63
  64 =cut
  65
  66 sub new {
  67     my $class = ref $_[0] ? ref shift : shift;
  68
  69     # bring in compat for old API <= 0.6
  70     if ( @_ == 2 ) {
  71         require HTTP::Body::Compat;
  72         return  HTTP::Body::Compat->new(@_);
  73     }
  74
  75     my $params = Params::Validate::validate_with(
  76         params  => \@_,
  77         spec    => {
  78             bufsize => {
  79                 type      => Params::Validate::SCALAR,
  80                 default   => 65536,
  81                 optional  => 1
  82             },
  83             context => {
  84                 type      => Params::Validate::OBJECT,
  85                 isa       => 'HTTP::Body::Context',
  86                 optional  => 0
  87             },
  88             parser  => {
  89                 type      => Params::Validate::OBJECT,
  90                 isa       => 'HTTP::Body::Parser',
  91                 optional  => 1
  92             }
  93         },
  94         called  => "$class\::new"
  95     );
  96
  97     return bless( {}, $class )->initialize($params);
  98 }
  99
 100 sub initialize {
 101     my ( $self, $params ) = @_;
 102
 103     my $bufsize = delete $params->{bufsize} || 65536;
 104
 105     $params->{parser} ||= HTTP::Body::Parser->new(
 106         bufsize => $bufsize,
 107         context => $params->{context}
 108     );
 109
 110     while ( my ( $param, $value ) = each( %{ $params } ) ) {
 111         $self->$param($value);
 112     }
 113
 114     return $self;
 115 }
 116
 117 =item eos
 118
 119 =cut
 120
 121 sub eos {
 122     return shift->parser->eos;
 123 }
 124
 125 =item put
 126
 127 =cut
 128
 129 sub put {
 130     return shift->parser->put(@_);
 131 }
 132
 133 =back
 134
 135 =head1 AUTHOR
 136
 137 Christian Hansen, C<ch@ngmedia.com>
 138
 139 This pod written by Ash Berlin, C<ash@cpan.org>.
 140
 141 =head1 LICENSE
 142
 143 This library is free software. You can redistribute it and/or modify
 144 it under the same terms as perl itself.
 145
 146 =cut
 147
 148 1;