File: 01-netasync.t

package info (click to toggle)
libfuture-http-perl 0.17-2
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 276 kB
  • sloc: perl: 1,320; makefile: 2
file content (68 lines) | stat: -rw-r--r-- 1,821 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
#!perl -w
use strict;
use warnings;
use Data::Dumper;

use Test::More;
use Test::HTTP::LocalServer;

my $ok = eval {
    require Net::Async::HTTP;
	require Future::HTTP::NetAsync;
    1;
};
my $err = $@;
if( !$ok) {
    plan skip_all => "Couldn't load Net::Async::HTTP: $err";
    exit;
};
plan tests => 11;


delete @ENV{ qw[
    HTTP_PROXY
    http_proxy
    HTTP_PROXY_ALL
    http_proxy_all
    HTTPS_PROXY
    https_proxy
    CGI_HTTP_PROXY
    ALL_PROXY
    all_proxy
] };

diag( "Version of Net::Async::HTTP: " . Net::Async::HTTP->VERSION );

my $server = Test::HTTP::LocalServer->spawn(
    #debug => 1
);

my $ua = Future::HTTP::NetAsync->new();
ok $ua->is_async, 'is_async is true';
my $url = $server->url;

my ($body,$headers) = $ua->http_get($url)->get;
like $headers->{Status}, qr/2../, "Retrieve URL using Net::Async::HTTP backend";
is $headers->{URL}, $server->url, "We arrive at the expected URL"
    or diag Dumper $headers;

my $u = $server->redirect( 'foo' );
($body,$headers) = $ua->http_get($u)->get;
like $headers->{Status}, qr/2../, "Retrieve URL using redirect for a single redirection";
is $headers->{URL}, $url . 'foo', "We arrive at the expected URL"
    or diag Dumper $headers;
ok exists $headers->{Redirect}, "We were redirected here";
ok !exists $headers->{Redirect}->[1]->{Redirect}, "... once";

$u = $server->redirect( 'redirect/foo' );
($body,$headers) = $ua->http_get($u)->get;
like $headers->{Status}, qr/2../, "Retrieve URL using redirect for a double redirection";
is $headers->{URL}, $url . 'foo', "We arrive at the expected URL"
    or diag Dumper $headers;
ok exists $headers->{Redirect}, "We were redirected here";
is $headers->{Redirect}->[1]->{Redirect}->[1]->{URL}, $u, "... twice, starting from $u"
  or diag Dumper $headers->{Redirect}->[1];

$server->stop;

done_testing;