root/lang/perl/HTTP-Engine/branches/shika/lib/HTTP/Engine/Interface/ServerSimple.pm @ 25224

Revision 25224, 3.2 kB (checked in by tokuhirom, 6 years ago)

use Fast

Line 
1package HTTP::Engine::Interface::ServerSimple;
2use HTTP::Engine::Interface
3    builder => 'NoEnv',
4    writer  => {
5        response_line => 1,
6    }
7;
8use HTTP::Engine::ClassCreator;
9
10use HTTP::Server::Simple 0.34;
11use HTTP::Server::Simple::CGI;
12
13has host => (
14    is      => 'ro',
15    isa     => 'Str',
16    default => '127.0.0.1',
17);
18
19has port => (
20    is       => 'ro',
21    isa      => 'Int',
22    required => 1,
23);
24
25has net_server => (
26    is      => 'ro',
27    isa     => 'Str | Undef',
28    default => undef,
29);
30
31sub run {
32    my ($self, ) = @_;
33
34    my $headers;
35    my %setup;
36    my $server;
37    $server = HTTP::Engine::ClassCreator
38        ->create_anon(
39            superclasses => ['HTTP::Server::Simple'],
40            methods => {
41                headers => sub {
42                    my ( $self, $args ) = @_;
43                    $headers = HTTP::Headers::Fast->new(@$args);
44                },
45                setup => sub {
46                    shift; # $self;
47                    %setup = @_;
48                },
49                handler    => sub {
50                    my($host, $port) = $headers->header('Host') ?
51                        split(':', $headers->header('Host')) :($setup{localname}, $setup{localport});
52                    my $base = "http://${host}";
53                    $base .= ":$port" if $port;
54                    my $request_uri = $setup{request_uri};
55                    $request_uri = '/' if $request_uri =~ m!^https?://!i;
56                    my $uri = URI::WithBase->new(
57                        $base . $request_uri,
58                        $base . '/',
59                    );
60                    $self->handle_request(
61                        uri => $uri,
62                        connection_info => {
63                            method      => $setup{method},
64                            protocol    => $setup{protocol},
65                            address     => $setup{peeraddr},
66                            port        => $setup{localport},
67                            user        => undef,
68                            _https_info => undef,
69                            request_uri => $setup{request_uri},
70                        },
71                        headers     => $headers,
72                        _connection => {
73                            env           => {},
74                            input_handle  => \*STDIN,
75                            output_handle => \*STDOUT,
76                        },
77                    )
78                },
79                net_server => sub { $self->net_server },
80            },
81            cache => 1
82        )->new(
83            $self->port
84        );
85    $server->host($self->host);
86    $server->run;
87}
88
89__INTERFACE__
90
91__END__
92
93=head1 NAME
94
95HTTP::Engine::Interface::ServerSimple - HTTP::Server::Simple interface for HTTP::Engine
96
97=head1 DESCRIPTION
98
99HTTP::Engine::Plugin::Interface::ServerSimple is wrapper for HTTP::Server::Simple.
100
101HTTP::Server::Simple is flexible web server.And it can use Net::Server, so you can make it preforking or using Coro.
102
103=head1 AUTHOR
104
105Tokuhiro Matsuno(cpan:tokuhirom)
106
107=head1 THANKS TO
108
109obra++
110
111=head1 SEE ALSO
112
113L<HTTP::Server::Simple>, L<HTTP::Engine>
114
115=head1 LICENSE
116
117This library is free software; you can redistribute it and/or modify
118it under the same terms as Perl itself.
119
120=cut
Note: See TracBrowser for help on using the browser.