1# XXX add cookie reading on the server side to the test
2
3BEGIN { delete @ENV{ qw( http_proxy HTTP_PROXY ) }; }
4
5use warnings;
6use strict;
7use Test::More;
8
9if ( $^O =~ /Win32/ ) {
10    plan skip_all => 'HTTP::Server::Simple does not support Windows yet.';
11}
12else {
13    plan tests => 14;
14}
15
16use WWW::Mechanize;
17use URI::Escape qw( uri_unescape );
18
19use lib 't/';
20use TestServer;
21
22my $ncookies = 0;
23
24sub send_cookies {
25    my $cgi = shift;
26    return if !ref $cgi;
27
28    ++$ncookies;
29
30    print
31        $cgi->header(
32            -cookie => $cgi->cookie(
33                -name    => 'my_cookie',
34                -value   => "Cookie #$ncookies",
35                -domain  => '127.0.0.1',
36                -path    => '/',
37                -expires => '+1h',
38                -secure  => 0,
39            )
40        ),
41        $cgi->start_html( -title => "Home of Cookie #$ncookies" ),
42        $cgi->h1( "Here is Cookie #$ncookies" ),
43        $cgi->end_html;
44}
45
46sub nosend_cookies {
47    my $cgi = shift;
48    return if !ref $cgi;
49
50    print
51        $cgi->header(),
52        $cgi->start_html( -title => 'No cookies sent' ),
53        $cgi->h1( 'No cookies sent' ),
54        $cgi->end_html;
55}
56
57my $server = TestServer->new();
58$server->set_dispatch( {
59    '/feedme'   => \&send_cookies,
60    '/nocookie' => \&nosend_cookies,
61} );
62my $pid = $server->background();
63
64my $root             = $server->root;
65
66my $cookiepage_url   = "$root/feedme";
67my $nocookiepage_url = "$root/nocookie";
68
69my $mech = WWW::Mechanize->new( autocheck => 0 );
70isa_ok( $mech, 'WWW::Mechanize' );
71
72FIRST_COOKIE: {
73    $mech->get( $cookiepage_url );
74    is( $mech->status, 200, 'First fetch works' );
75
76    my $cookieval = cookieval( $mech );
77
78    is( $cookieval, 'Cookie #1', 'First cookie matches' );
79    is( $mech->title, 'Home of Cookie #1', 'Right title' );
80}
81
82SECOND_COOKIE: {
83    $mech->get( $cookiepage_url );
84    is( $mech->status, 200, 'Second fetch works' );
85
86    my $cookieval = cookieval( $mech );
87
88    is( $cookieval, 'Cookie #2', 'Second cookie matches' );
89    is( $mech->title, 'Home of Cookie #2', 'Right title' );
90}
91
92BACK_TO_FIRST_PAGE: {
93    $mech->back();
94
95    my $cookieval = cookieval( $mech );
96
97    is( $cookieval, 'Cookie #2', 'Cookie did not change...' );
98    is( $mech->title, 'Home of Cookie #1', '... but back to the first page title' );
99}
100
101FORWARD_TO_NONCOOKIE_PAGE: {
102    $mech->get( $nocookiepage_url );
103
104    my $cookieval = cookieval( $mech );
105
106    is( $cookieval, 'Cookie #2', 'Cookie did not change...' );
107    is( $mech->title, 'No cookies sent', 'On the proper 3rd page' );
108}
109
110GET_A_THIRD_COOKIE: {
111    $mech->get( $cookiepage_url );
112
113    my $cookieval = cookieval( $mech );
114
115    is( $cookieval, 'Cookie #3', 'Got the third cookie' );
116    is( $mech->title, 'Home of Cookie #3', 'Title is correct' );
117}
118
119
120my $signal = ($^O eq 'MSWin32') ? 9 : 15;
121my $nprocesses = kill $signal, $pid;
122is( $nprocesses, 1, 'Signaled the child process' );
123
124
125sub cookieval {
126    my $mech = shift;
127
128    return uri_unescape( $mech->cookie_jar->{COOKIES}{'127.0.0.1'}{'/'}{'my_cookie'}[1] );
129}
130