Permalink
Browse files

initial commit

  • Loading branch information...
0 parents commit 6ce7289ca62adc31cd39661b273349a33ab15430 @miyagawa committed Jan 31, 2010
Showing with 347 additions and 0 deletions.
  1. +5 −0 .gitignore
  2. +2 −0 .shipit
  3. +4 −0 Changes
  4. +28 −0 MANIFEST
  5. +14 −0 MANIFEST.SKIP
  6. +10 −0 Makefile.PL
  7. +20 −0 README
  8. +125 −0 lib/Plack/Handler/SCGI/AnyEvent.pm
  9. +4 −0 t/00_compile.t
  10. +81 −0 t/SCGIUtils.pm
  11. +32 −0 t/suite.t
  12. +5 −0 xt/perlcritic.t
  13. +4 −0 xt/pod.t
  14. +9 −0 xt/podspell.t
  15. +4 −0 xt/synopsis.t
@@ -0,0 +1,5 @@
+META.yml
+Makefile
+inc/
+pm_to_blib
+*~
@@ -0,0 +1,2 @@
+steps = FindVersion, ChangeVersion, CheckChangeLog, DistTest, Commit, Tag, MakeDist, UploadCPAN
+git.push_to = origin
@@ -0,0 +1,4 @@
+Revision history for Perl extension Plack::Handler::SCGI::AnyEvent
+
+0.01 Sun Jan 31 05:31:36 2010
+ - original version
@@ -0,0 +1,28 @@
+.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/Win32.pm
+inc/Module/Install/WriteAll.pm
+inc/Test/Builder/Module.pm
+inc/Test/Requires.pm
+lib/Plack/Handler/SCGI/AnyEvent.pm
+Makefile.PL
+MANIFEST This list of files
+META.yml
+README
+t/00_compile.t
+t/SCGIUtils.pm
+t/suite.t
+xt/perlcritic.t
+xt/pod.t
+xt/podspell.t
+xt/synopsis.t
@@ -0,0 +1,14 @@
+\bRCS\b
+\bCVS\b
+\.svn/
+\.git/
+^MANIFEST\.
+^Makefile$
+~$
+\.old$
+^blib/
+^pm_to_blib
+^MakeMaker-\d
+\.gz$
+\.cvsignore
+\.shipit
@@ -0,0 +1,10 @@
+use inc::Module::Install;
+name 'Plack-Handler-SCGI-AnyEvent';
+all_from 'lib/Plack/Handler/SCGI/AnyEvent.pm';
+readme_from 'lib/Plack/Handler/SCGI/AnyEvent.pm';
+build_requires 'Test::More';
+test_requires 'Test::Requires';
+auto_include_deps;
+author_tests('xt');
+auto_set_repository;
+WriteAll;
20 README
@@ -0,0 +1,20 @@
+NAME
+ Plack::Handler::SCGI::AnyEvent - PSGI handler on AnyEvent::SCGI
+
+SYNOPSIS
+ plackup -s SCGI::AnyEvent --port 22222
+
+DESCRIPTION
+ Plack::Handler::SCGI::AnyEvent is a standalone SCGI daemon running on
+ AnyEvent::SCGI.
+
+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::SCGI Plack::Handler::SCGI
+
@@ -0,0 +1,125 @@
+package Plack::Handler::SCGI::AnyEvent;
+
+use strict;
+use 5.008_001;
+our $VERSION = '0.01';
+
+use AnyEvent::SCGI;
+use URI::Escape;
+use Plack::Util;
+
+sub new {
+ my($class, %args) = @_;
+ bless { port => 9999, %args }, $class;
+}
+
+sub run {
+ my $self = shift;
+ $self->register_service(@_);
+ $self->{_cv}->recv;
+}
+
+sub register_service {
+ my($self, $app) = @_;
+
+ $self->{_server} = scgi_server $self->{host} || '127.0.0.1', $self->{port}, sub {
+ my($handle, $env, $content_r, $fatal, $error) = @_;
+ $self->handle_request($app, $handle, $env, $content_r) unless $fatal;
+ };
+
+ $self->{_cv} = AE::cv;
+}
+
+sub handle_request {
+ my($self, $app, $handle, $env, $content_r) = @_;
+
+ delete $env->{HTTP_CONTENT_TYPE};
+ delete $env->{HTTP_CONTENT_LENGTH};
+ ($env->{PATH_INFO}, $env->{QUERY_STRING}) = split /\?/, $env->{REQUEST_URI};
+ $env->{PATH_INFO} = URI::Escape::uri_unescape $env->{PATH_INFO};
+ $env->{SCRIPT_NAME} = '';
+ $env->{SERVER_NAME} =~ s/:\d+$//; # lighttpd bug?
+
+ $env = {
+ %$env,
+ 'psgi.version' => [1,1],
+ 'psgi.url_scheme' => ($env->{HTTPS}||'off') =~ /^(?:on|1)$/i ? 'https' : 'http',
+ 'psgi.input' => do { open my $io, "<", $content_r || \''; $io },
+ 'psgi.errors' => *STDERR,
+ 'psgi.multithread' => Plack::Util::FALSE,
+ 'psgi.multiprocess' => Plack::Util::FALSE,
+ 'psgi.run_once' => Plack::Util::FALSE,
+ 'psgi.streaming' => Plack::Util::TRUE,
+ 'psgi.nonblocking' => Plack::Util::TRUE,
+ };
+
+ my $res = Plack::Util::run_app $app, $env;
+
+ if (ref $res eq 'ARRAY') {
+ $self->handle_response($res, $handle);
+ } elsif (ref $res eq 'CODE') {
+ $res->(sub { $self->handle_response($_[0], $handle) });
+ } else {
+ die "Bad response $res";
+ }
+}
+
+sub handle_response {
+ my($self, $res, $handle) = @_;
+
+ my $hdrs;
+ $hdrs = "Status: $res->[0]\015\012";
+
+ my $headers = $res->[1];
+ while (my ($k, $v) = splice @$headers, 0, 2) {
+ $hdrs .= "$k: $v\015\012";
+ }
+ $hdrs .= "\015\012";
+
+ $handle->push_write($hdrs);
+
+ my $cb = sub { $handle->push_write($_[0]) };
+ my $body = $res->[2];
+ if (defined $body) {
+ Plack::Util::foreach($body, $cb);
+ $handle->push_shutdown;
+ } else {
+ return Plack::Util::inline_object
+ write => $cb,
+ close => sub { $handle->push_shutdown };
+ }
+}
+
+1;
+__END__
+
+=encoding utf-8
+
+=for stopwords
+
+=head1 NAME
+
+Plack::Handler::SCGI::AnyEvent - PSGI handler on AnyEvent::SCGI
+
+=head1 SYNOPSIS
+
+ plackup -s SCGI::AnyEvent --port 22222
+
+=head1 DESCRIPTION
+
+Plack::Handler::SCGI::AnyEvent is a standalone SCGI daemon running on L<AnyEvent::SCGI>.
+
+=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::SCGI> L<Plack::Handler::SCGI>
+
+=cut
@@ -0,0 +1,4 @@
+use strict;
+use Test::More tests => 1;
+
+BEGIN { use_ok 'Plack::Handler::SCGI::AnyEvent' }
@@ -0,0 +1,81 @@
+package t::SCGIUtils;
+use strict;
+use warnings;
+use File::Temp ();
+use FindBin;
+use Test::More;
+use IO::Socket;
+use File::Spec;
+use Test::TCP qw/test_tcp empty_port/;
+use parent qw/Exporter/;
+
+our @EXPORT = qw/ test_lighty_external test_scgi_standalone /;
+
+# test for SCGI External Server
+sub test_lighty_external (&@) {
+ my ($callback, $lighty_port, $scgi_port) = @_;
+
+ $lighty_port ||= empty_port();
+ $scgi_port ||= empty_port($lighty_port);
+
+ my $lighttpd_bin = $ENV{LIGHTTPD_BIN} || `which lighttpd`;
+ chomp $lighttpd_bin;
+
+ plan skip_all => 'Please set LIGHTTPD_BIN to the path to lighttpd'
+ unless $lighttpd_bin && -x $lighttpd_bin;
+
+ my $tmpdir = File::Temp::tempdir( CLEANUP => 1 );
+
+ test_tcp(
+ client => sub {
+ $callback->($lighty_port, $scgi_port);
+ warn `cat $tmpdir/error.log` if $ENV{DEBUG};
+ },
+ server => sub {
+ my $conffname = File::Spec->catfile($tmpdir, "lighty.conf");
+ _write_file($conffname => _render_conf($tmpdir, $lighty_port, $scgi_port));
+
+ my $pid = open my $lighttpd, "$lighttpd_bin -D -f $conffname 2>&1 |"
+ or die "Unable to spawn lighttpd: $!";
+ $SIG{TERM} = sub {
+ kill 'INT', $pid;
+ close $lighttpd;
+ exit;
+ };
+ sleep 60; # waiting tests.
+ die "server timeout";
+ },
+ port => $lighty_port,
+ );
+}
+
+sub _write_file {
+ my ($fname, $src) = @_;
+ open my $fh, '>', $fname or die $!;
+ print {$fh} $src or die $!;
+ close $fh;
+}
+
+sub _render_conf {
+ my ($tmpdir, $port, $scgiport) = @_;
+ <<"END";
+# basic lighttpd config file for testing scgi(external server)+Plack
+server.modules += ("mod_scgi")
+
+server.document-root = "$tmpdir"
+
+server.bind = "127.0.0.1"
+server.port = $port
+
+scgi.server = (
+ "" => ((
+ "check-local" => "disable",
+ "host" => "127.0.0.1",
+ "port" => $scgiport,
+ "idle-timeout" => 20,
+ ))
+)
+END
+}
+
+1;
@@ -0,0 +1,32 @@
+use strict;
+use warnings;
+use Test::More;
+use Plack;
+use Plack::Handler::SCGI::AnyEvent;
+use Plack::Test::Suite;
+use t::SCGIUtils;
+
+my $lighty_port;
+my $scgi_port;
+
+test_lighty_external(
+ sub {
+ ($lighty_port, $scgi_port) = @_;
+ Plack::Test::Suite->run_server_tests(\&run_server, $scgi_port, $lighty_port);
+ done_testing();
+ }
+);
+
+sub run_server {
+ my($port, $app) = @_;
+
+ $| = 0; # Test::Builder autoflushes this. reset!
+
+ my $server = Plack::Handler::SCGI::AnyEvent->new(
+ host => '127.0.0.1',
+ port => $port,
+ );
+ $server->run($app);
+}
+
+
@@ -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");
@@ -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();
@@ -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
@@ -0,0 +1,4 @@
+use Test::More;
+eval "use Test::Synopsis";
+plan skip_all => "Test::Synopsis required" if $@;
+all_synopsis_ok();

0 comments on commit 6ce7289

Please sign in to comment.