Permalink
Browse files

Renamed to POE::Component::Server::PSGI and moved to Dist::Zilla

  • Loading branch information...
1 parent 8c27b14 commit 85dec13394798459c525c16c2f25b1d8f13641c7 @frodwith committed Feb 16, 2010
Showing with 279 additions and 301 deletions.
  1. +2 −0 Changes
  2. +0 −20 MANIFEST
  3. +0 −14 MANIFEST.SKIP
  4. +0 −16 Makefile.PL
  5. +0 −21 README
  6. +18 −0 dist.ini
  7. +252 −0 lib/POE/Component/Server/PSGI.pm
  8. +7 −230 lib/Plack/Server/POE.pm
View
@@ -6,3 +6,5 @@
- Streaming from filehandles, poll_cb
0.04 Wed Oct 21 02:13:04 2009
- poll_cb bug fixed (misunderstood the unreleased spec), tests!
+0.05 Mon Feb 15 17:17:30 2010
+ - renamed to POE::Component::Server::PSGI
View
@@ -1,20 +0,0 @@
-Changes
-inc/Module/AutoInstall.pm
-inc/Module/Install.pm
-inc/Module/Install/AutoInstall.pm
-inc/Module/Install/Base.pm
-inc/Module/Install/Can.pm
-inc/Module/Install/Fetch.pm
-inc/Module/Install/Include.pm
-inc/Module/Install/Makefile.pm
-inc/Module/Install/Metadata.pm
-inc/Module/Install/ReadmeFromPod.pm
-inc/Module/Install/Win32.pm
-inc/Module/Install/WriteAll.pm
-lib/Plack/Server/POE.pm
-Makefile.PL
-MANIFEST This list of files
-META.yml
-README
-t/streaming.t
-t/suite.t
View
@@ -1,14 +0,0 @@
-\bRCS\b
-\bCVS\b
-\.svn/
-\.git/
-^MANIFEST\.
-^Makefile$
-~$
-\.old$
-^blib/
-^pm_to_blib
-^MakeMaker-\d
-\.gz$
-\.cvsignore
-\.shipit
View
@@ -1,16 +0,0 @@
-use inc::Module::Install;
-
-name 'Plack-Server-POE';
-all_from 'lib/Plack/Server/POE.pm';
-readme_from 'lib/Plack/Server/POE.pm';
-requires 'POE';
-requires 'POE::Component::Server::TCP';
-requires 'POE::Filter::HTTP::Parser';
-requires 'Plack';
-requires 'HTTP::Message::PSGI';
-requires 'HTTP::Status';
-build_requires 'Test::More';
-use_test_base;
-auto_include_deps;
-auto_install;
-WriteAll;
View
21 README
@@ -1,21 +0,0 @@
-NAME
- Plack::Server::POE - Plack Server implementation for POE
-
-SYNOPSIS
- use Plack::Server::POE;
-
- my $server = Plack::Server::POE->new(
- host => $host,
- port => $port,
- );
- $server->run($app);
-
-AUTHOR
- Paul Driver, "<frodwith at cpan.org>"
-
-LICENSE
- This module is licensed under the same terms as Perl itself.
-
-SEE ALSO
- Plack
-
View
@@ -0,0 +1,18 @@
+name = POE-Component-Server-PSGI
+version = 0.5
+abstract = PSGI Server implementation for POE
+author = Paul Driver <frodwith@cpan.org>
+license = Perl_5
+copyright_holder = Paul Driver
+
+[@Classic]
+
+[Prereq]
+POE = 0
+POE::Component::Server::TCP = 0
+POE::Filter::HTTP::Parser = 0
+Plack = 0
+HTTP::Message::PSGI = 0
+HTTP::Status = 0
+Test::More = 0
+namespace::autoclean = 0
@@ -0,0 +1,252 @@
+package POE::Component::Server::PSGI;
+
+use warnings;
+use strict;
+
+use namespace::autoclean;
+
+use HTTP::Message::PSGI;
+use HTTP::Status qw(status_message);
+use Plack::Util;
+use POE;
+use POE::Component::Server::TCP;
+use POE::Filter::HTTP::Parser;
+use POE::Filter::Stream;
+
+sub new {
+ my $class = shift;
+ my $opt = ref $_[0] eq 'HASH' ? shift : { @_ };
+ $opt->{port} ||= 8080,
+ $opt->{host} ||= '0.0.0.0',
+
+ return bless $opt, $class;
+}
+
+sub on_client_input {
+ my ($self, $heap, $req) = @_;
+ my $client = $heap->{client};
+
+ unless ($req->isa('HTTP::Request')) {
+ $client->put($req->as_string);
+ POE::Kernel->yield('shutdown');
+ return;
+ }
+
+ my $version = $req->header('X-HTTP-Version') || '0.9';
+ my $protocol = "HTTP/$version";
+
+ my $env = req_to_psgi($req,
+ SERVER_NAME => $self->{host},
+ SERVER_PORT => $self->{port},
+ SERVER_PROTOCOL => $protocol,
+ 'psgi.streaming' => Plack::Util::TRUE,
+ 'psgi.nonblocking' => Plack::Util::TRUE,
+ 'psgi.runonce' => Plack::Util::FALSE,
+ );
+
+ my $connection = $req->header('Connection') || '';
+ my $keep_alive = $version eq '1.1' && $connection ne 'close';
+
+ my $write = sub { $client->put($_[0]) };
+ my $close = sub {
+ delete $heap->{client_flush};
+ POE::Kernel->yield('shutdown') unless $keep_alive;
+ return;
+ };
+
+ my $write_chunked = sub {
+ my $chunk = shift;
+ my $len = sprintf "%X", do { use bytes; length($chunk) };
+ $write->("$len\r\n$chunk\r\n");
+ };
+
+ my $close_chunked = sub {
+ $write->("0\r\n\r\n");
+ $close->();
+ };
+
+ my $start_response = sub {
+ my ($code, $headers, $body) = @{+shift};
+ my ($explicit_length, $chunked);
+ my $message = status_message($code);
+ $write->("$protocol $code $message\r\n");
+
+ while (@$headers) {
+ my $k = shift(@$headers);
+ my $v = shift(@$headers);
+ if ($k eq 'Connection' && $v eq 'close') {
+ $keep_alive = 0;
+ }
+ elsif ($k eq 'Content-Length') {
+ $explicit_length = 1;
+ }
+ $write->("$k: $v\r\n");
+ }
+
+ my $no_body_allowed = ($req->method =~ /^head$/i)
+ || ($code < 200)
+ || ($code == 204)
+ || ($code == 304);
+
+ if ($no_body_allowed) {
+ $write->("\r\n");
+ return;
+ }
+
+ $chunked = ($keep_alive && !$explicit_length);
+ $write->("Transfer-Encoding: chunked\r\n") if $chunked;
+
+ $write->("\r\n");
+
+ my $w = $chunked ? $write_chunked : $write;
+ my $c = $chunked ? $close_chunked : $close;
+
+ if ($body) {
+ if (Plack::Util::is_real_fh($body)) {
+ my ($wheel, $buffer);
+ my $flusher = sub {
+ return unless $buffer;
+ $w->($buffer);
+ $buffer = '';
+ $wheel->resume_input() if $wheel;
+ };
+ $heap->{client_flush} = $flusher;
+ POE::Session->create(
+ inline_states => {
+ _start => sub {
+ $wheel = POE::Wheel::ReadWrite->new(
+ Handle => $body,
+ Filter => POE::Filter::Stream->new,
+ InputEvent => 'got_input',
+ ErrorEvent => 'got_error',
+ );
+ },
+ got_error => sub {
+ my ($op, $errno, $errstr, $id) = @_[ARG0..ARG3];
+ if ($op eq 'read') {
+ delete $_[HEAP]->{wheels}->{$id};
+ $wheel = undef;
+ $body->close();
+ $c->();
+ }
+ },
+ got_input => sub {
+ my $data = $_[ARG0];
+ my $already_flushed = !$buffer;
+ $buffer .= $data;
+ if ($already_flushed) {
+ $flusher->();
+ }
+ else {
+ my $len = do { use bytes; length($buffer) };
+ $wheel->pause_input if $len > 1024;
+ }
+ }
+ }
+ );
+ }
+ else {
+ Plack::Util::foreach($body, $w);
+ $c->();
+ }
+ return;
+ }
+
+ my $writer; $writer = Plack::Util::inline_object(
+ write => $w,
+ close => sub { $c->(@_); undef $writer },
+ poll_cb => sub {
+ my $get = shift;
+ ($heap->{client_flush} = sub {
+ $get->($writer);
+ })->();
+ },
+ );
+ return $writer;
+ };
+
+ my $response = Plack::Util::run_app($self->{app}, $env);
+
+ if (ref $response eq 'CODE') {
+ $response->($start_response);
+ }
+ else {
+ $start_response->($response);
+ }
+}
+
+sub register_service {
+ my ($self, $app) = @_;
+ $self->{app} = $app;
+
+ my $filter = POE::Filter::HTTP::Parser->new( type => 'server' );
+ print STDERR "Listening on $self->{host}:$self->{port}\n";
+ POE::Component::Server::TCP->new(
+ Port => $self->{port},
+ Address => $self->{host},
+ ClientInput => sub {
+ $self->on_client_input(@_[HEAP, ARG0]);
+ },
+ ClientInputFilter => $filter,
+ ClientOutputFilter => 'POE::Filter::Stream',
+ ClientFlushed => sub {
+ my $cb = $_[HEAP]->{client_flush};
+ $cb && $cb->();
+ },
+ );
+}
+
+sub run {
+ my ($self, $app) = @_;
+ $self->register_service($app);
+ POE::Kernel->run;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+POE::Component::Server::PSGI
+
+=head1 DESCRIPTION
+
+PSGI Server implementation for POE
+
+=head1 SYNOPSIS
+
+ use POE::Component::Server::PSGI;
+
+ my $server = POE::Component::Server::PSGI->new(
+ host => $host,
+ port => $port,
+ );
+ $server->run($app);
+
+=head1 INTERFACE
+
+See Plack::Server.
+
+=head1 AUTHOR
+
+Paul Driver, C<< <frodwith at cpan.org> >>
+
+=head1 LICENSE
+
+This module is licensed under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+L<Plack>
+
+=begin Pod::Coverage
+
+new
+on_client_input
+register_service
+run
+
+=end Pod::Coverage
+
+=cut
Oops, something went wrong.

0 comments on commit 85dec13

Please sign in to comment.