ACIL FM

Pilih semua

Nama	Ukuran	Aksi
lib	-	Open
00-report-prereqs.dd	3.22 MB	View DL Edit
00-report-prereqs.t	5.79 MB	View DL Edit
add.t	8.61 MB	View DL Edit
cookies_for.t	1.26 MB	View DL Edit
examples.t	1.47 MB	View DL Edit
parse.t	2.64 MB	View DL Edit
publicsuffix.t	3.03 MB	View DL Edit
save.t	2.12 MB	View DL Edit
sort.t	1.47 MB	View DL Edit
zzz-lwp.t	21.79 MB	View DL Edit

Edit file: /home/.cpan/build/HTTP-CookieJar-0.014-0/t/zzz-lwp.t

use 5.008001;
use warnings;
use Test::More 0.96;
use Time::Local;

use HTTP::CookieJar::LWP;
use Test::Requires qw( HTTP::Request HTTP::Response );

#-------------------------------------------------------------------
# First we check that it works for the original example at
# http://curl.haxx.se/rfc/cookie_spec.html

# Client requests a document, and receives in the response:
#
#       Set-Cookie: CUSTOMER=WILE_E_COYOTE; path=/; expires=Wednesday, 09-Nov-99 23:12:40 GMT
#
# When client requests a URL in path "/" on this server, it sends:
#
#       Cookie: CUSTOMER=WILE_E_COYOTE
#
# Client requests a document, and receives in the response:
#
#       Set-Cookie: PART_NUMBER=ROCKET_LAUNCHER_0001; path=/
#
# When client requests a URL in path "/" on this server, it sends:
#
#       Cookie: CUSTOMER=WILE_E_COYOTE; PART_NUMBER=ROCKET_LAUNCHER_0001
#
# Client receives:
#
#       Set-Cookie: SHIPPING=FEDEX; path=/fo
#
# When client requests a URL in path "/" on this server, it sends:
#
#       Cookie: CUSTOMER=WILE_E_COYOTE; PART_NUMBER=ROCKET_LAUNCHER_0001
#
# When client requests a URL in path "/foo" on this server, it sends:
#
#       Cookie: CUSTOMER=WILE_E_COYOTE; PART_NUMBER=ROCKET_LAUNCHER_0001; SHIPPING=FEDEX
#
# The last Cookie is buggy, because both specifications says that the
# most specific cookie must be sent first.  SHIPPING=FEDEX is the
# most specific and should thus be first.

my $year_plus_one = (localtime)[5] + 1900 + 1;

$c = HTTP::CookieJar::LWP->new;

$req = HTTP::Request->new( GET => "http://1.1.1.1/" );
$req->header( "Host", "www.acme.com:80" );

$res = HTTP::Response->new( 200, "OK" );
$res->request($req);
$res->header( "Set-Cookie" =>
      "CUSTOMER=WILE_E_COYOTE; path=/ ; expires=Wednesday, 09-Nov-$year_plus_one 23:12:40 GMT"
);
#;
$c->extract_cookies($res);

$req = HTTP::Request->new( GET => "http://www.acme.com/" );
$c->add_cookie_header($req);

is( $req->header("Cookie"), "CUSTOMER=WILE_E_COYOTE" ) or diag explain $c;

$res->request($req);
$res->header( "Set-Cookie" => "PART_NUMBER=ROCKET_LAUNCHER_0001; path=/" );
$c->extract_cookies($res);

$req = HTTP::Request->new( GET => "http://www.acme.com/foo/bar" );
$c->add_cookie_header($req);

$h = $req->header("Cookie");
ok( $h =~ /PART_NUMBER=ROCKET_LAUNCHER_0001/ );
ok( $h =~ /CUSTOMER=WILE_E_COYOTE/ );

$res->request($req);
$res->header( "Set-Cookie", "SHIPPING=FEDEX; path=/foo" );
$c->extract_cookies($res);

$req = HTTP::Request->new( GET => "http://www.acme.com/" );
$c->add_cookie_header($req);

