Changeset 17742 for lang

Show
Ignore:
Timestamp:
08/17/08 02:48:07 (5 years ago)
Author:
tokuhirom
Message:

Interface::(?:POE|Standalone): bug fixed around $req->base.

Location:
lang/perl/HTTP-Engine/trunk
Files:
3 modified

Legend:

Unmodified
Added
Removed

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

    r17715 r17742  
    6565            my $host = $request->header('Host'); 
    6666            my $uri = $request->uri; 
    67             $uri->scheme('http')    unless $uri->scheme; 
    68             $uri->host($self->host) unless $uri->host; 
    69             $uri->port($self->port) unless $uri->port; 
    70             $uri->host_port($host)  unless !$host || ( $host eq $uri->host_port ); 
     67            $uri->scheme('http'); 
     68            $uri->host($self->host); 
     69            $uri->port($self->port); 
    7170 
    7271            $self->handle_request( 
    7372                request_args => { 
    7473                    headers => $request->headers, 
    75                     uri     => URI::WithBase->new($uri), 
     74                    uri     => URI::WithBase->new($uri, do { 
     75                        my $u = $uri->clone; 
     76                        $u->path_query('/'); 
     77                        $u; 
     78                    }), 
    7679                    connection_info => { 
    7780                        address    => $heap->{remote_ip}, 

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

    r17718 r17742  
    167167                uri            => URI::WithBase->new( 
    168168                    do { 
    169                         ; 
    170169                        my $u = URI->new($uri); 
    171170                        $u->scheme('http'); 
    172171                        $u->host($headers->header('Host') || $self->host); 
    173172                        $u->port($self->port); 
    174                         $u; 
    175                     } 
     173                        my $b = $u->clone; 
     174                        $b->path_query('/'); 
     175                        ($u, $b); 
     176                    }, 
    176177                ), 
    177178                headers        => $headers, 

  • lang/perl/HTTP-Engine/trunk/t/030_daemonize/uri.t

    r17714 r17742  
    1515    wait_port $port; 
    1616    my $ua = LWP::UserAgent->new(timeout => 10); 
    17     my $res = $ua->get("http://localhost:$port/", 'Foo' => 'Bar'); 
     17    my $res = $ua->get("http://localhost:$port/foobar?foo=bar"); 
    1818    is $res->code, 200; 
    19     like $res->content, qr{http://localhost:\d+/}; 
     19    like $res->content, qr{http://(?:localhost|\Q127.0.0.1\E):\d+/foobar\?foo=bar, http://(?:localhost|\Q127.0.0.1\E):\d+/, /foobar}; 
    2020} => ( 
    2121    poe_kernel_run => 1, 
    … …  
    2828            HTTP::Engine::Response->new( 
    2929                status => 200, 
    30                 body   => join(', ', $req->uri ), 
     30                body   => join(', ', $req->uri, $req->base, $req->path), 
    3131            ); 
    3232        },