| 1 | #!/usr/bin/perl |
|---|
| 2 | |
|---|
| 3 | package HTTP::Engine::Role::RequestBuilder::HTTPBody; |
|---|
| 4 | use Mouse::Role; |
|---|
| 5 | |
|---|
| 6 | with qw( |
|---|
| 7 | HTTP::Engine::Role::RequestBuilder::ReadBody |
|---|
| 8 | ); |
|---|
| 9 | |
|---|
| 10 | # tempolary file path for upload file. |
|---|
| 11 | has upload_tmp => ( |
|---|
| 12 | is => 'rw', |
|---|
| 13 | ); |
|---|
| 14 | |
|---|
| 15 | has chunk_size => ( |
|---|
| 16 | is => 'ro', |
|---|
| 17 | isa => 'Int', |
|---|
| 18 | default => 4096, |
|---|
| 19 | ); |
|---|
| 20 | |
|---|
| 21 | sub _build_http_body { |
|---|
| 22 | my ( $self, $req ) = @_; |
|---|
| 23 | |
|---|
| 24 | $self->_read_to_end($req->_read_state); |
|---|
| 25 | |
|---|
| 26 | return delete $req->_read_state->{data}{http_body}; |
|---|
| 27 | } |
|---|
| 28 | |
|---|
| 29 | sub _build_raw_body { |
|---|
| 30 | my ( $self, $req ) = @_; |
|---|
| 31 | |
|---|
| 32 | $self->_read_to_end($req->_read_state); |
|---|
| 33 | |
|---|
| 34 | return delete $req->_read_state->{data}{raw_body}; |
|---|
| 35 | } |
|---|
| 36 | |
|---|
| 37 | |
|---|
| 38 | sub _build_read_state { |
|---|
| 39 | my($self, $req) = @_; |
|---|
| 40 | |
|---|
| 41 | my $length = $req->content_length || 0; |
|---|
| 42 | my $type = $req->header('Content-Type'); |
|---|
| 43 | |
|---|
| 44 | HTTP::Engine::Util::require_once('HTTP/Body.pm'); |
|---|
| 45 | my $body = HTTP::Body->new($type, $length); |
|---|
| 46 | $body->tmpdir( $self->upload_tmp) if $self->upload_tmp; |
|---|
| 47 | |
|---|
| 48 | return $self->_read_init({ |
|---|
| 49 | input_handle => $req->_connection->{input_handle}, |
|---|
| 50 | content_length => $length, |
|---|
| 51 | read_position => 0, |
|---|
| 52 | data => { |
|---|
| 53 | raw_body => "", |
|---|
| 54 | http_body => $body, |
|---|
| 55 | }, |
|---|
| 56 | }); |
|---|
| 57 | } |
|---|
| 58 | |
|---|
| 59 | sub _handle_read_chunk { |
|---|
| 60 | my ( $self, $state, $chunk ) = @_; |
|---|
| 61 | |
|---|
| 62 | my $d = $state->{data}; |
|---|
| 63 | |
|---|
| 64 | $d->{raw_body} .= $chunk; |
|---|
| 65 | $d->{http_body}->add($chunk); |
|---|
| 66 | } |
|---|
| 67 | |
|---|
| 68 | sub _prepare_uploads { |
|---|
| 69 | my($self, $req) = @_; |
|---|
| 70 | |
|---|
| 71 | my $uploads = $req->http_body->upload; |
|---|
| 72 | my %uploads; |
|---|
| 73 | for my $name (keys %{ $uploads }) { |
|---|
| 74 | my $files = $uploads->{$name}; |
|---|
| 75 | $files = ref $files eq 'ARRAY' ? $files : [$files]; |
|---|
| 76 | |
|---|
| 77 | my @uploads; |
|---|
| 78 | for my $upload (@{ $files }) { |
|---|
| 79 | my $headers = HTTP::Headers::Fast->new( %{ $upload->{headers} } ); |
|---|
| 80 | push( |
|---|
| 81 | @uploads, |
|---|
| 82 | HTTP::Engine::Request::Upload->new( |
|---|
| 83 | headers => $headers, |
|---|
| 84 | tempname => $upload->{tempname}, |
|---|
| 85 | size => $upload->{size}, |
|---|
| 86 | filename => $upload->{filename}, |
|---|
| 87 | ) |
|---|
| 88 | ); |
|---|
| 89 | } |
|---|
| 90 | $uploads{$name} = @uploads > 1 ? \@uploads : $uploads[0]; |
|---|
| 91 | |
|---|
| 92 | # support access to the filename as a normal param |
|---|
| 93 | my @filenames = map { $_->{filename} } @uploads; |
|---|
| 94 | $req->parameters->{$name} = @filenames > 1 ? \@filenames : $filenames[0]; |
|---|
| 95 | } |
|---|
| 96 | return \%uploads; |
|---|
| 97 | } |
|---|
| 98 | |
|---|
| 99 | 1; |
|---|
| 100 | |
|---|