$h = $req->header("Cookie");
ok( $h =~ /PART_NUMBER=ROCKET_LAUNCHER_0001/ );
ok( $h =~ /CUSTOMER=WILE_E_COYOTE/ );
ok( $h !~ /SHIPPING=FEDEX/ );

$req = HTTP::Request->new( GET => "http://www.acme.com/foo/" );
$c->add_cookie_header($req);

$h = $req->header("Cookie");
ok( $h =~ /PART_NUMBER=ROCKET_LAUNCHER_0001/ );
ok( $h =~ /CUSTOMER=WILE_E_COYOTE/ );
ok( $h =~ /^SHIPPING=FEDEX;/ );

# Second Example transaction sequence:
#
# Assume all mappings from above have been cleared.
#
# Client receives:
#
#       Set-Cookie: PART_NUMBER=ROCKET_LAUNCHER_0001; path=/
#
# When client requests a URL in path "/" on this server, it sends:
#
#       Cookie: PART_NUMBER=ROCKET_LAUNCHER_0001
#
# Client receives:
#
#       Set-Cookie: PART_NUMBER=RIDING_ROCKET_0023; path=/ammo
#
# When client requests a URL in path "/ammo" on this server, it sends:
#
#       Cookie: PART_NUMBER=RIDING_ROCKET_0023; PART_NUMBER=ROCKET_LAUNCHER_0001
#
#       NOTE: There are two name/value pairs named "PART_NUMBER" due to
#       the inheritance of the "/" mapping in addition to the "/ammo" mapping.

$c = HTTP::CookieJar::LWP->new; # clear it

$req = HTTP::Request->new( GET => "http://www.acme.com/" );
$res = HTTP::Response->new( 200, "OK" );
$res->request($req);
$res->header( "Set-Cookie", "PART_NUMBER=ROCKET_LAUNCHER_0001; path=/" );

$c->extract_cookies($res);

$req = HTTP::Request->new( GET => "http://www.acme.com/" );
$c->add_cookie_header($req);

is( $req->header("Cookie"), "PART_NUMBER=ROCKET_LAUNCHER_0001" );

$res->request($req);
$res->header( "Set-Cookie", "PART_NUMBER=RIDING_ROCKET_0023; path=/ammo" );
$c->extract_cookies($res);

$req = HTTP::Request->new( GET => "http://www.acme.com/ammo" );
$c->add_cookie_header($req);

ok( $req->header("Cookie")
      =~ /^PART_NUMBER=RIDING_ROCKET_0023;\s*PART_NUMBER=ROCKET_LAUNCHER_0001/ );

undef($c);

#-------------------------------------------------------------------
# When there are no "Set-Cookie" header, then even responses
# without any request URLs connected should be allowed.

$c = HTTP::CookieJar::LWP->new;
$c->extract_cookies( HTTP::Response->new( "200", "OK" ) );
is( count_cookies($c), 0 );

#-------------------------------------------------------------------
# Then we test with the examples from RFC 2965.
#
# 5.  EXAMPLES

# XXX BUT CONVERT THEM FROM COOKIE2 TO REGULAR COOKIE --xdg

$c = HTTP::CookieJar::LWP->new;

#
# 5.1  Example 1
#
# Most detail of request and response headers has been omitted.  Assume
# the user agent has no stored cookies.
#
#   1.  User Agent -> Server
#
#       POST /acme/login HTTP/1.1
#       [form data]
#
#       User identifies self via a form.
#
#   2.  Server -> User Agent
#
#       HTTP/1.1 200 OK
#       Set-Cookie2: Customer="WILE_E_COYOTE"; Version="1"; Path="/acme"
#
#       Cookie reflects user's identity.

$cookie = interact(
    $c,
    'http://www.acme.com/acme/login',
    'Customer=WILE_E_COYOTE; Path=/acme'
);
ok( !$cookie );

#
#   3.  User Agent -> Server
#
#       POST /acme/pickitem HTTP/1.1
#       Cookie: $Version="1"; Customer="WILE_E_COYOTE"; $Path="/acme"
#       [form data]
#
#       User selects an item for ``shopping basket.''
#
#   4.  Server -> User Agent
#
#       HTTP/1.1 200 OK
#       Set-Cookie2: Part_Number="Rocket_Launcher_0001"; Version="1";
#               Path="/acme"
#
#       Shopping basket contains an item.

