view release on metacpan or  search on metacpan

t/lib/Test.pm  view on Meta::CPAN

package t::lib::Test;

use 5.006;
use strict;
use warnings;
use parent 'Test::Builder::Module';

BEGIN {
    if (!$ENV{REMOTE_DEBUGGER}) {
        require Devel::Debug::DBGp;

        $ENV{REMOTE_DEBUGGER} = Devel::Debug::DBGp->debugger_path;
    }

    die "\$ENV{REMOTE_DEBUGGER} not set" unless $ENV{REMOTE_DEBUGGER};
    die "\$ENV{REMOTE_DEBUGGER} not set correctly" unless
        -f "$ENV{REMOTE_DEBUGGER}/perl5db.pl";
}

use Test::More;
use Test::DBGp;
use HTTP::CookieJar;

use IPC::Open3 ();
use MIME::Base64 qw(encode_base64);
use Storable qw(thaw);
use Symbol;
use Cwd;

require feature;

our @EXPORT = (
  @Test::More::EXPORT,
  @Test::DBGp::EXPORT,
  qw(
        abs_uri
        run_app
        wait_app
        send_command
        command_is
        init_is
        eval_value_is
        start_listening
        stop_listening
        wait_connection
        discard_connection
        send_request
        response_is
  )
);

sub import {
    unshift @INC, 't/lib';

    strict->import;
    warnings->import;
    feature->import(':5.10');

    goto &Test::Builder::Module::import;
}

my ($HTTP_PORT);
my ($PID, $CHILD_IN, $CHILD_OUT, $CHILD_ERR);
my ($REQ_PID, $REQ_OUT, $REQ_ERR);

sub abs_uri {
    return 'file://' . Cwd::abs_path($_[0]);
}

sub start_listening { dbgp_listen() }
sub stop_listening { dbgp_stop_listening() }

sub run_app {
    my ($app) = @_;

    for my $port (17000 .. 19000) {
        my $sock = IO::Socket::INET->new(
            Listen    => 1,
            LocalAddr => '127.0.0.1',
            LocalPort => $port,
            Proto     => 'tcp',
            Timeout   => 5,
        );
        next unless $sock;

        $HTTP_PORT = $port;
        last;
    }

    die "Unable to find a free port for HTTP in the 17000 - 19000 port range"
        unless $HTTP_PORT;

    local $ENV{DEBUGGER_PORT} = dbgp_listening_port();
    local $ENV{DEBUGGER_PATH} = dbgp_listening_path();
    $CHILD_ERR = gensym;
    $PID = IPC::Open3::open3(
        $CHILD_IN, $CHILD_OUT, $CHILD_ERR,
        $^X, ($INC{'blib.pm'} ? ('-Mblib') : ()),
        't/scripts/plackup.pl',
        '-o', 'localhost', '-p', $HTTP_PORT,
        $app,
    );
}

sub wait_app {
    die "Call run_app() first" unless $PID;

    for (1 .. 5) {
        eval {
            IO::Socket::INET->new(
                PeerAddr => 'localhost',
                PeerPort => $HTTP_PORT,
            );
        } or do {
            sleep 1;