STF::Dispatcher::Mock::Hash::Mock::Hash とかあったらいいのに

package STF::Dispatcher::Mock::Hash::Mock::Hash;
use strict;
use warnings;
use Test::TCP;

sub new {
    my $class = shift;

    my $test_tcp = Test::TCP->new(
        code => sub {
            my $port = shift;
            require STF::Dispatcher::Impl::Hash;
            require STF::Dispatcher::PSGI;
            my $impl = STF::Dispatcher::Impl::Hash->new();
            my $dispatcher = STF::Dispatcher::PSGI->new(
                impl => $impl,
            );
            my $app = $dispatcher->to_app();
            require Plack::Runner;
            my $runner = Plack::Runner->new;
            $runner->parse_options('--port', $port);
            $runner->run($app);
        },
    );
    bless [$test_tcp], $class;
}

sub url {
    my $self = shift;
    'http://127.0.0.1:' . $self->[0]->port();
}

1;

Published: 2012-12-14(Fri) 10:39