Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Initial commit.

suite.t requires Plack b16693a or later to pass.
  • Loading branch information...
commit 2289ce03484140e7ed7214c22d47fa360cd2fc92 0 parents
@miyagawa authored
5 .gitignore
@@ -0,0 +1,5 @@
+META.yml
+Makefile
+inc/
+pm_to_blib
+*~
2  .shipit
@@ -0,0 +1,2 @@
+steps = FindVersion, ChangeVersion, CheckChangeLog, DistTest, Commit, Tag, MakeDist, UploadCPAN
+git.push_to = origin
4 Changes
@@ -0,0 +1,4 @@
+Revision history for Perl extension Plack::Handler::AnyEvent::HTTPD
+
+0.01 Wed Feb 3 18:02:45 2010
+ - original version
33 MANIFEST
@@ -0,0 +1,33 @@
+.gitignore
+Changes
+inc/Module/Install.pm
+inc/Module/Install/AuthorTests.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/Repository.pm
+inc/Module/Install/TestBase.pm
+inc/Module/Install/Win32.pm
+inc/Module/Install/WriteAll.pm
+inc/Spiffy.pm
+inc/Test/Base.pm
+inc/Test/Base/Filter.pm
+inc/Test/Builder.pm
+inc/Test/Builder/Module.pm
+inc/Test/More.pm
+inc/Test/Requires.pm
+lib/Plack/Handler/AnyEvent/HTTPD.pm
+Makefile.PL
+MANIFEST This list of files
+META.yml
+README
+t/00_compile.t
+t/suite.t
+xt/perlcritic.t
+xt/pod.t
+xt/podspell.t
+xt/synopsis.t
14 MANIFEST.SKIP
@@ -0,0 +1,14 @@
+\bRCS\b
+\bCVS\b
+\.svn/
+\.git/
+^MANIFEST\.
+^Makefile$
+~$
+\.old$
+^blib/
+^pm_to_blib
+^MakeMaker-\d
+\.gz$
+\.cvsignore
+\.shipit
11 Makefile.PL
@@ -0,0 +1,11 @@
+use inc::Module::Install;
+name 'Plack-Handler-AnyEvent-HTTPD';
+all_from 'lib/Plack/Handler/AnyEvent/HTTPD.pm';
+readme_from 'lib/Plack/Handler/AnyEvent/HTTPD.pm';
+build_requires 'Test::More';
+use_test_base;
+test_requires 'Test::Requires';
+auto_include_deps;
+author_tests('xt');
+auto_set_repository;
+WriteAll;
21 README
@@ -0,0 +1,21 @@
+NAME
+ Plack::Handler::AnyEvent::HTTPD - Plack handler to run PSGI apps on
+ AnyEvent::HTTPD
+
+SYNOPSIS
+ plackup -s AnyEvent::HTTPD --port 9090
+
+DESCRIPTION
+ Plack::Handler::AnyEvent::HTTPD is a Plack handler to run PSGI apps on
+ AnyEvent::HTTPD module.
+
+AUTHOR
+ Tatsuhiko Miyagawa <miyagawa@bulknews.net>
+
+LICENSE
+ This library is free software; you can redistribute it and/or modify it
+ under the same terms as Perl itself.
+
+SEE ALSO
+ AnyEvent::HTTPD
+
162 lib/Plack/Handler/AnyEvent/HTTPD.pm
@@ -0,0 +1,162 @@
+package Plack::Handler::AnyEvent::HTTPD;
+
+use strict;
+use 5.008_001;
+our $VERSION = '0.01';
+
+use AnyEvent::HTTPD;
+use Plack::Util;
+use HTTP::Status;
+use URI::Escape;
+
+sub new {
+ my($class, %args) = @_;
+ bless {%args}, $class;
+}
+
+sub register_service {
+ my($self, $app) = @_;
+
+ my $httpd = AnyEvent::HTTPD->new(
+ port => $self->{port} || 9000,
+ host => $self->{host},
+ connection_class => 'Plack::Handler::AnyEvent::HTTPD::Connection',
+ request_timeout => $self->{request_timeout},
+ );
+ $httpd->reg_cb(
+ '' => sub {
+ my($httpd, $req) = @_;
+
+ my($path, $query) = split /\?/, $req->{url}, 2;
+
+ my $env = {
+ REMOTE_ADDR => $req->client_host,
+ SERVER_PORT => $httpd->port,
+ SERVER_NAME => $httpd->host,
+ SCRIPT_NAME => '',
+ REQUEST_METHOD => $req->method,
+ PATH_INFO => URI::Escape::uri_unescape($path),
+ REQUEST_URI => $req->{url},
+ QUERY_STRING => $query,
+ SERVER_PROTOCOL => 'HTTP/1.0', # no way to get this from HTTPConnection
+ 'psgi.version' => [ 1, 1 ],
+ 'psgi.errors' => *STDERR,
+ 'psgi.url_scheme' => 'http',
+ 'psgi.nonblocking' => Plack::Util::TRUE,
+ 'psgi.streaming' => Plack::Util::TRUE,
+ 'psgi.run_once' => Plack::Util::FALSE,
+ 'psgi.multithread' => Plack::Util::FALSE,
+ 'psgi.multiprocess' => Plack::Util::FALSE,
+ 'psgi.input' => do { open my $input, "<", \($req->content || ''); $input },
+ };
+
+ my $hdr = $req->headers;
+ $env->{CONTENT_TYPE} = delete $hdr->{'content-type'};
+ $env->{CONTENT_LENGTH} = delete $hdr->{'content-length'};
+
+ while (my($key, $val) = each %$hdr) {
+ $key =~ tr/-/_/;
+ $env->{"HTTP_" . uc $key} = $val;
+ }
+
+ my $res = Plack::Util::run_app($app, $env);
+
+ my $respond = sub {
+ my $res = shift;
+
+ my @res = ($res->[0], HTTP::Status::status_message($res->[0]), {@{$res->[1]}});
+
+ if (defined $res->[2]) {
+ my $content;
+ Plack::Util::foreach($res->[2], sub { $content .= $_[0] });
+
+ # Work around AnyEvent::HTTPD bugs that it sets
+ # Content-Length even when it's not necessary
+ if (!$content && Plack::Util::status_with_no_entity_body($res->[0])) {
+ $content = sub { $_[0]->(undef) if $_[0] };
+ }
+
+ $req->respond([ @res, $content ]);
+ } else {
+ # Probably unnecessary, but in case ->write is
+ # called before the poll callback is execute.
+ my @buf;
+ my $data_cb = sub { push @buf, $_[0] };
+ $req->respond([
+ @res,
+ sub {
+ # TODO $data_cb = undef -> Client Disconnect
+ $data_cb = shift;
+ if ($data_cb && @buf) {
+ $data_cb->($_) for @buf;
+ @buf = ()
+ }
+ }
+ ]);
+
+ return Plack::Util::inline_object
+ write => sub { $data_cb->($_[0]) if $data_cb },
+ close => sub { $data_cb->(undef) if $data_cb };
+ }
+ };
+
+ ref $res eq 'CODE' ? $res->($respond) : $respond->($res);
+ }
+ );
+
+ $self->{_httpd} = $httpd;
+}
+
+sub run {
+ my $self = shift;
+ $self->register_service(@_);
+
+ $self->{_httpd}->run;
+}
+
+package Plack::Handler::AnyEvent::HTTPD::Connection;
+use parent qw(AnyEvent::HTTPD::HTTPConnection);
+
+# Don't parse content
+sub handle_request {
+ my($self, $method, $uri, $hdr, $cont) = @_;
+
+ $self->{keep_alive} = ($hdr->{connection} =~ /keep-alive/io);
+ $self->event(request => $method, $uri, $hdr, $cont);
+}
+
+package Plack::Handler::AnyEvent::HTTPD;
+
+1;
+__END__
+
+=encoding utf-8
+
+=for stopwords
+
+=head1 NAME
+
+Plack::Handler::AnyEvent::HTTPD - Plack handler to run PSGI apps on AnyEvent::HTTPD
+
+=head1 SYNOPSIS
+
+ plackup -s AnyEvent::HTTPD --port 9090
+
+=head1 DESCRIPTION
+
+Plack::Handler::AnyEvent::HTTPD is a Plack handler to run PSGI apps on AnyEvent::HTTPD module.
+
+=head1 AUTHOR
+
+Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>
+
+=head1 LICENSE
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+L<AnyEvent::HTTPD>
+
+=cut
4 t/00_compile.t
@@ -0,0 +1,4 @@
+use strict;
+use Test::More tests => 1;
+
+BEGIN { use_ok 'Plack::Handler::AnyEvent::HTTPD' }
9 t/suite.t
@@ -0,0 +1,9 @@
+use strict;
+use warnings;
+use Test::More;
+use Plack;
+use Plack::Test::Suite;
+
+Plack::Test::Suite->run_server_tests('AnyEvent::HTTPD');
+done_testing();
+
5 xt/perlcritic.t
@@ -0,0 +1,5 @@
+use strict;
+use Test::More;
+eval q{ use Test::Perl::Critic };
+plan skip_all => "Test::Perl::Critic is not installed." if $@;
+all_critic_ok("lib");
4 xt/pod.t
@@ -0,0 +1,4 @@
+use Test::More;
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok();
9 xt/podspell.t
@@ -0,0 +1,9 @@
+use Test::More;
+eval q{ use Test::Spelling };
+plan skip_all => "Test::Spelling is not installed." if $@;
+add_stopwords(<DATA>);
+set_spell_cmd("aspell -l en list");
+all_pod_files_spelling_ok('lib');
+__DATA__
+Tatsuhiko
+Miyagawa
4 xt/synopsis.t
@@ -0,0 +1,4 @@
+use Test::More;
+eval "use Test::Synopsis";
+plan skip_all => "Test::Synopsis required" if $@;
+all_synopsis_ok();
Please sign in to comment.
Something went wrong with that request. Please try again.