view release on metacpan or  search on metacpan

t/headers.t  view on Meta::CPAN

#!perl -T

use strict;
use warnings;
use Test::More tests => 26;
use Test::Builder::Tester;

use lib 't';
use TestServer;

my $server      = TestServer->new;
my $pid         = $server->background;
my $server_root = $server->root;

use Test::WWW::Mechanize ();

my $mech = do {
    local @ENV{qw( http_proxy HTTP_PROXY )};
    Test::WWW::Mechanize->new( autocheck => 0 );
};
isa_ok($mech,'Test::WWW::Mechanize');
$mech->get_ok( "$server_root/form.html" );

GOOD_EXISTS: {
    test_out( 'ok 1 - Has Content-Type' );
    my $ok = $mech->header_exists_ok('Content-Type', 'Has Content-Type');
    test_test( 'Gets existing header and reports success' );
    is( ref($ok), '', 'get_ok() should only return a scalar' );
    ok( $ok, 'And the result should be true' );

    # default desc
    test_out( 'ok 1 - Response has Content-Type header' );
    $mech->header_exists_ok('Content-Type');
    test_test( 'Gets existing header and reports success - default desc' );
}

BAD_EXISTS: {
    test_out( 'not ok 1 - Try to get a bad header' );
    test_fail( +1 );
    my $ok = $mech->header_exists_ok('Server', 'Try to get a bad header');
    test_test( 'Fails to get nonexistent header and reports failure' );

    is( ref($ok), '', 'get_ok() should only return a scalar' );
    ok( !$ok, 'And the result should be false' );
}

GOOD_LACKS: {
    test_out( 'ok 1 - Lacks Bongotronic-X' );
    my $ok = $mech->lacks_header_ok( 'Bongotronic-X', 'Lacks Bongotronic-X' );
    test_test( 'Gets existing header and reports success' );
    is( ref($ok), '', 'get_ok() should only return a scalar' );
    ok( $ok, 'And the result should be true' );

    test_out( 'ok 1 - Response lacks Bongotronic-X header' );
    $mech->lacks_header_ok( 'Bongotronic-X' );
    test_test( 'Gives reasonable default to lacks_header_ok' );
}

BAD_LACKS: {
    test_out( 'not ok 1 - Hoping Content-Type is missing' );
    test_fail( +1 );
    my $ok = $mech->lacks_header_ok( 'Content-Type', 'Hoping Content-Type is missing' );
    test_test( 'The header we expected to lack is indeed there.' );

    is( ref($ok), '', 'get_ok() should only return a scalar' );
    ok( !$ok, 'And the result should be false' );
}

GOOD_IS: {
    test_out( 'ok 1 - Content-Type is "text/html"' );
    my $ok = $mech->header_is('Content-Type', 'text/html', 'Content-Type is "text/html"');
    test_test( 'Matches existing header and reports success' );
    is( ref($ok), '', 'get_ok() should only return a scalar' );
    ok( $ok, 'And the result should be true' );

    # default desc
    test_out( 'ok 1 - Response has Content-Type header with value "text/html"' );
    $mech->header_is('Content-Type', 'text/html');