/t/020_interface/test_upload.t

  1use strict;
  2use warnings;
  3use t::Utils;
  4use HTTP::Engine;
  5use HTTP::Headers;
  6use HTTP::Request;
  7use Test::Base;
  8use File::Temp qw( tempdir );
  9use File::Spec;
 10
 11plan tests => 4*blocks;
 12
 13filters {
 14    response => [qw/chop/],
 15};
 16
 17run {
 18    my $block = shift;
 19    my $test;
 20    my $body;
 21
 22    if ($block->request && exists $block->request->{method} && $block->request->{method} eq 'POST') {
 23        delete $block->request->{method};
 24        $body = delete $block->request->{body};
 25        my $content = delete $block->request->{content};
 26        $content =~ s/\r\n/\n/g;
 27        $content =~ s/\n/\r\n/g;
 28        $test = HTTP::Request->new( POST => 'http://localhost/', HTTP::Headers::Fast->new( %{ $block->request } ), $content );
 29    } else {
 30        $test = HTTP::Request->new( GET => 'http://localhost/');
 31    }
 32
 33    my $upload;
 34    my $res = HTTP::Engine::Response->new(
 35        status => 200,
 36        body   => 'OK!',
 37    );
 38    my $response = HTTP::Engine->new(
 39        interface => {
 40            module => 'Test',
 41            request_handler => sub {
 42                my $req = shift;
 43                my $res = $res;
 44                return $res unless $body;
 45
 46                return $res unless $upload = $req->upload('test_upload_file');
 47                my $upload_body = $upload->slurp;
 48                unless ($body eq $upload_body) {
 49                    $res->body('NG');
 50                }
 51                return $res;
 52            },
 53        },
 54    )->run($test);
 55
 56    $response->headers->remove_header('Date');
 57    my $data = $response->headers->as_string."\n".$response->content;
 58    is $data, $block->response;
 59
 60    my $response2 = HTTP::Engine->new(
 61        interface => {
 62            module => 'Test',
 63            request_handler => sub {
 64                my $req = shift;
 65                my $res = $res;
 66                return $res unless $body;
 67
 68                return $res unless $upload = $req->upload('test_upload_file');
 69                my $upload_body_with_layer = $upload->slurp(':raw');
 70                unless ($body eq $upload_body_with_layer) {
 71                    $res->body('NG');
 72                }
 73                return $res;
 74            },
 75        },
 76    )->run($test);
 77    $response->headers->remove_header('Date');
 78    $data = $response->headers->as_string."\n".$response->content;
 79    is $data, $block->response;
 80
 81    unless ($body) {
 82        ok 1;
 83        ok 1;
 84        return;
 85    };
 86
 87    my $tmpdir = tempdir( CLEANUP => 1 );
 88    is slurp( copy => $tmpdir => $upload ), $body;
 89    is slurp( link => $tmpdir => $upload ), $body;
 90};
 91
 92sub slurp {
 93    my($action, $tmpdir, $upload) = @_;
 94    my $method = "${action}_to";
 95    my $path = File::Spec->catfile( $tmpdir, $action );
 96    $upload->$method($path);
 97    open my $fh, '<', $path or die $!;
 98    eval { local $/; <$fh> };
 99}
100
101sub crlf {
102    my $in = shift;
103    $in =~ s/\n/\r\n/g;
104    $in;
105}
106
107__END__
108
109===
110--- request yaml
111method: POST
112content: |
113  ------BOUNDARY
114  Content-Disposition: form-data; name="test_upload_file"; filename="yappo.txt"
115  Content-Type: text/plain
116  
117  SHOGUN
118  ------BOUNDARY--
119Content-Type: multipart/form-data; boundary=----BOUNDARY
120Content-Length: 149
121body: SHOGUN
122--- response
123Content-Length: 3
124Content-Type: text/html
125Status: 200
126
127OK!
128===
129--- resquest
130--- response
131Content-Length: 3
132Content-Type: text/html
133Status: 200
134
135OK!