$cookie = interact(
    $c,
    'http://www.acme.com/acme/pickitem',
    'Part_Number=Rocket_Launcher_0001; Path=/acme'
);
is( $cookie, "Customer=WILE_E_COYOTE" );

#
#   5.  User Agent -> Server
#
#       POST /acme/shipping HTTP/1.1
#       Cookie: $Version="1";
#               Customer="WILE_E_COYOTE"; $Path="/acme";
#               Part_Number="Rocket_Launcher_0001"; $Path="/acme"
#       [form data]
#
#       User selects shipping method from form.
#
#   6.  Server -> User Agent
#
#       HTTP/1.1 200 OK
#       Set-Cookie2: Shipping="FedEx"; Version="1"; Path="/acme"
#
#       New cookie reflects shipping method.

$cookie =
  interact( $c, "http://www.acme.com/acme/shipping", 'Shipping=FedEx; Path=/acme' );

like( $cookie, qr/Part_Number=Rocket_Launcher_0001/ );
like( $cookie, qr/Customer=WILE_E_COYOTE/ );

#
#   7.  User Agent -> Server
#
#       POST /acme/process HTTP/1.1
#       Cookie: $Version="1";
#               Customer="WILE_E_COYOTE"; $Path="/acme";
#               Part_Number="Rocket_Launcher_0001"; $Path="/acme";
#               Shipping="FedEx"; $Path="/acme"
#       [form data]
#
#       User chooses to process order.
#
#   8.  Server -> User Agent
#
#       HTTP/1.1 200 OK
#
#       Transaction is complete.

$cookie = interact( $c, "http://www.acme.com/acme/process" );
like( $cookie, qr/Shipping=FedEx/ );
like( $cookie, qr/WILE_E_COYOTE/ );

#
# The user agent makes a series of requests on the origin server, after
# each of which it receives a new cookie.  All the cookies have the same
# Path attribute and (default) domain.  Because the request URLs all have
# /acme as a prefix, and that matches the Path attribute, each request
# contains all the cookies received so far.

##;

# 5.2  Example 2
#
# This example illustrates the effect of the Path attribute.  All detail
# of request and response headers has been omitted.  Assume the user agent
# has no stored cookies.

$c = HTTP::CookieJar::LWP->new;

# Imagine the user agent has received, in response to earlier requests,
# the response headers
#
# Set-Cookie2: Part_Number="Rocket_Launcher_0001"; Version="1";
#         Path="/acme"
#
# and
#
# Set-Cookie2: Part_Number="Riding_Rocket_0023"; Version="1";
#         Path="/acme/ammo"

interact(
    $c,
    "http://www.acme.com/acme/ammo/specific",
    'Part_Number=Rocket_Launcher_0001; Path=/acme',
    'Part_Number=Riding_Rocket_0023; Path=/acme/ammo'
);

# A subsequent request by the user agent to the (same) server for URLs of
# the form /acme/ammo/...  would include the following request header:
#
# Cookie: $Version="1";
#         Part_Number="Riding_Rocket_0023"; $Path="/acme/ammo";
#         Part_Number="Rocket_Launcher_0001"; $Path="/acme"
#
# Note that the NAME=VALUE pair for the cookie with the more specific Path
# attribute, /acme/ammo, comes before the one with the less specific Path
# attribute, /acme.  Further note that the same cookie name appears more
# than once.

$cookie = interact( $c, "http://www.acme.com/acme/ammo/..." );
like( $cookie, qr/Riding_Rocket_0023.*Rocket_Launcher_0001/ );

# A subsequent request by the user agent to the (same) server for a URL of
# the form /acme/parts/ would include the following request header:
#
# Cookie: $Version="1"; Part_Number="Rocket_Launcher_0001"; $Path="/acme"
#
# Here, the second cookie's Path attribute /acme/ammo is not a prefix of
# the request URL, /acme/parts/, so the cookie does not get forwarded to
# the server.

