Commit | Line | Data |
32b29b79 |
1 | package HTTP::Body; |
2 | |
3 | use strict; |
4 | |
58050177 |
5 | use Carp qw[ ]; |
6 | use List::Util qw[ first ]; |
32b29b79 |
7 | |
8 | our $PARSERS = { |
9 | 'application/octet-stream' => 'HTTP::Body::Octetstream', |
10 | 'application/x-www-form-urlencoded' => 'HTTP::Body::Urlencoded', |
11 | 'multipart/form-data' => 'HTTP::Body::Multipart' |
12 | }; |
13 | |
14 | sub new { |
15 | my ( $class, $content_type, $content_length ) = @_; |
16 | |
17 | unless ( @_ == 3 ) { |
18 | Carp::croak( $class, '->new( $content_type, $content_length )' ); |
19 | } |
20 | |
21 | my $type = first { index( lc($content_type), $_ ) >= 0 } keys %{ $PARSERS }; |
22 | my $body = $PARSERS->{ $type || 'application/octet-stream' }; |
23 | |
24 | eval "require $body"; |
25 | |
26 | if ( $@ ) { |
27 | die $@; |
28 | } |
29 | |
30 | my $self = { |
31 | buffer => '', |
32 | content_length => $content_length, |
33 | content_type => $content_type, |
58050177 |
34 | length => 0, |
32b29b79 |
35 | param => { }, |
36 | upload => { } |
37 | }; |
38 | |
39 | bless( $self, $body ); |
40 | |
41 | return $self->init; |
42 | } |
43 | |
44 | sub add { |
58050177 |
45 | my $self = shift; |
46 | |
47 | if ( defined $_[0] ) { |
48 | $self->{buffer} .= $_[0]; |
49 | $self->{length} += length($_[0]); |
50 | } |
51 | |
52 | $self->spin; |
53 | |
54 | return ( $self->length - $self->content_length ); |
32b29b79 |
55 | } |
56 | |
57 | sub body { |
58 | my $self = shift; |
59 | $self->{body} = shift if @_; |
60 | return $self->{body}; |
61 | } |
62 | |
58050177 |
63 | sub buffer { |
64 | return shift->{buffer}; |
65 | } |
66 | |
32b29b79 |
67 | sub content_length { |
68 | return shift->{content_length}; |
69 | } |
70 | |
71 | sub content_type { |
72 | return shift->{content_type}; |
73 | } |
74 | |
58050177 |
75 | sub init { |
76 | return $_[0]; |
77 | } |
78 | |
79 | sub length { |
80 | return shift->{length}; |
81 | } |
82 | |
83 | sub spin { |
84 | Carp::croak('Define abstract method spin() in implementation'); |
85 | } |
86 | |
32b29b79 |
87 | sub param { |
88 | my $self = shift; |
89 | |
90 | if ( @_ == 2 ) { |
91 | |
92 | my ( $name, $value ) = @_; |
93 | |
94 | if ( exists $self->{param}->{$name} ) { |
95 | for ( $self->{param}->{$name} ) { |
96 | $_ = [$_] unless ref($_) eq "ARRAY"; |
97 | push( @$_, $value ); |
98 | } |
99 | } |
100 | else { |
101 | $self->{param}->{$name} = $value; |
102 | } |
103 | } |
104 | |
105 | return $self->{param}; |
106 | } |
107 | |
108 | sub upload { |
109 | my $self = shift; |
110 | |
111 | if ( @_ == 2 ) { |
112 | |
113 | my ( $name, $upload ) = @_; |
114 | |
115 | if ( exists $self->{upload}->{$name} ) { |
116 | for ( $self->{upload}->{$name} ) { |
117 | $_ = [$_] unless ref($_) eq "ARRAY"; |
118 | push( @$_, $upload ); |
119 | } |
120 | } |
121 | else { |
122 | $self->{upload}->{$name} = $upload; |
123 | } |
124 | } |
125 | |
126 | return $self->{upload}; |
127 | } |
128 | |
129 | 1; |