Changeset 13594

Show
Ignore:
Timestamp:
06/10/08 00:43:53 (5 years ago)
Author:
tokuhirom
Message:

rewrite Interface::POE. previous code is broken. that does not works. this revision works well(probably).

Files:
1 modified

Legend:

Unmodified
Added
Removed

  • lang/perl/HTTP-Engine/trunk/lib/HTTP/Engine/Interface/POE.pm

    r13592 r13594  
    77/; 
    88use HTTP::Server::Simple; 
     9use POE::Filter::HTTPD; 
     10use HTTP::Request::AsCGI; 
    911 
    1012has host => ( 
    … …  
    2729    # setup poe session 
    2830    POE::Component::Server::TCP->new( 
    29         Port     => $self->port, 
    30         Address  => $self->host, 
    31         Acceptor => sub { 
    32             my ($socket, $remote_address, $remote_port) = @_[ARG0, ARG1, ARG2]; 
     31        Port         => $self->port, 
     32        Address      => $self->host, 
     33        ClientFilter => 'POE::Filter::HTTPD', 
     34        ClientInput  => sub { 
     35            my ( $kernel, $heap, $request ) = @_[ KERNEL, HEAP, ARG0 ]; 
    3336 
    34             # warn "ACCEPT FROM $remote_address, $remote_port"; 
     37            # Filter::HTTPD sometimes generates HTTP::Response objects. 
     38            # They indicate (and contain the response for) errors that occur 
     39            # while parsing the client's HTTP request.  It's easiest to send 
     40            # the responses as they are and finish up. 
     41            if ( $request->isa('HTTP::Response') ) { 
     42                $heap->{client}->put($request); 
     43                $kernel->yield('shutdown'); 
     44                return; 
     45            } 
    3546 
    36             local %ENV = ( 
    37                 %init_env, 
    38                 SERVER_SOFTWARE   => __PACKAGE__, 
    39                 GATEWAY_INTERFACE => 'CGI/1.1', 
    40             ); 
    41  
    42             $ENV{REMOTE_ADDR} = $remote_address; 
    43             $ENV{REMOTE_PORT} = $remote_port; 
    44  
    45             local *STDIN  = $socket; 
    46             local *STDOUT = $socket; 
    47             select STDOUT; 
    48             do { 
    49                 my ( $method, $request_uri, $proto ) = HTTP::Server::Simple->parse_request(); 
    50                 $proto ||= 'HTTP/0.9'; 
    51                 @ENV{qw/REQUEST_METHOD SERVER_PROTOCOL/} = ($method, $proto); 
    52                 my @uri_split      = ( $request_uri =~ /([^?]*)(?:\?(.*))?/s );    # split at ? 
    53                 $ENV{PATH_INFO}    = shift @uri_split; 
    54                 $ENV{QUERY_STRING} = shift @uri_split if @uri_split && defined $uri_split[0]; 
    55             }; 
    56             do { 
    57                 my $headers = HTTP::Server::Simple->parse_headers() or die "bad request"; 
    58                 while ( my ( $tag, $value ) = splice @$headers, 0, 2 ) { 
    59                     $tag = uc($tag); 
    60                     $tag =~ s/^COOKIES$/COOKIE/; 
    61                     $tag =~ s/-/_/g; 
    62                     $tag = "HTTP_" . $tag 
    63                         unless $tag =~ m/^(?:CONTENT_(?:LENGTH|TYPE)|COOKIE)$/; 
    64  
    65                     if ( exists $ENV{$tag} ) { 
    66                         $ENV{$tag} .= "; $value"; 
    67                     } 
    68                     else { 
    69                         $ENV{$tag} = $value; 
    70                     } 
    71                 } 
    72             }; 
    73             $ENV{SERVER_PORT} ||= $self->port; 
     47            # follow is normal workflow. 
     48            my $ascgi = HTTP::Request::AsCGI->new($request)->setup; 
    7449            do { 
    7550                $self->handle_request(); 
    7651            }; 
    77             close $socket; 
     52            $ascgi->restore; 
     53 
     54            $heap->{client}->put($ascgi->response); 
     55            $kernel->yield('shutdown'); 
    7856        }, 
    7957    );