Permalink
Browse files

Add Server::Starter support

  • Loading branch information...
1 parent a24f150 commit ed7024f424a3768f8d997aaf906d976259071d8d @lestrrat lestrrat committed Feb 16, 2010
Showing with 138 additions and 2 deletions.
  1. +17 −1 lib/Plack/Handler/Twiggy.pm
  2. +7 −1 lib/Twiggy/Server.pm
  3. +85 −0 lib/Twiggy/Server/SS.pm
  4. +29 −0 t/anyevent_server_starter.t
View
18 lib/Plack/Handler/Twiggy.pm
@@ -1,6 +1,22 @@
package Plack::Handler::Twiggy;
use strict;
-use parent qw( Twiggy::Server );
+
+sub new {
+ my $class = shift;
+ bless {@_}, $class;
+}
+
+sub run {
+ my ($self, $app) = @_;
+
+ my $class = $ENV{SERVER_STARTER_PORT} ?
+ 'Twiggy::Server::SS' : 'Twiggy::Server';
+ eval "require $class";
+ die if $@;
+
+ $class->new(%{$self})->run($app);
+}
+
1;
View
8 lib/Twiggy/Server.pm
@@ -60,7 +60,13 @@ sub _create_tcp_server {
$port = $listen;
}
- return tcp_server $host, $port, $self->_accept_handler($app, $is_tcp), sub {
+ return tcp_server $host, $port, $self->_accept_handler($app, $is_tcp),
+ $self->_accept_prepare_handler;
+}
+
+sub _accept_prepare_handler {
+ my $self = shift;
+ return sub {
my ( $fh, $host, $port ) = @_;
DEBUG && warn "Listening on $host:$port\n";
$self->{prepared_host} = $host;
View
85 lib/Twiggy/Server/SS.pm
@@ -0,0 +1,85 @@
+package Twiggy::Server::SS;
+use strict;
+use warnings;
+use base qw(Twiggy::Server);
+use AnyEvent;
+use AnyEvent::Util qw(fh_nonblocking guard);
+use AnyEvent::Socket qw(format_address);
+use Server::Starter qw(server_ports);
+
+sub register_service {
+ my ($self, $app) = @_;
+
+ if ($self->{listen}) {
+ warn "'listen' option is currently ignored when used in conjunction with Server::Starter (start_server script)";
+ }
+
+ my $host = $self->{host} || '';
+
+ my @listen;
+ my $ports = server_ports();
+ while (my ($hostport, $fd) = each %$ports ) {
+ push @listen, $hostport;
+ $self->_create_ss_tcp_server($hostport, $fd, $app);
+ }
+
+ # overwrite, just in case somebody wants to refer to it afterwards
+ $self->{listen} = \@listen;
+}
+
+sub _create_ss_tcp_server {
+ my ($self, $hostport, $fd, $app) = @_;
+
+ my $is_tcp = 1; # currently no unix socket support
+
+ my ($host, $port);
+ if ($hostport =~ /(.*):(\d+)/) {
+ $host = $1;
+ $port = $2;
+ } else {
+ $host ||= '0.0.0.0';
+ $port = $hostport;
+ }
+
+ # /WE/ don't care what the address family, type of socket we got, just
+ # create a new handle, and perform a fdopen on it. So that part of
+ # AE::Socket::tcp_server is stripped out
+
+ my %state;
+ $state{fh} = IO::Socket::INET->new(
+ Proto => 'tcp',
+ Listen => 128,
+ );
+
+ $state{fh}->fdopen( $fd, 'w' ) or
+ Carp::croak "failed to bind to listening socket: $!";
+ fh_nonblocking $state{fh}, 1;
+
+ my $len;
+ my $prepare = $self->_accept_prepare_handler;
+ if ($prepare) {
+ my ($service, $host) = AnyEvent::Socket::unpack_sockaddr getsockname $state{fh};
+ $len = $prepare && $prepare->( $state{fh}, format_address $host, $service );
+ }
+
+ $len ||= 128;
+
+ listen $state{fh}, $len or Carp::croak "listen: $!";
+
+ my $accept = $self->_accept_handler($app, $is_tcp);
+ $state{aw} = AE::io $state{fh}, 0, sub {
+ # this closure keeps $state alive
+ while ($state{fh} && (my $peer = accept my $fh, $state{fh})) {
+ fh_nonblocking $fh, 1; # POSIX requires inheritance, the outside world does not
+
+ my ($service, $host) = AnyEvent::Socket::unpack_sockaddr($peer);
+ $accept->($fh, format_address $host, $service);
+ }
+ };
+
+ defined wantarray
+ ? guard { %state = () } # clear fh and watcher, which breaks the circular dependency
+ : ()
+}
+
+1;
View
29 t/anyevent_server_starter.t
@@ -0,0 +1,29 @@
+use strict;
+use Test::More;
+use Test::TCP;
+use LWP::UserAgent;
+use Server::Starter qw(start_server);
+
+test_tcp(
+ server => sub {
+ my $port = shift;
+
+ start_server(
+ exec => [ $^X, '-Mblib', '-MPlack::Loader', '-e',
+ q|Plack::Loader->load('Twiggy', host => '127.0.0.1')->run(sub { [ '200', ['Content-Type' => 'text/plain'], [ 'Hello, Twiggy!' ] ] })| ],
+ port => [ $port ]
+ );
+ exit 1;
+ },
+ client => sub {
+ my $port = shift;
+
+ # XXX LWP is implied by plack
+ my $ua = LWP::UserAgent->new();
+ my $res = $ua->get("http://127.0.0.1:$port/");
+ ok $res->is_success, "request ok";
+ is $res->content, "Hello, Twiggy!";
+ }
+);
+
+done_testing;

0 comments on commit ed7024f

Please sign in to comment.