File: 22http.t

package info (click to toggle)
libhttp-proxy-perl 0.19-1
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 456 kB
  • ctags: 119
  • sloc: perl: 2,278; makefile: 36
file content (54 lines) | stat: -rw-r--r-- 1,365 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
use strict;
use vars qw( @requests );

# here are all the requests the client will try
BEGIN {
    @requests = (
        [ 'http://www.mongueurs.net/',    200 ],
        [ 'http://httpd.apache.org/docs', 301 ],
        [ 'http://www.google.com/testing/', 404 ],
        [ 'http://www.error.zzz/',        500 ],
    );
}

use Test::More tests => @requests + 1;
use t::Utils;
use LWP::UserAgent;
use HTTP::Proxy;

# we skip the tests if the network is not available

SKIP: {
    skip "Web does not seem to work", @requests + 1 unless web_ok();

    my $test = Test::Builder->new;

    # this is to work around tests in forked processes
    $test->use_numbers(0);
    $test->no_ending(1);

    my $proxy = HTTP::Proxy->new( port => 0, max_connections => scalar @requests );
    $proxy->init;    # required to access the url later

    # fork a HTTP proxy
    my $pid = fork_proxy(
        $proxy,
        sub {
            ok( $proxy->conn == @requests,
                "Served the correct number of requests" );
        }
    );

    # run a client
    my $ua = LWP::UserAgent->new;
    $ua->proxy( http => $proxy->url );

    for (@requests) {
        my $req = HTTP::Request->new( GET => $_->[0] );
        my $rep = $ua->simple_request($req);
        is( $rep->code, $_->[1], "Got an answer (@{[$rep->code]})" );
    }

    # make sure the kid is dead
    wait;
}