File: cookies.t

package info (click to toggle)
libwww-mechanize-perl 2.03-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, sid
  • size: 988 kB
  • sloc: perl: 4,088; makefile: 6
file content (129 lines) | stat: -rw-r--r-- 3,049 bytes parent folder | download | duplicates (3)
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
# 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] );
}