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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
#!/usr/bin/perl -w
# XXX add cookie reading on the server side to the test
BEGIN { delete @ENV{ qw( http_proxy HTTP_PROXY ) }; }
use warnings;
use strict;
use Test::More;
if ( $^O =~ /Win32/ ) {
plan skip_all => 'HTTP::Server::Simple does not support Windows yet.';
}
else {
plan tests => 14;
}
use WWW::Mechanize;
use URI::Escape qw( uri_unescape );
use lib 't/';
use TestServer;
my $ncookies = 0;
sub send_cookies {
my $cgi = shift;
return if !ref $cgi;
++$ncookies;
print
$cgi->header(
-cookie => $cgi->cookie(
-name => 'my_cookie',
-value => "Cookie #$ncookies",
-domain => '127.0.0.1',
-path => '/',
-expires => '+1h',
-secure => 0,
)
),
$cgi->start_html( -title => "Home of Cookie #$ncookies" ),
$cgi->h1( "Here is Cookie #$ncookies" ),
$cgi->end_html;
}
sub nosend_cookies {
my $cgi = shift;
return if !ref $cgi;
print
$cgi->header(),
$cgi->start_html( -title => 'No cookies sent' ),
$cgi->h1( 'No cookies sent' ),
$cgi->end_html;
}
my $server = TestServer->new();
$server->set_dispatch( {
'/feedme' => \&send_cookies,
'/nocookie' => \&nosend_cookies,
} );
my $pid = $server->background();
my $root = $server->root;
my $cookiepage_url = "$root/feedme";
my $nocookiepage_url = "$root/nocookie";
my $mech = WWW::Mechanize->new( autocheck => 0 );
isa_ok( $mech, 'WWW::Mechanize' );
FIRST_COOKIE: {
$mech->get( $cookiepage_url );
is( $mech->status, 200, 'First fetch works' );
my $cookieval = cookieval( $mech );
is( $cookieval, 'Cookie #1', 'First cookie matches' );
is( $mech->title, 'Home of Cookie #1', 'Right title' );
}
SECOND_COOKIE: {
$mech->get( $cookiepage_url );
is( $mech->status, 200, 'Second fetch works' );
my $cookieval = cookieval( $mech );
is( $cookieval, 'Cookie #2', 'Second cookie matches' );
is( $mech->title, 'Home of Cookie #2', 'Right title' );
}
BACK_TO_FIRST_PAGE: {
$mech->back();
my $cookieval = cookieval( $mech );
is( $cookieval, 'Cookie #2', 'Cookie did not change...' );
is( $mech->title, 'Home of Cookie #1', '... but back to the first page title' );
}
FORWARD_TO_NONCOOKIE_PAGE: {
$mech->get( $nocookiepage_url );
my $cookieval = cookieval( $mech );
is( $cookieval, 'Cookie #2', 'Cookie did not change...' );
is( $mech->title, 'No cookies sent', 'On the proper 3rd page' );
}
GET_A_THIRD_COOKIE: {
$mech->get( $cookiepage_url );
my $cookieval = cookieval( $mech );
is( $cookieval, 'Cookie #3', 'Got the third cookie' );
is( $mech->title, 'Home of Cookie #3', 'Title is correct' );
}
my $signal = ($^O eq 'MSWin32') ? 9 : 15;
my $nprocesses = kill $signal, $pid;
is( $nprocesses, 1, 'Signaled the child process' );
sub cookieval {
my $mech = shift;
return uri_unescape( $mech->cookie_jar->{COOKIES}{'127.0.0.1'}{'/'}{'my_cookie'}[1] );
}
|