$cookie = interact( $c, "http://www.acme.com/acme/parts/" );
ok( $cookie =~ /Rocket_Launcher_0001/ );
ok( $cookie !~ /Riding_Rocket_0023/ );

##;

#-----------------------------------------------------------------------

# Test rejection of Set-Cookie2 responses based on domain, path or port

$c = HTTP::CookieJar::LWP->new;

# XXX RFC 6265 says strip leading dots and embedded dots in prefix are OK
### illegal domain (no embedded dots)
##$cookie = interact($c, "http://www.acme.com", 'foo=bar; domain=.com');
##is(count_cookies($c), 0);

# legal domain
$cookie = interact( $c, "http://www.acme.com", 'foo=bar; domain=acme.com' );
is( count_cookies($c), 1 );

# illegal domain (host prefix "www.a" contains a dot)
$cookie = interact( $c, "http://www.a.acme.com", 'foo=bar; domain=acme.com' );
is( count_cookies($c), 1 );

# legal domain
$cookie = interact( $c, "http://www.a.acme.com", 'foo=bar; domain=.a.acme.com' );
is( count_cookies($c), 2 );

# can't use a IP-address as domain
$cookie = interact( $c, "http://125.125.125.125", 'foo=bar; domain=125.125.125' );
is( count_cookies($c), 2 );

# XXX RFC 6265 doesn't prohibit this; path matching happens on cookie header generation
### illegal path (must be prefix of request path)
##$cookie = interact($c, "http://www.sol.no", 'foo=bar; domain=.sol.no; path=/foo');
##is(count_cookies($c), 2);

# legal path
$cookie =
  interact( $c, "http://www.sol.no/foo/bar", 'foo=bar; domain=.sol.no; path=/foo' );
is( count_cookies($c), 3 );

# XXX ports not part of RFC 6265 standard
### illegal port (request-port not in list)
##$cookie = interact($c, "http://www.sol.no", 'foo=bar; domain=.sol.no; port=90,100');
##is(count_cookies($c), 3);

# legal port
$cookie = interact( $c, "http://www.sol.no",
    'foo=bar; domain=.sol.no; port=90,100, 80,8080; max-age=100; Comment = "Just kidding! (\"|\\\\) "'
);
is( count_cookies($c), 4 );

# port attribute without any value (current port)
$cookie = interact( $c, "http://www.sol.no",
    'foo9=bar; domain=.sol.no; port; max-age=100;' );
is( count_cookies($c), 5 ) or diag explain $c;

# encoded path
$cookie = interact( $c, "http://www.sol.no/foo/", 'foo8=bar; path=/%66oo' );
is( count_cookies($c), 6 );

# XXX not doing save/load
##my $file = "lwp-cookies-$$.txt";
##$c->save($file);
##$old = $c->as_string;
##undef($c);

##$c = HTTP::CookieJar::LWP->new;
##$c->load($file);
##unlink($file) || warn "Can't unlink $file: $!";
##
##is($old, $c->as_string);
##
##undef($c);

#
# Try some URL encodings of the PATHs
#
$c = HTTP::CookieJar::LWP->new;
interact( $c, "http://www.acme.com/foo%2f%25/%40%40%0Anew%E5/%E5", 'foo  =   bar' );
##;
$cookie = interact(
    $c,
    "http://www.acme.com/foo%2f%25/@@%0anewå/æøå",
    "bar=baz; path=/foo/"
);
ok( $cookie =~ /foo=bar/ );
$cookie = interact( $c, "http://www.acme.com/foo/%25/@@%0anewå/æøå" );
ok($cookie);
undef($c);

#
### Try to use the Netscape cookie file format for saving
###
##$file = "cookies-$$.txt";
##$c = HTTP::CookieJar::LWP->new(file => $file);
##interact($c, "http://www.acme.com/", "foo1=bar; max-age=100");
##interact($c, "http://www.acme.com/", "foo2=bar; port=\"80\"; max-age=100; Discard; Version=1");
##interact($c, "http://www.acme.com/", "foo3=bar; secure; Version=1");
##$c->save;
##undef($c);
##
##$c = HTTP::CookieJar::LWP->new(file => $file);
##is(count_cookies($c), 1);     # 2 of them discarded on save
##
##ok($c->as_string =~ /foo1=bar/);
##undef($c);
##unlink($file);

