root/lang/perl/HTTP-Engine/trunk/lib/HTTP/Engine/Interface/ModPerl.pm @ 18231

Revision 18231, 3.1 kB (checked in by tokuhirom, 6 years ago)

merge interface-decrare branch

  • Property svn:keywords set to Id
Line 
1package HTTP::Engine::Interface::ModPerl;
2use HTTP::Engine::Interface
3    builder => '+HTTP::Engine::Interface::ModPerl::RequestBuilder',
4    writer  => {
5        finalize => sub {
6            my ($self, $req, $res) = @_;
7            my $r = $req->_connection->{apache_request} or die "missing apache request";
8            $r->status( $res->status );
9            $req->headers->scan(
10                sub {
11                    my ($key, $val) = @_;
12                    $r->headers_out->add($key => $val);
13                }
14            );
15            $self->output_body($r, $res->body);
16        },
17    }
18;
19
20
21BEGIN
22{
23    if (! exists $ENV{MOD_PERL_API_VERSION} ||
24         $ENV{MOD_PERL_API_VERSION} != 2)
25    {
26        die "HTTP::Engine::Interface::ModPerl only supports mod_perl2";
27    }
28}
29
30use Apache2::Const -compile => qw(OK);
31use Apache2::Connection;
32use Apache2::RequestRec;
33use Apache2::RequestIO  ();
34use Apache2::RequestUtil;
35use Apache2::ServerRec;
36use APR::Table;
37use HTTP::Engine;
38
39has 'apache' => (
40    is      => 'rw',
41    isa     => 'Apache2::RequestRec',
42    is_weak => 1,
43);
44
45no Moose;
46
47my %HE;
48
49sub handler : method
50{
51    my $class = shift;
52    my $r     = shift;
53
54    # ModPerl is currently the only environment where the inteface comes
55    # before the actual invocation of HTTP::Engine
56
57    my $location = $r->location;
58    my $engine   = $HE{ $location };
59    if (! $engine ) {
60        $engine = $class->create_engine($r);
61        $HE{ $r->location } = $engine;
62    }
63
64    $engine->interface->apache( $r );
65
66    my $server = $r->server;
67    my $connection = $r->connection;
68
69    $engine->interface->request_processor->handle_request(
70        headers => HTTP::Headers->new(
71            %{ $r->headers_in }
72        ),
73        _connection => {
74            input_handle   => \*STDIN,
75            output_handle  => \*STDOUT,
76            env            => {
77                REQUEST_METHOD => $r->method(),
78                REMOTE_ADDR    => $connection->remote_ip(),
79                SERVER_PORT    => $server->port(),
80                QUERY_STRING   => $r->args() || '',
81                HTTP_HOST      => $r->hostname(),
82                SERVER_PROTOCOL => $r->protocol,
83            },
84            apache_request => $r,
85        },
86        connection_info => {
87            address    => $connection->remote_ip(),
88            protocol   => $r->protocol,
89            method     => $r->method,
90            port       => $server->port,
91            user       => $r->user,
92            https_info => undef, # TODO: implement
93        },
94        hostname => $r->hostname,
95    );
96
97    return &Apache2::Const::OK;
98}
99
100sub create_engine
101{
102    my ($self, $r) = @_;
103
104    HTTP::Engine->new(
105        interface => HTTP::Engine::Interface::ModPerl->new(
106            request_handler   => sub { HTTP::Engine::Response->new(status => 200) },
107        )
108    );
109}
110
111sub run { die "THIS IS DUMMY" }
112
113__INTERFACE__
114
115__END__
116
117=head1 NAME
118
119HTTP::Engine::Interface::ModPerl - mod_perl Adaptor for HTTP::Engine
120
121=head1 AUTHORS
122
123Daisuke Maki
124
125Tokuhiro Matsuno
126
127=head1 KNOWN BUGS
128
129    cannot get https_info
130
131=head1 SEE ALSO
132
133L<HTTP::Engine>, L<Apache2>
134
135=cut
Note: See TracBrowser for help on using the browser.