/t/020_interface/test_upload.t

http://github.com/http-engine/HTTP-Engine · Raku · 135 lines · 117 code · 18 blank · 0 comment · 13 complexity · 9b705acb0e9134b83801419c066a29b0 MD5 · raw file

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