#
# Some additional Netscape cookies test
#
$c = HTTP::CookieJar::LWP->new;
$req = HTTP::Request->new( POST => "http://foo.bar.acme.com/foo" );

# Netscape allows a host part that contains dots
$res = HTTP::Response->new( 200, "OK" );
$res->header( set_cookie => 'Customer=WILE_E_COYOTE; domain=.acme.com' );
$res->request($req);
$c->extract_cookies($res);

# and that the domain is the same as the host without adding a leading
# dot to the domain.  Should not quote even if strange chars are used
# in the cookie value.
$res = HTTP::Response->new( 200, "OK" );
$res->header( set_cookie => 'PART_NUMBER=3,4; domain=foo.bar.acme.com' );
$res->request($req);
$c->extract_cookies($res);

##;

require URI;
$req = HTTP::Request->new( POST => URI->new("http://foo.bar.acme.com/foo") );
$c->add_cookie_header($req);
#;
ok( $req->header("Cookie") =~ /PART_NUMBER=3,4/ );
ok( $req->header("Cookie") =~ /Customer=WILE_E_COYOTE/ );

# XXX the .local mechanism is not in RFC 6265
# Test handling of local intranet hostnames without a dot
##$c->clear;
##print "---\n";
##
##interact($c, "http://example/", "foo1=bar; PORT; Discard;");
##$cookie=interact($c, "http://example/", 'foo2=bar; domain=".local"');
##like($cookie, qr/foo1=bar/);
##
##$cookie=interact($c, "http://example/", 'foo3=bar');
##$cookie=interact($c, "http://example/");
##like($cookie, qr/foo2=bar/);
##is(count_cookies($c), 3);

# Test for empty path
# Broken web-server ORION/1.3.38 returns to the client response like
#
#     Set-Cookie: JSESSIONID=ABCDERANDOM123; Path=
#
# e.g. with Path set to nothing.
# In this case routine extract_cookies() must set cookie to / (root)

$c = HTTP::CookieJar::LWP->new; # clear it

$req = HTTP::Request->new( GET => "http://www.ants.com/" );

$res = HTTP::Response->new( 200, "OK" );
$res->request($req);
$res->header( "Set-Cookie" => "JSESSIONID=ABCDERANDOM123; Path=" );
$c->extract_cookies($res);

$req = HTTP::Request->new( GET => "http://www.ants.com/" );
$c->add_cookie_header($req);

is( $req->header("Cookie"), "JSESSIONID=ABCDERANDOM123" );

# missing path in the request URI
$req = HTTP::Request->new( GET => URI->new("http://www.ants.com:8080") );
$c->add_cookie_header($req);

is( $req->header("Cookie"), "JSESSIONID=ABCDERANDOM123" );

