The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/env perl

use Test::More;
use File::Basename;
use lib File::Basename::dirname(__FILE__)."/../../../../lib";
use lib File::Basename::dirname(__FILE__)."/../../..";
use UR;
use strict;
use warnings;

use IO::Socket;
use HTTP::Request;
use File::Temp;
use Plack::Util;

plan tests => 43;

# Test out the lazy host and port methods
{
    my $srv = UR::Service::WebServer->create();
    ok($srv, 'Created WebServer service');
    $srv->dump_status_messages(0);
    $srv->queue_status_messages(1);

    is($srv->port(12345), 12345, 'Can change port before socket is created');
    is($srv->port(undef), undef, 'Change port back to undef');
    is($srv->host('abc'), 'abc', 'Can change host before socket is created');
    is($srv->host(undef), undef, 'Change host back to undef');

    my $port = $srv->port;
    ok($port, 'Forced port to be filled in');
    my $host = $srv->host;
    my $server = $srv->server;
    is($port, $server->listen_sock->sockport, "autogenerated port matches server's sockport");
    is($host, $server->listen_sock->sockhost, "autogenerated port matches server's sockhost");

    ok( !eval { $srv->port($port + 1) }, 'Setting port after socket creation fails');
    like($@, qr(Cannot change port), 'Exception looks correct');
    ok( !eval { $srv->host($host .'aa') }, 'Setting host after socket creation fails');
    like($@, qr(Cannot change host), 'Exception looks correct');
}

# test out making a socket with a random port and connecting to it
{
    my $srv = UR::Service::WebServer->create();
    ok($srv, 'Created WebServer service');

    $srv->dump_status_messages(0);
    $srv->queue_status_messages(1);
    my $server = $srv->server();
    isa_ok($server, 'UR::Service::WebServer::Server');

    ok($server->setup_listener, 'setup_listener');
    my $sock = $server->listen_sock;
    my $port = $sock->sockport;
    ok($port, "server is listening on random port: $port");
    my $host = $sock->sockhost;
    is($host, '127.0.0.1', 'Default listening on localhost');

    # try connecting
    my $conn = IO::Socket::INET->new(PeerAddr => $host, PeerPort => $port, Proto => 'tcp');
    ok($conn, 'Connected');
    $conn->close();

    ok($srv->delete(), 'Delete WebServer');
    # try connecting again
    $conn = IO::Socket::INET->new(PeerAddr => $host, PeerPort => $port, Proto => 'tcp');
    ok(!$conn, "Connection to deleted WebServer failed: $!");
}


# Make another and specify the listen port
{
    my $tryport = pick_random_port();
    my $srv = UR::Service::WebServer->create(port => $tryport);
    ok($srv, 'Create WebServer service specifying port');
    $srv->dump_status_messages(0);
    $srv->queue_status_messages(1);

    ok($srv->server->setup_listener, 'setup_listener');
    my $sock = $srv->server->listen_sock;
    my $port = $sock->sockport;
    is($port, $tryport, 'Listen port is correct');

    # try connecting
    my $conn = IO::Socket::INET->new(PeerAddr => 'localhost', PeerPort => $tryport, Proto => 'tcp');
    ok($conn, 'Connected');
    $conn->close();

    $srv->delete();
}

# Test the idle timeout
{
    my $srv = UR::Service::WebServer->create(idle_timeout => 1);
    ok($srv, 'Created WebServer service');
    $srv->dump_status_messages(0);
    $srv->queue_status_messages(1);

    # NOTE - This will hang if the test fails :(
    $srv->run(sub {} );
    ok(1, 'timeout');

    $srv->delete();
}

