Dogcows Code - chaz/p5-HTTP-AnyUA/blob - t/12-put.t

   1 #!perl
   2
   3 use warnings;
   4 use strict;
   5
   6 use lib 't/lib';
   7
   8 use HTTP::AnyUA;
   9 use Test::More;
  10 use Util qw(:server :test :ua);
  11
  12 my $server = start_server('t/app.psgi');
  13
  14 plan tests => scalar user_agents;
  15
  16 test_all_user_agents {
  17     plan tests => 9;
  18
  19     my $ua      = shift;
  20     my $any_ua  = HTTP::AnyUA->new(ua => $ua, response_is_future => 1);
  21
  22     my $path    = '/modify-document';
  23     my $url     = $server->url . $path;
  24     my $future  = $any_ua->put($url, {
  25         headers => {'content-type' => 'text/plain'},
  26         content => 'some document',
  27     });
  28
  29     $future->on_ready(sub {
  30         my $self    = shift;
  31         my $resp    = $self->is_done ? $self->get : $self->failure;
  32         my $env     = $server->read_env;
  33
  34         note explain 'RESPONSE: ', $resp;
  35         note explain 'ENV: ', $env;
  36
  37         SKIP: {
  38             skip 'unexpected env', 3 if ref($env) ne 'HASH';
  39             is($env->{REQUEST_METHOD}, 'PUT', 'correct method sent');
  40             is($env->{REQUEST_URI}, $path, 'correct url sent');
  41             is($env->{content}, 'some document', 'correct body sent');
  42         }
  43
  44         is_response_reason($resp, 'No Content');
  45         is_response_status($resp, 204);
  46         is_response_success($resp, 1);
  47         is_response_url($resp, $url);
  48         response_protocol_ok($resp);
  49
  50         my $body = ref($resp) eq 'HASH' && $resp->{content};
  51         ok(!$body, 'response body is empty');
  52     });
  53
  54     return $future;
  55 };
  56