# XXX we don't support Cookie2
### test mixing of Set-Cookie and Set-Cookie2 headers.
### Example from http://www.trip.com/trs/trip/flighttracker/flight_tracker_home.xsl
### which gives up these headers:
###
### HTTP/1.1 200 OK
### Connection: close
### Date: Fri, 20 Jul 2001 19:54:58 GMT
### Server: Apache/1.3.19 (Unix) ApacheJServ/1.1.2
### Content-Type: text/html
### Content-Type: text/html; charset=iso-8859-1
### Link: </trip/stylesheet.css>; rel="stylesheet"; type="text/css"
### Servlet-Engine: Tomcat Web Server/3.2.1 (JSP 1.1; Servlet 2.2; Java 1.3.0; SunOS 5.8 sparc; java.vendor=Sun Microsystems Inc.)
### Set-Cookie: trip.appServer=1111-0000-x-024;Domain=.trip.com;Path=/
### Set-Cookie: JSESSIONID=fkumjm7nt1.JS24;Path=/trs
### Set-Cookie2: JSESSIONID=fkumjm7nt1.JS24;Version=1;Discard;Path="/trs"
### Title: TRIP.com Travel - FlightTRACKER
### X-Meta-Description: Trip.com privacy policy
### X-Meta-Keywords: privacy policy
##
##$req = HTTP::Request->new('GET', 'http://www.trip.com/trs/trip/flighttracker/flight_tracker_home.xsl');
##$res = HTTP::Response->new(200, "OK");
##$res->request($req);
##$res->push_header("Set-Cookie"  => qq(trip.appServer=1111-0000-x-024;Domain=.trip.com;Path=/));
##$res->push_header("Set-Cookie"  => qq(JSESSIONID=fkumjm7nt1.JS24;Path=/trs));
##$res->push_header("Set-Cookie2" => qq(JSESSIONID=fkumjm7nt1.JS24;Version=1;Discard;Path="/trs"));
###;
##
##$c = HTTP::CookieJar::LWP->new;  # clear it
##$c->extract_cookies($res);
##;
##is($c->as_string, <<'EOT');
##Set-Cookie3: trip.appServer=1111-0000-x-024; path="/"; domain=.trip.com; path_spec; discard; version=0
##Set-Cookie3: JSESSIONID=fkumjm7nt1.JS24; path="/trs"; domain=www.trip.com; path_spec; discard; version=1
##EOT

# XXX not implemented yet -- xdg, 2013-02-11
###-------------------------------------------------------------------
### Test if temporary cookies are deleted properly with
### $jar->clear_temporary_cookies()
##
##$req = HTTP::Request->new('GET', 'http://www.perlmeister.com/scripts');
##$res = HTTP::Response->new(200, "OK");
##$res->request($req);
##   # Set session/perm cookies and mark their values as "session" vs. "perm"
##   # to recognize them later
##$res->push_header("Set-Cookie"  => qq(s1=session;Path=/scripts));
##$res->push_header("Set-Cookie"  => qq(p1=perm; Domain=.perlmeister.com;Path=/;expires=Fri, 02-Feb-$year_plus_one 23:24:20 GMT));
##$res->push_header("Set-Cookie"  => qq(p2=perm;Path=/;expires=Fri, 02-Feb-$year_plus_one 23:24:20 GMT));
##$res->push_header("Set-Cookie"  => qq(s2=session;Path=/scripts;Domain=.perlmeister.com));
##$res->push_header("Set-Cookie2" => qq(s3=session;Version=1;Discard;Path="/"));
##
##$c = HTTP::CookieJar::LWP->new;  # clear jar
##$c->extract_cookies($res);
### How many session/permanent cookies do we have?
##my %counter = ("session_after" => 0);
##$c->scan( sub { $counter{"${_[2]}_before"}++ } );
##$c->clear_temporary_cookies();
### How many now?
##$c->scan( sub { $counter{"${_[2]}_after"}++ } );
##is($counter{"perm_after"}, $counter{"perm_before"}); # a permanent cookie got lost accidently
##is($counter{"session_after"}, 0); # a session cookie hasn't been cleared
##is($counter{"session_before"}, 3);  # we didn't have session cookies in the first place
###;

# Test handling of 'secure ' attribute for classic cookies
$c = HTTP::CookieJar::LWP->new;
$req = HTTP::Request->new( GET => "https://1.1.1.1/" );
$req->header( "Host", "www.acme.com:80" );

$res = HTTP::Response->new( 200, "OK" );
$res->request($req);
$res->header( "Set-Cookie" => "CUSTOMER=WILE_E_COYOTE ; secure ; path=/" );
#;
$c->extract_cookies($res);

$req = HTTP::Request->new( GET => "http://www.acme.com/" );
$c->add_cookie_header($req);

ok( !$req->header("Cookie") );

$req->uri->scheme("https");
$c->add_cookie_header($req);

is( $req->header("Cookie"), "CUSTOMER=WILE_E_COYOTE" );

$req = HTTP::Request->new( GET => "ftp://ftp.activestate.com/" );
$c->add_cookie_header($req);
ok( !$req->header("Cookie") );

$req = HTTP::Request->new( GET => "file:/etc/motd" );
$c->add_cookie_header($req);
ok( !$req->header("Cookie") );

