File: 04-psgi.t

package info (click to toggle)
libtest-lwp-useragent-perl 0.036-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 428 kB
  • sloc: perl: 530; makefile: 10
file content (158 lines) | stat: -rw-r--r-- 5,075 bytes parent folder | download | duplicates (2)
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
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
use strict;
use warnings;

use Test::Needs 'HTTP::Message::PSGI';
use Test::More 0.88;
use if $ENV{AUTHOR_TESTING}, 'Test::Warnings';
use Test::Deep;

use Test::LWP::UserAgent;
use Scalar::Util 'refaddr';
use HTTP::Request::Common;

my $app_foo = sub {
    my $env = shift;
    return [ '200', ['Content-Type' => 'text/plain' ], [ 'this is the foo app' ]];
};

my $app_foo2 = sub {
    my $env = shift;
    return [ '200', ['Content-Type' => 'text/html' ], [ 'this is the alternative foo app' ]];
};

my $app_bar = sub {
    my $env = shift;
    return [ '200', ['Content-Type' => 'text/html' ], [ 'this is the bar app' ]];
};

my $app_bar2 = sub {
    my $env = shift;
    return [ '200', ['Content-Type' => 'text/plain' ], [ 'this is the alternative bar app' ]];
};

my $app_baz = sub {
    my $env = shift;
    return [ '200', ['Content-Type' => 'image/jpeg' ], [ 'this is the baz app' ]];
};

{
    my $useragent = Test::LWP::UserAgent->new;
    my $useragent2 = Test::LWP::UserAgent->new;

    Test::LWP::UserAgent->register_psgi('foo', $app_foo);
    $useragent->register_psgi('bar', $app_bar);
    Test::LWP::UserAgent->register_psgi('bar', $app_bar2);
    $useragent2->register_psgi('baz', $app_baz);

    test_send_request('foo app (registered globally)', $useragent, GET('http://foo'),
        '200', [ 'Content-Type' => 'text/plain' ], 'this is the foo app');

    $useragent->register_psgi('foo' , $app_foo2);

    test_send_request('foo app (registered on the object)', $useragent, GET('http://foo'),
        '200', [ 'Content-Type' => 'text/html' ], 'this is the alternative foo app');

    # the object registration takes priority
    test_send_request('bar app (registered on the object)', $useragent, GET(URI->new('http://bar')),
        '200', [ 'Content-Type' => 'text/html' ], 'this is the bar app');

    test_send_request('baz app (registered on the second object)', $useragent2, GET('http://baz'),
        '200', [ 'Content-Type' => 'image/jpeg' ], 'this is the baz app');

    test_send_request('unmatched request', $useragent, GET('http://quux'),
        '404', [ ], '');


    $useragent->unregister_psgi('bar', 'this_instance_only');

    test_send_request('backup bar app is now available to this instance', $useragent, GET('http://bar'),
        '200', [ 'Content-Type' => 'text/plain' ], 'this is the alternative bar app');

    $useragent->unregister_psgi('bar');

    test_send_request('bar app (was registered on the instance, but now removed everywhere)',
        $useragent, GET('http://bar'),
        '404', [ ], '');


    # mask a mapping from just this one instance
    $useragent->unregister_psgi('foo', 'instance_only');

    test_send_request('foo app was registered on both, but now removed from the instance only',
        $useragent, GET('http://foo'),
        '200', [ 'Content-Type' => 'text/plain' ], 'this is the foo app');

    test_send_request('foo app (registered globally; still available for other instances)',
        $useragent2, GET('http://foo'),
        '200', [ 'Content-Type' => 'text/plain' ], 'this is the foo app');

    # mask the global mapping entirely
    $useragent->register_psgi('foo', undef);
    test_send_request('foo app was registered globally, but now removed from the instance only',
        $useragent, GET('http://foo'),
        '404', [ ], '');


    $useragent->unmap_all('this_instance_only');

    test_send_request('baz app is not available on this instance', $useragent, GET('http://baz'),
        '404', [ ], '');

    test_send_request('baz app is still available on other instances', $useragent2, GET('http://baz'),
        '200', [ 'Content-Type' => 'image/jpeg' ], 'this is the baz app');

    $useragent->unmap_all;

    test_send_request('bar app now removed', $useragent, GET('http://baz'),
        '404', [ ], '');

    test_send_request('baz app now removed', $useragent, GET('http://baz'),
        '404', [ ], '');
}

sub test_send_request
{
    my ($name, $useragent, $request, $expected_code, $expected_headers, $expected_content) = @_;

    local $Test::Builder::Level = $Test::Builder::Level + 1;
    note "\n", $name;

    my $response = $useragent->request($request);

    # response is what we stored in the useragent
    isa_ok($response, 'HTTP::Response');
    is(
        refaddr($useragent->last_http_response_received),
        refaddr($response),
        'last_http_response_received',
    );

    cmp_deeply(
        $useragent->last_http_request_sent,
        all(
            isa('HTTP::Request'),
            $request,
        ),
        "$name - request",
    );

    my %header_spec = @$expected_headers;

    cmp_deeply(
        $response,
        methods(
            code => $expected_code,
            ( map +([ header => $_ ] => $header_spec{$_}), keys %header_spec ),
            content => $expected_content,
            request => $useragent->last_http_request_sent,
        ),
        "$name - response",
    );

    ok(
        HTTP::Date::parse_date($response->header('Client-Date')),
        'Client-Date is a timestamp',
    );
}

done_testing;