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
|
use warnings;
use strict;
use FindBin ();
use Test::More tests => 14;
use Test::Memory::Cycle;
BEGIN {
delete @ENV{qw( IFS CDPATH ENV BASH_ENV )};
use_ok('WWW::Mechanize');
}
our $server;
my $agent = WWW::Mechanize->new();
isa_ok( $agent, 'WWW::Mechanize' );
SKIP: {
# We want to be safe from non-resolving local host names
delete $ENV{HTTP_PROXY};
# Now start a fake webserver, fork, and connect to ourselves
my $command = qq'"$^X" "$FindBin::Bin/referer-server"';
if ( $^O eq 'VMS' ) {
$command = qq'mcr $^X t/referer-server';
}
open $server, "$command |" or die "Couldn't spawn fake server: $!";
sleep 1; # give the child some time
my $url = <$server>;
chomp $url;
$agent->get($url);
is( $agent->status, 200, 'Got first page' ) or diag $agent->res->message;
is(
$agent->content, q{Referer: ''},
'First page gets sent with empty referrer'
);
$agent->get($url);
is( $agent->status, 200, 'Got second page' ) or diag $agent->res->message;
is(
$agent->content, "Referer: '$url'",
'Referer got sent for absolute url'
);
$agent->get('.');
is( $agent->status, 200, 'Got third page' ) or diag $agent->res->message;
is(
$agent->content, "Referer: '$url'",
'Referer got sent for relative url'
);
$agent->add_header( Referer => 'x' );
$agent->get($url);
is( $agent->status, 200, 'Got fourth page' ) or diag $agent->res->message;
is(
$agent->content, q{Referer: 'x'},
'Referer can be set to empty again'
);
my $ref = 'This is not the referer you are looking for *jedi gesture*';
$agent->add_header( Referer => $ref );
$agent->get($url);
is( $agent->status, 200, 'Got fourth page' ) or diag $agent->res->message;
is( $agent->content, "Referer: '$ref'", 'Custom referer can be set' );
$agent->get( $url . 'quit_server' );
ok( $agent->success, 'Quit OK' );
}
memory_cycle_ok( $agent, 'No memory cycles found' );
END {
close $server if $server;
}
|
