Commit | Line | Data |
affa35d5 |
1 | #!perl |
6bc86362 |
2 | use strict; |
3 | use warnings; |
4 | use lib 'lib'; |
60f2b4d9 |
5 | use Test::More; |
6bc86362 |
6 | use lib 't/lib'; |
7 | use Test::WWW::Mechanize::Catalyst 'Catty'; |
705f22fa |
8 | use HTTP::Request::Common; |
9 | use URI; |
10 | use Test::utf8; |
6bc86362 |
11 | |
12 | my $root = "http://localhost"; |
13 | |
14 | my $m; |
15 | foreach my $where (qw{hi greetings bonjour}) { |
16 | $m = Test::WWW::Mechanize::Catalyst->new; |
17 | $m->get_ok( "$root/$where", "got something when we $where" ); |
18 | |
19 | is( $m->base, "http://localhost/hello", "check got to hello 1/4" ); |
20 | is( $m->ct, "text/html", "check got to hello 2/4" ); |
21 | $m->title_is( "Hello",, "check got to hello 3/4" ); |
22 | $m->content_contains( "Hi there",, "check got to hello 4/4" ); |
23 | |
24 | # check that the previous response is still there |
25 | my $prev = $m->response->previous; |
26 | ok( $prev, "have a previous" ); |
27 | is( $prev->code, 302, "was a redirect" ); |
28 | like( $prev->header('Location'), '/hello$/', "to the right place" ); |
29 | } |
30 | |
31 | # extra checks for bonjour (which is a double redirect) |
32 | my $prev = $m->response->previous->previous; |
33 | ok( $prev, "have a previous previous" ); |
34 | is( $prev->code, 302, "was a redirect" ); |
35 | like( $prev->header('Location'), '/hi$/', "to the right place" ); |
affa35d5 |
36 | |
37 | $m->get("$root/redirect_with_500"); |
38 | is ($m->status, 500, "Redirect not followed on 500"); |
74649ca9 |
39 | |
705f22fa |
40 | my $req = GET "$root/redirect_to_utf8_upgraded_string"; |
41 | my $loc = $m->_do_catalyst_request($req)->header('Location'); |
42 | my $uri = URI->new_abs( $loc, $req->uri )->as_string; |
43 | is_sane_utf8($uri); |
44 | isnt_flagged_utf8($uri); |
60f2b4d9 |
45 | |
46 | # Check for max_redirects support |
47 | { |
48 | $m = Test::WWW::Mechanize::Catalyst->new(max_redirect => 1); |
49 | is( $m->max_redirect, 1, 'max_redirect set' ); |
50 | |
51 | $m->get( "$root/bonjour" ); |
52 | ok( !$m->success, "get /bonjour with max_redirect=1 is not a success" ); |
53 | is( $m->response->redirects, 1, 'redirects only once' ); |
54 | like( $m->response->header('Client-Warning'), qr/Redirect loop detected/i, |
55 | 'sets Client-Warning header' ); |
56 | } |
57 | |
58 | # Make sure we can handle max_redirects=0 |
59 | { |
60 | $m = Test::WWW::Mechanize::Catalyst->new(max_redirect => 0); |
61 | $m->get( "$root/hello" ); |
62 | ok( $m->success, "get /hello with max_redirect=0 succeeds" ); |
63 | is( $m->response->redirects, 0, 'no redirects' ); |
64 | ok( !$m->response->header('Client-Warning'), 'no Client-Warning header' ); |
65 | |
66 | # shouldn't be redirected if max_redirect == 0 |
67 | $m->get( "$root/bonjour" ); |
68 | ok( !$m->success, "get /bonjour with max_redirect=0 is not a success" ); |
69 | is( $m->response->redirects, 0, 'no redirects' ); |
70 | like( $m->response->header('Client-Warning'), qr/Redirect loop detected/i, |
71 | 'sets Client-Warning header' ); |
72 | } |
73 | |
74 | done_testing; |
75 | |