# Test running through a connection and request
{
    #my $srv = UR::Service::WebServer->create(idle_timeout => 1);
    my $srv = UR::Service::WebServer->create();
    ok($srv, 'Create WebServer service');
    $srv->dump_status_messages(0);
    $srv->queue_status_messages(1);

    my($req_method, $path_info);
    my $handler = sub {
        my $env = shift;
        ($req_method, $path_info) = @$env{'REQUEST_METHOD','PATH_INFO'};
        # HACK since old versions of HTTP::Server::PSGI don't
        # support psgix.harakiri.  We can't just simply die because the
        # handlers are wrapped inside an eval, but the response callbacks
        # are not.
        return sub { die "Worked\n" };
    };
    my $port = $srv->port;
    my $conn = IO::Socket::INET->new(PeerPort => $port, PeerHost => 'localhost', Proto => 'tcp');
    my $req = HTTP::Request->new(GET => 'http://localhost/test',
                                [ 'user-agent' => 'Test 1.0'] );
    $req->protocol('HTTP/1.1');
    $srv->server->buffer_input($req->as_string);

    eval { $srv->run($handler) };
    is($@, "Worked\n", 'Request handler was invoked');
    is($req_method, 'GET', 'Request method matches request');
    is($path_info, 'http://localhost/test', 'Request path matches request');
    $conn->close;

    # Test assigning a callback before run()
    $conn = IO::Socket::INET->new(PeerPort => $port, PeerHost => 'localhost', Proto => 'tcp');
    $srv->cb($handler);
    $srv->server->buffer_input($req->as_string);
    eval { $srv->run() };
    is($@, "Worked\n", 'Request handler was invoked');
    is($req_method, 'GET', 'Request method matches request');
    is($path_info, 'http://localhost/test', 'Request path matches request');
}

# Test the file/directory handling, non streaming and streaming
{
    for my $does_streaming ( Plack::Util::FALSE, Plack::Util::TRUE) {

        my $check_dirhandler_result = sub {
            my($data, $expected_data, $message) = @_;

            if ($does_streaming and ref($data->[2]) ne 'ARRAY') {
                my $fh = $data->[2];
                local $/;
                $data->[2] =  [ <$fh> ];
            }
            is_deeply($data, $expected_data, $message);
        };

        my $tmpdir = File::Temp::tempdir( CLEANUP => 1 );
        IO::File->new($tmpdir . '/file1','w')->print("This is file 1\n");
        IO::File->new($tmpdir . '/file2.css','w')->print("This is file 2\n");
        IO::File->new($tmpdir . '/file3.html','w')->print("This is file 3\n");
        my $dirhandler = UR::Service::WebServer->file_handler_for_directory( $tmpdir, $does_streaming);

        my $psgi_env = { 'psgi.streaming' => $does_streaming };
        ok($dirhandler, 'Create file handler for directory');
        my $data = $dirhandler->($psgi_env, '/file1');
        $check_dirhandler_result->(
            $data,
            [ 200, [ 'Content-Type' => 'text/plain' ], ["This is file 1\n"]],
            'Got data for file1'
        );

        $data = $dirhandler->($psgi_env, '/nothere');
        $check_dirhandler_result->(
            $data,
            [ 404, [ 'Content-Type' => 'text/plain' ], ["Not Found"]],
            'Got 404 for non-existent file'
        );

        $data = $dirhandler->($psgi_env, '/file2.css');
        $check_dirhandler_result->(
            $data,
            [ 200, [ 'Content-Type' => 'text/css' ], ["This is file 2\n"]],
            'Got data for file2'
        );

        $data = $dirhandler->($psgi_env, '/file3.html');
        $check_dirhandler_result->(
            $data,
            [ 200, [ 'Content-Type' => 'text/html' ], ["This is file 3\n"]],
            'Got data for file3'
        );
    }
}


sub pick_random_port {
    # Have the system make socket and pick the port for us
    my $trysock = IO::Socket::INET->new(Listen => 1, Proto => 'tcp', LocalAddr => 'localhost');
    my $tryport = $trysock->sockport;
    # Now close this socket, and tell the WebServer to use the same socket
    # There's a small chance of a race condition here if another process
    # re-uses the same port number, but the chance is _really_ small, since the
    # port is in TIME_WAIT.  The underlying socket open in the webserver code
    # uses SO_REUSEADDR to re-open the port.
    $trysock->close();
    return $tryport;
}