t/redirect.t

   1 #!perl
   2 use strict;
   3 use warnings;
   4 use lib 'lib';
   5 use Test::More;
   6 use lib 't/lib';
   7 use Test::WWW::Mechanize::Catalyst 'Catty';
   8 use HTTP::Request::Common;
   9 use URI;
  10 use Test::utf8;
  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" );
  36
  37 $m->get("$root/redirect_with_500");
  38 is ($m->status, 500, "Redirect not followed on 500");
  39
  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);
  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