Dogcows Code - chaz/p5-HTTP-AnyUA/blob - t/22-redirects.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 => 29;
  18
  19     my $ua      = shift;
  20     my $any_ua  = HTTP::AnyUA->new($ua, response_is_future => 1);
  21
  22     # enable redirects for useragents that don't do it by default
  23     if ($ua->isa('Mojo::UserAgent')) {
  24         $ua->max_redirects(5);
  25     }
  26     elsif ($ua->isa('Net::Curl::Easy')) {
  27         $ua->setopt(Net::Curl::Easy::CURLOPT_FOLLOWLOCATION(), 1);
  28     }
  29
  30     my $path    = '/foo';
  31     my $url     = $server->url . $path;
  32     my $future  = $any_ua->get($url);
  33
  34     $future->on_ready(sub {
  35         my $self    = shift;
  36         my $resp    = $self->is_done ? $self->get : $self->failure;
  37         my $env     = $server->read_env;
  38
  39         note explain 'RESPONSE: ', $resp;
  40         note explain 'ENV: ', $env;
  41
  42         SKIP: {
  43             skip 'unexpected env', 3 if ref($env) ne 'HASH';
  44             is($env->{REQUEST_METHOD}, 'GET', 'correct method sent');
  45             is($env->{REQUEST_URI}, '/baz', 'correct url sent');
  46             is($env->{content}, '', 'no body sent');
  47         }
  48
  49         is_response_content($resp, 'you found it');
  50         is_response_reason($resp, 'OK');
  51         is_response_status($resp, 200);
  52         is_response_success($resp, 1);
  53         TODO: {
  54             local $TODO = 'some user agents do not support this correctly';
  55             # Furl has the URL from the original request, not the last request
  56             is_response_url($resp, $server->url . '/baz');
  57         };
  58         is_response_header($resp, 'content-type', 'text/plain');
  59         is_response_header($resp, 'content-length', 12);
  60         response_protocol_ok($resp);
  61
  62         SKIP: {
  63             skip 'no redirect chain', 18 if !$resp || !$resp->{redirects};
  64
  65             my $chain = $resp->{redirects};
  66             isa_ok($chain, 'ARRAY', 'redirect chain');
  67             is(scalar @$chain, 2, 'redirect chain has two redirections');
  68
  69             my $r1 = $chain->[0];
  70             is_response_content($r1, 'the thing you seek is not here');
  71             is_response_reason($r1, 'Found');
  72             is_response_status($r1, 302);
  73             is_response_success($r1, 0);
  74             is_response_url($r1, $server->url . '/foo');
  75             is_response_header($r1, 'content-type', 'text/plain');
  76             is_response_header($r1, 'content-length', 30);
  77             response_protocol_ok($r1);
  78
  79             my $r2 = $chain->[1];
  80             is_response_content($r2, 'not here either');
  81             is_response_reason($r2, 'Moved Permanently');
  82             is_response_status($r2, 301);
  83             is_response_success($r2, 0);
  84             is_response_url($r2, $server->url . '/bar');
  85             is_response_header($r2, 'content-type', 'text/plain');
  86             is_response_header($r2, 'content-length', 15);
  87             response_protocol_ok($r2);
  88         }
  89     });
  90
  91     return $future;
  92 };
  93