use v6-alpha;
use Test;
my $tempfile = 'temp-ex-output';
# Change the URLs to something better/different
my @urls = <
%s/
%s
%s/index.html
>;
my @live_urls;
if (%*ENV{"PUGS_TESTS_ALLOW_NETWORK"}) {
# Need to get some easily validated stuff here
@live_urls = <
http://www.corion.net
http://datenzoo.de
http://datenzoo.de/
http://datenzoo.de/index.html
>;
};
plan 2+@urls*10+@live_urls*8;
use LWP::Simple; pass "(dummy instead of broken use_ok)";
my $expected = "Hello from Pugs";
# Spawn a local proxy server
sub spawn_server (Int $port) {
my $port = $port || 8086;
diag "Spawning proxy on port $port";
my $sock = listen($port);
my $url = "http://localhost:$port";
ok(defined $sock, "Listening on $url");
async {
#diag "Spawned server";
while (1) {
my $hdl = $sock.accept;
my $request = =$hdl;
$request ~~ s:P5/\s+$//;
#diag $request;
if ($request ~~ rx:P5"^GET /stop-server/") {
$hdl.close;
last();
};
while (readline($hdl) ~~ rx:P5/\S/) { 1 };
$hdl.print( "HTTP/1.0 200 OK\r\n"
~ "Content-Type: text/plain; charset=UTF-8\r\n"
~ "Server: Fake local Pugs HTTPd\r\n"
~ "X-Original-Request: $request\r\n"
~ "\r\n"
~ $expected );
$hdl.flush();
$hdl.close;
};
};
$url;
};
my $base_url = spawn_server( 8086 );
for @urls -> $t_url {
my $url = $t_url;
$url ~~ s:P5/%s/$base_url/;
diag "Getting HEAD of $url";
my $head = head($url);
ok($head ~~ m:P5/.../, "Got some headers as scalar");
my @head = head($url);
ok(@head > 3, "Got more than 1 line as list");
my %head = head($url);
ok(%head.keys() > 3, "Got some headers as hash", );
is(%head{'Content-Type'}, "text/plain; charset=UTF-8", "Got a content type of text/plain", );
diag "Retrieving $url";
my $res = get($url);
ok(defined $res, "Got some result");
ok($res.chars, "and it's not empty");
is( chars($res), chars($expected), "The response has the correct length");
# TODO: Add a check against Content-Length, once it's implemented
is( $res, $expected, "Got the correct response");
diag "Storing $url to $tempfile";
my $f = getstore($url,$tempfile);
my $buf = slurp $tempfile;
is( $buf, $res, "... and contains $url");
is( $f, $res, "... and getstore() returns $url");
};
get("$base_url/stop-server/");
for @live_urls -> $url {
diag "Getting HEAD of $url";
my $head = head($url);
ok( $head ~~ rx:P5/.../, "Got some headers as scalar");
my @head = head($url);
todo_ok( @head > 3, "Got more than 1 line as list");
my %head = head($url);
todo_ok( %head.keys() > 3, "Got some headers as hash");
todo_is( %head{'Content-Type'}, "text/html", "Got a content type of text/html");
diag "Retrieving $url";
my $res = get($url);
ok(defined $res, "Got some result");
ok( defined ($res ~~ rx:P5/./), "and it's not empty");
# TODO: Uncomment once length() is implemented
# is( length($res), length($expected), "The response has the correct length");
# TODO: Add a check against Content-Length, once it's implemented
diag "Storing $url to $tempfile";
my $f = getstore($url,$tempfile);
my $buf = slurp $tempfile;
is( $buf, $res, "... and contains $url");
is( $f, $res, "... and getstore() returns $url");
};
unlink $tempfile;