$req = HTTP::Request->new( GET => "mailto:gisle\@aas.no" );
$c->add_cookie_header($req);
ok( !$req->header("Cookie") );

# Test cookie called 'expires' <https://rt.cpan.org/Ticket/Display.html?id=8108>
$c      = HTTP::CookieJar::LWP->new;
$cookie = interact( $c, "http://example.com/", 'Expires=10101' );
$cookie = interact( $c, "http://example.com/" );
is( $cookie, 'Expires=10101' ) or diag explain $c;

# Test empty cookie header [RT#29401]
$c = HTTP::CookieJar::LWP->new;
$cookie =
  interact( $c, "http://example.com/", "CUSTOMER=WILE_E_COYOTE; path=/;", "" );
is( count_cookies($c), 1, "empty cookie not set" );

# Test empty cookie part [RT#38480]
$c      = HTTP::CookieJar::LWP->new;
$cookie = interact( $c, "http://example.com/", "CUSTOMER=WILE_E_COYOTE;;path=/;" );
$cookie = interact( $c, "http://example.com/" );
like( $cookie, qr/CUSTOMER=WILE_E_COYOTE/, "empty attribute ignored" );

# Test Set-Cookie with version set
$c      = HTTP::CookieJar::LWP->new;
$cookie = interact( $c, "http://example.com/", "foo=\"bar\";version=1" );
$cookie = interact( $c, "http://example.com/" );
is( $cookie, "foo=\"bar\"", "version ignored" );

# Test cookies that expire far into the future [RT#50147] ( or past ? )
# if we can't do far future, use 2037
my $future = eval { timegm( 1, 2, 3, 4, 5, 2039 ) } ? 2211 : 2037;

$c = HTTP::CookieJar::LWP->new;
interact(
    $c,
    "http://example.com/foo",
    "PREF=ID=cee18f7c4e977184:TM=1254583090:LM=1254583090:S=Pdb0-hy9PxrNj4LL; expires=Mon, 03-Oct-$future 15:18:10 GMT; path=/; domain=.example.com",
    "expired1=1; expires=Mon, 03-Oct-2001 15:18:10 GMT; path=/; domain=.example.com",
    "expired2=1; expires=Fri Jan  1 00:00:00 GMT 1970; path=/; domain=.example.com",
    "expired3=1; expires=Fri Jan  1 00:00:01 GMT 1970; path=/; domain=.example.com",
    "expired4=1; expires=Thu Dec 31 23:59:59 GMT 1969; path=/; domain=.example.com",
    "expired5=1; expires=Fri Feb  2 00:00:00 GMT 1950; path=/; domain=.example.com",
);
$cookie = interact( $c, "http://example.com/foo" );

is(
    $cookie,
    "PREF=ID=cee18f7c4e977184:TM=1254583090:LM=1254583090:S=Pdb0-hy9PxrNj4LL",
    "far future and past"
) or diag explain $c;

# Test merging of cookies
$c = HTTP::CookieJar::LWP->new;
interact( $c, "http://example.com/foo/bar", "foo=1" );
interact( $c, "http://example.com/foo",     "foo=2; path=/" );
$cookie = interact( $c, "http://example.com/foo/bar" );
is( $cookie, "foo=1; foo=2", "merging cookies" );

#-------------------------------------------------------------------

sub interact {
    my $c   = shift;
    my $url = shift;
    my $req = HTTP::Request->new( POST => $url );
    $c->add_cookie_header($req);
    my $cookie = $req->header("Cookie");
    my $res = HTTP::Response->new( 200, "OK" );
    $res->request($req);
    for (@_) { $res->push_header( "Set-Cookie" => $_ ) }
    $c->extract_cookies($res);
    return $cookie;
}

sub count_cookies {
    my $c = shift;
    return scalar $c->_all_cookies;
}

done_testing;
#
# This file is part of HTTP-CookieJar
#
# This software is Copyright (c) 2013 by David Golden.
#
# This is free software, licensed under:
#
#   The Apache License, Version 2.0, January 2004
#

Batal

Isi Zip:

Create