1package Plack::Handler::AnyEvent::SCGI;
2
3use strict;
4use 5.008_001;
5our $VERSION = '0.03';
6
7use AnyEvent::SCGI;
8use URI::Escape;
9use Plack::Util;
10
11sub new {
12    my($class, %args) = @_;
13    bless { port => 9999, %args }, $class;
14}
15
16sub run {
17    my $self = shift;
18    $self->register_service(@_);
19    $self->{_cv}->recv;
20}
21
22sub register_service {
23    my($self, $app) = @_;
24
25    $self->{_server} = scgi_server $self->{host} || '127.0.0.1', $self->{port}, sub {
26        my($handle, $env, $content_r, $fatal, $error) = @_;
27        $self->handle_request($app, $handle, $env, $content_r) unless $fatal;
28    };
29
30    $self->{_cv} = AE::cv;
31}
32
33sub handle_request {
34    my($self, $app, $handle, $env, $content_r) = @_;
35
36    delete $env->{HTTP_CONTENT_TYPE};
37    delete $env->{HTTP_CONTENT_LENGTH};
38    ($env->{PATH_INFO}, $env->{QUERY_STRING}) = split /\?/, $env->{REQUEST_URI};
39    $env->{PATH_INFO} = URI::Escape::uri_unescape $env->{PATH_INFO};
40    $env->{SCRIPT_NAME} = '';
41    $env->{SERVER_NAME} =~ s/:\d+$//; # lighttpd bug?
42
43    $env = {
44        %$env,
45        'psgi.version'      => [1,1],
46        'psgi.url_scheme'   => ($env->{HTTPS}||'off') =~ /^(?:on|1)$/i ? 'https' : 'http',
47        'psgi.input'        => do { open my $io, "<", $content_r || \''; $io },
48        'psgi.errors'       => *STDERR,
49        'psgi.multithread'  => Plack::Util::FALSE,
50        'psgi.multiprocess' => Plack::Util::FALSE,
51        'psgi.run_once'     => Plack::Util::FALSE,
52        'psgi.streaming'    => Plack::Util::TRUE,
53        'psgi.nonblocking'  => Plack::Util::TRUE,
54        'psgix.input.buffered' => Plack::Util::TRUE,
55    };
56
57    my $res = Plack::Util::run_app $app, $env;
58
59    if (ref $res eq 'ARRAY') {
60        $self->handle_response($res, $handle);
61    } elsif (ref $res eq 'CODE') {
62        $res->(sub { $self->handle_response($_[0], $handle) });
63    } else {
64        die "Bad response $res";
65    }
66}
67
68sub handle_response {
69    my($self, $res, $handle) = @_;
70
71    my $hdrs;
72    $hdrs = "Status: $res->[0]\015\012";
73
74    my $headers = $res->[1];
75    while (my ($k, $v) = splice @$headers, 0, 2) {
76        $hdrs .= "$k: $v\015\012";
77    }
78    $hdrs .= "\015\012";
79
80    $handle->push_write($hdrs);
81
82    my $cb = sub { $handle->push_write($_[0]) };
83    my $body = $res->[2];
84    if (defined $body) {
85        Plack::Util::foreach($body, $cb);
86        $handle->push_shutdown;
87    } else {
88        return Plack::Util::inline_object
89            write => $cb,
90            close => sub { $handle->push_shutdown };
91    }
92}
93
941;
95__END__
96
97=encoding utf-8
98
99=for stopwords
100
101=head1 NAME
102
103Plack::Handler::AnyEvent::SCGI - PSGI handler on AnyEvent::SCGI
104
105=head1 SYNOPSIS
106
107  plackup -s AnyEvent::SCGI --port 22222
108
109=head1 DESCRIPTION
110
111Plack::Handler::AnyEvent::SCGI is a standalone SCGI daemon running on L<AnyEvent::SCGI>.
112
113=head1 AUTHOR
114
115Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>
116
117=head1 LICENSE
118
119This library is free software; you can redistribute it and/or modify
120it under the same terms as Perl itself.
121
122=head1 SEE ALSO
123
124L<AnyEvent::SCGI> L<Plack::Handler::SCGI>
125
126=cut
127