Changeset 17384

Show
Ignore:
Timestamp:
08/11/08 14:55:08 (6 years ago)
Author:
tokuhirom
Message:

No Context!

Location:
lang/perl/HTTP-Engine/trunk
Files:
6 added
33 modified
2 copied
7 moved

Legend:

Unmodified
Added
Removed
  • lang/perl/HTTP-Engine/trunk/MANIFEST

    r17168 r17384  
    11Changes 
    22examples/dumper.pl 
     3examples/lighty/access.log 
     4examples/lighty/error.log 
    35examples/lighty/lighty.conf 
    46examples/lighty/lighty_external_fcgi.conf 
     
    2931inc/Test/More.pm 
    3032lib/HTTP/Engine.pm 
    31 lib/HTTP/Engine/Context.pm 
     33lib/HTTP/Engine/Compat.pm 
     34lib/HTTP/Engine/Compat/Context.pm 
    3235lib/HTTP/Engine/Cookbook.pod 
    3336lib/HTTP/Engine/Interface/CGI.pm 
     
    3639lib/HTTP/Engine/Interface/POE.pm 
    3740lib/HTTP/Engine/Interface/ServerSimple.pm 
     41lib/HTTP/Engine/Interface/ServerSimple/ResponseWriter.pm 
    3842lib/HTTP/Engine/Interface/Standalone.pm 
    3943lib/HTTP/Engine/Interface/Standalone/RequestBuilder.pm 
     
    4852lib/HTTP/Engine/RequestProcessor.pm 
    4953lib/HTTP/Engine/Response.pm 
     54lib/HTTP/Engine/ResponseFinalizer.pm 
    5055lib/HTTP/Engine/ResponseWriter.pm 
    5156lib/HTTP/Engine/Role/Interface.pm 
     
    6671t/00_compile.t 
    6772t/010_core/abstract_method.t 
    68 t/010_core/context.t 
    69 t/010_core/middleware-import.t 
    70 t/010_core/middleware-import_loadmethods.t 
    71 t/010_core/middleware-load_middleware.t 
    72 t/010_core/middleware-wrap.t 
    7373t/010_core/request-absolute_uri.t 
    7474t/010_core/request-as_http_request.t 
     
    7676t/010_core/request-body.t 
    7777t/010_core/request-content.t 
     78t/010_core/request-cookie.t 
     79t/010_core/request-hostname.t 
     80t/010_core/request-parameters.t 
    7881t/010_core/request-params.t 
    7982t/010_core/request-parse.t 
    80 t/010_core/request-uri_with.t 
     83t/010_core/request-raw_body.t 
     84t/010_core/request-secure.t 
     85t/010_core/request-uri.t 
    8186t/010_core/request.t 
     87t/010_core/request_builder_dummy.t 
     88t/010_core/request_processor-catch_error.t 
    8289t/010_core/request_upload-basename.t 
    8390t/010_core/response-set_http_response.t 
    8491t/010_core/response-status.t 
    8592t/010_core/response.t 
    86 t/010_core/response_redirect.t 
     93t/010_core/response_finalizer.t 
    8794t/010_core/response_writer.t 
    8895t/010_core/responsewriter-with_io.t 
     
    9097t/020_interface/lighty-fcgi.t 
    9198t/020_interface/poe.t 
     99t/020_interface/server_simple.t 
    92100t/020_interface/test.t 
     101t/020_interface/test_request_builder.t 
    93102t/020_interface/test_upload.t 
     103t/030_daemonize/raw_body.t 
     104t/030_daemonize/upload.t 
     105t/040_compat/context.t 
     106t/040_compat/middleware-import.t 
     107t/040_compat/middleware-import_loadmethods.t 
     108t/040_compat/middleware-load_middleware.t 
     109t/040_compat/middleware-wrap.t 
     110t/040_compat/request-body.t 
     111t/040_compat/request-context.t 
     112t/040_compat/request-cookie.t 
     113t/040_compat/response_redirect.t 
    94114t/DummyMiddleware.pm 
    95115t/DummyMiddlewareImport.pm 
     
    97117t/response/TestModPerl/Basic.pm 
    98118t/TEST.PL 
     119t/testlib/HTTP/Engine/Middleware/Foo.pm 
     120t/testlib/HTTPEx/Middleware/Bar.pm 
     121t/Utils.pm 
    99122TODO 
  • lang/perl/HTTP-Engine/trunk/MANIFEST.SKIP

    r17161 r17384  
    2020^nytprof 
    2121^cover_db 
     22\.sw[po]$ 
  • lang/perl/HTTP-Engine/trunk/Makefile.PL

    r17168 r17384  
    2929all_from 'lib/HTTP/Engine.pm'; 
    3030 
    31 requires 'Moose' => 0.54; 
     31requires 'Moose' => 0.55; 
    3232requires 'MooseX::Types' => 0.04; 
    3333requires 'Scalar::Util'; 
  • lang/perl/HTTP-Engine/trunk/examples/dumper.pl

    r11805 r17384  
    1313        }, 
    1414        request_handler => sub { 
    15             my $c = shift; 
     15            my $req = shift; 
    1616            local $Data::Dumper::Sortkeys = 1; 
    17             die "OK!" if ($c->req->body_params->{'foo'} || '') eq 'ok'; 
    18             my $req_dump = Dumper( $c->req ); 
    19             my $raw      = $c->req->raw_body; 
     17            die "OK!" if ($req->body_params->{'foo'} || '') eq 'ok'; 
     18            my $req_dump = Dumper( $req ); 
     19            my $raw      = $req->raw_body; 
    2020            my $body     = strip tt q{  
    2121                <form method="post"> 
     
    3333            }; 
    3434 
    35             $c->res->body($body); 
     35            HTTP::Engine::Response->new( 
     36                status => 200, 
     37                body   => $body, 
     38            ); 
    3639        }, 
    3740    }, 
  • lang/perl/HTTP-Engine/trunk/lib/HTTP/Engine.pm

    r17369 r17384  
    33use HTTP::Engine::Types::Core qw( Interface ); 
    44our $VERSION = '0.0.13_1'; 
    5 use HTTP::Engine::Context; 
    65use HTTP::Engine::Request; 
    76use HTTP::Engine::Request::Upload; 
     
    1514    handles => [ qw(run load_plugins) ], 
    1615); 
    17  
    18 sub import { 
    19     my($class, %args) = @_; 
    20     return unless $args{middlewares} && ref $args{middlewares} eq 'ARRAY'; 
    21     $class->load_middlewares(@{ $args{middlewares} }); 
    22 } 
    23  
    24 sub load_middlewares { 
    25     my ($class, @middlewares) = @_; 
    26     for my $middleware (@middlewares) { 
    27         $class->load_middleware( $middleware ); 
    28     } 
    29 } 
    30  
    31 sub load_middleware { 
    32     my ($class, $middleware) = @_; 
    33  
    34     my $pkg; 
    35     if (($pkg = $middleware) =~ s/^(\+)//) { 
    36         Class::MOP::load_class($pkg); 
    37     } else { 
    38         $pkg = 'HTTP::Engine::Middleware::' . $middleware; 
    39         unless (eval { Class::MOP::load_class($pkg) }) { 
    40             $pkg = 'HTTPEx::Middleware::' . $middleware; 
    41             Class::MOP::load_class($pkg); 
    42         } 
    43     } 
    44  
    45     if ($pkg->meta->has_method('setup')) { 
    46         $pkg->setup(); 
    47     } 
    48  
    49     if ($pkg->meta->has_method('wrap')) { 
    50         HTTP::Engine::RequestProcessor->meta->make_mutable; 
    51         HTTP::Engine::RequestProcessor->meta->add_around_method_modifier( 
    52             call_handler => $pkg->meta->get_method('wrap')->body 
    53         ); 
    54         HTTP::Engine::RequestProcessor->meta->make_immutable; 
    55     } 
    56 } 
    5716 
    5817no Moose; 
  • lang/perl/HTTP-Engine/trunk/lib/HTTP/Engine/Compat/Context.pm

    r13360 r17384  
    1 package HTTP::Engine::Context; 
     1package HTTP::Engine::Compat::Context; 
    22use Moose; 
    33use HTTP::Engine::Request; 
     
    4040=head1 NAME 
    4141 
    42 HTTP::Engine::Context - Context object 
     42HTTP::Engine::Compat::Context - Context object 
    4343 
    4444=head1 SYNOPSIS 
  • lang/perl/HTTP-Engine/trunk/lib/HTTP/Engine/Interface/FCGI.pm

    r14906 r17384  
    139139 
    140140use HTTP::Engine::ResponseWriter; 
     141HTTP::Engine::ResponseWriter->meta->make_mutable; 
    141142HTTP::Engine::ResponseWriter->meta->add_method( _write => sub { 
    142143    my($self, $buffer) = @_; 
     
    155156    *STDOUT->syswrite($buffer); 
    156157}); 
     158HTTP::Engine::ResponseWriter->meta->make_immutable; 
    157159 
    1581601; 
  • lang/perl/HTTP-Engine/trunk/lib/HTTP/Engine/Interface/ServerSimple/ResponseWriter.pm

    r17282 r17384  
    33 
    44before finalize => sub { 
    5     my($self, $c) = @_; 
    6     $c->res->headers->header( 
     5    my($self, $req, $res) = @_; 
     6    $res->headers->header( 
    77        Connection => 'close' 
    88    ); 
  • lang/perl/HTTP-Engine/trunk/lib/HTTP/Engine/Interface/Standalone/ResponseWriter.pm

    r17154 r17384  
    1010 
    1111before finalize => sub { 
    12     my($self, $c) = @_; 
     12    my($self, $req, $res) = @_; 
    1313 
    14     $c->res->headers->date(time); 
    15     $c->res->headers->header( 
     14    $res->headers->date(time); 
     15    $res->headers->header( 
    1616        Connection => $self->keepalive ? 'keep-alive' : 'close' 
    1717    ); 
  • lang/perl/HTTP-Engine/trunk/lib/HTTP/Engine/Interface/Test/ResponseWriter.pm

    r17313 r17384  
    1313 
    1414sub finalize { 
    15     my ( $self, $c ) = @_; 
     15    my ( $self, $req, $res ) = @_; 
    1616 
    17     HTTP::Engine::ResponseFinalizer->finalize($c->req => $c->res); 
    18     $self->_response($c->res->as_http_response); 
     17    HTTP::Engine::ResponseFinalizer->finalize($req => $res); 
     18    $self->_response($res->as_http_response); 
    1919} 
    2020 
  • lang/perl/HTTP-Engine/trunk/lib/HTTP/Engine/Request.pm

    r17305 r17384  
    7171} 
    7272 
    73 has context => ( 
    74     is       => 'rw', 
    75     isa      => 'HTTP::Engine::Context', 
    76     weak_ref => 1, 
    77 ); 
    78  
    7973has cookies => ( 
    8074    is      => 'rw', 
     
    231225sub _build_uploads { 
    232226    my $self = shift; 
    233     $self->request_builder->_prepare_uploads($self->context); 
     227    $self->request_builder->_prepare_uploads($self); 
    234228} 
    235229 
  • lang/perl/HTTP-Engine/trunk/lib/HTTP/Engine/RequestProcessor.pm

    r17368 r17384  
    1010use HTTP::Engine::RequestBuilder; 
    1111use HTTP::Engine::ResponseWriter; 
     12use HTTP::Engine::ResponseFinalizer; 
    1213 
    1314with qw(HTTP::Engine::Role::RequestProcessor); 
     
    1819    isa      => 'CodeRef', 
    1920    required => 1, 
    20 ); 
    21  
    22 has context_class => ( 
    23     is => 'rw', 
    24     isa => 'ClassName', 
    25     default => 'HTTP::Engine::Context', 
    2621); 
    2722 
     
    5045); 
    5146 
    52 has chunk_size => ( 
    53     is      => 'ro', 
    54     isa     => 'Int', 
    55     default => 4096, 
    56 ); 
    57  
    5847__PACKAGE__->meta->make_immutable; 
    5948no Moose; 
     
    6251    my ( $self, %args ) = @_; 
    6352 
    64     $self->context_class->new( 
    65         req => $args{req} || $self->request_class->new( 
    66             request_builder => $self->request_builder, 
    67             ($args{request_args} ? %{ $args{request_args} } : ()), 
    68         ), 
    69         res => $args{res} || $self->response_class->new( 
    70             ($args{response_args} ? %{ $args{response_args} } : ()), 
    71         ), 
    72         %args, 
     53    my $req = $args{req} || $self->request_class->new( 
     54        request_builder => $self->request_builder, 
     55        ($args{request_args} ? %{ $args{request_args} } : ()), 
    7356    ); 
    7457} 
    7558 
    76 my $rp; 
    77 sub handle_request { 
    78     my ( $self, %args ) = @_; 
    79  
    80     my $context = $self->make_context(%args); 
    81  
     59    my $res; 
    8260    my $ret = eval { 
    8361        $rp = sub { $self }; 
    84         call_handler($context); 
     62        $res = call_handler($req); 
     63        unless (Scalar::Util::blessed($res) && $res->isa('HTTP::Engine::Response')) { 
     64            die "You should return instance of HTTP::Engine::Response."; 
     65        } 
    8566    }; 
    8667    if (my $e = $@) { 
    8768        print STDERR $e; 
    88         $context->res->status(500); 
    89         $context->res->body('internal server error'); 
     69        $res = HTTP::Engine::Response->new( 
     70            status => 500, 
     71            body => 'internal server errror', 
     72        ); 
    9073    } 
    9174 
    92     $self->response_writer->finalize($context); 
     75    HTTP::Engine::ResponseFinalizer->finalize( $req => $res ); 
     76    $self->response_writer->finalize($req, $res); 
    9377 
    9478    $ret; 
     
    9781# hooked by middlewares. 
    9882sub call_handler { 
    99     my $context = shift; 
    100     $rp->()->handler->($context); 
     83    my $req = shift; 
     84    $rp->()->handler->($req); 
    10185} 
    10286 
  • lang/perl/HTTP-Engine/trunk/lib/HTTP/Engine/Response.pm

    r17313 r17384  
    2626); 
    2727 
    28 has location => ( 
    29     is  => 'rw', 
    30     isa => 'Str', 
    31 ); 
    32  
    3328has status => ( 
    3429    is      => 'rw', 
     
    5146 
    5247*output = \&body; 
    53  
    54 sub redirect { 
    55     my $self = shift; 
    56  
    57     if (@_) { 
    58         $self->location( shift ); 
    59         $self->status( shift || 302 ); 
    60     } 
    61  
    62     $self->location; 
    63 } 
    6448 
    6549sub set_http_response { 
  • lang/perl/HTTP-Engine/trunk/lib/HTTP/Engine/ResponseFinalizer.pm

    r17313 r17384  
    1010    Carp::confess 'argument missing: $res' unless $res; 
    1111 
    12     # Handle redirects 
    13     if (my $location = $res->location ) { 
    14         $res->header( Location => $req->absolute_url($location) ); 
    15         $res->body($res->status . ': Redirect') unless $res->body; 
    16     } 
     12    # protocol 
     13    $res->protocol( $req->protocol ) unless $res->protocol; 
    1714 
    1815    # Content-Length 
  • lang/perl/HTTP-Engine/trunk/lib/HTTP/Engine/ResponseWriter.pm

    r17313 r17384  
    2626 
    2727sub finalize { 
    28     my($self, $c) = @_; 
    29  
    30     local *STDOUT = $c->req->_connection->{output_handle}; 
    31     croak "argument missing" unless $c; 
     28    my($self, $req, $res) = @_; 
     29    Carp::croak "argument missing" unless $res; 
    3230 
    3331    delete $self->{_prepared_write}; 
    3432 
    35     $c->res->protocol( $c->req->protocol ) unless $c->res->protocol; 
    36     HTTP::Engine::ResponseFinalizer->finalize( $c->req => $c->res ); 
    37  
    38     $self->_write($self->_response_line($c) . $CRLF) if $self->should_write_response_line; 
    39     $self->_write($c->res->headers->as_string($CRLF)); 
     33    local *STDOUT = $req->_connection->{output_handle}; 
     34    $self->_write($self->_response_line($res) . $CRLF) if $self->should_write_response_line; 
     35    $self->_write($res->headers->as_string($CRLF)); 
    4036    $self->_write($CRLF); 
    41     $self->_output_body($c->res); 
     37    $self->_output_body($res); 
    4238} 
    4339 
     
    5955 
    6056sub _response_line { 
    61     my ( $self, $c ) = @_; 
     57    my ( $self, $res ) = @_; 
    6258 
    63     join(" ", $c->res->protocol, $c->res->status, HTTP::Status::status_message($c->res->status)); 
     59    join(" ", $res->protocol, $res->status, HTTP::Status::status_message($res->status)); 
    6460} 
    6561 
  • lang/perl/HTTP-Engine/trunk/lib/HTTP/Engine/Role/RequestBuilder/HTTPBody.pm

    r17245 r17384  
    6767 
    6868sub _prepare_uploads  { 
    69     my($self, $c) = @_; 
     69    my($self, $req) = @_; 
    7070 
    71     my $req     = $c->req; 
    7271    my $uploads = $req->http_body->upload; 
    7372    my %uploads; 
  • lang/perl/HTTP-Engine/trunk/t/010_core/request-body.t

    r17318 r17384  
    2222    $req, 
    2323    sub { 
    24         my $c = shift; 
    25         is $c->req->raw_body, 'foo=bar'; 
    26         is_deeply $c->req->body_params, { foo => 'bar' }; 
     24        my $req = shift; 
     25        is $req->raw_body, 'foo=bar'; 
     26        is_deeply $req->body_params, { foo => 'bar' }; 
     27        return ok_response; 
    2728    }, 
    2829); 
  • lang/perl/HTTP-Engine/trunk/t/010_core/request-cookie.t

    r17317 r17384  
    2020    # do test 
    2121    run_engine($req, sub { 
    22         my $c = shift; 
    23         is $c->req->cookie('Foo')->value, 'Bar'; 
    24         is $c->req->cookie('Bar')->value, 'Baz'; 
    25         is_deeply $c->req->cookies, {Foo => 'Foo=Bar; path=/', Bar => 'Bar=Baz; path=/'}; 
     22        my $req = shift; 
     23        is $req->cookie('Foo')->value, 'Bar'; 
     24        is $req->cookie('Bar')->value, 'Baz'; 
     25        is_deeply $req->cookies, {Foo => 'Foo=Bar; path=/', Bar => 'Bar=Baz; path=/'}; 
     26        return ok_response; 
    2627    }); 
    2728}; 
     
    3738    # do test 
    3839    run_engine($req, sub { 
    39         my $c = shift; 
    40         is_deeply $c->req->cookies, {}; 
     40        my $req = shift; 
     41        is_deeply $req->cookies, {}; 
     42        return ok_response; 
    4143    }); 
    4244}; 
  • lang/perl/HTTP-Engine/trunk/t/010_core/request-hostname.t

    r17305 r17384  
    1313# get hostname by REMOTE_ADDR 
    1414$ENV{REMOTE_HOST} = ''; 
    15 $ENV{REMOTE_ADDR} = "208.77.188.166"; 
    16 is _get(), "www.example.com"; 
     15$ENV{REMOTE_ADDR} = "127.0.0.1"; 
     16ok _get(); 
    1717 
    1818sub _get { 
  • lang/perl/HTTP-Engine/trunk/t/010_core/request.t

    r13758 r17384  
    88 
    99can_ok( "HTTP::Engine::Request", 
    10     qw(address context cookies method protocol query_parameters secure uri user raw_body headers), 
     10    qw(address cookies method protocol query_parameters secure uri user raw_body headers), 
    1111    qw(body_params input params query_params path_info base body), 
    1212    qw(body_parameters cookies hostname param parameters path upload uploads), 
  • lang/perl/HTTP-Engine/trunk/t/010_core/response.t

    r17283 r17384  
    88 
    99can_ok( "HTTP::Engine::Response", 
    10     qw(body cookies location status headers output redirect set_http_response), 
     10    qw(body cookies status headers output set_http_response), 
    1111    # delegated methods 
    1212    qw(content_encoding content_length content_type header) 
  • lang/perl/HTTP-Engine/trunk/t/010_core/response_writer.t

    r13758 r17384  
    44use IO::Scalar; 
    55use_ok "HTTP::Engine::ResponseWriter"; 
    6 use HTTP::Engine::Context; 
     6use HTTP::Engine::Request; 
     7use HTTP::Engine::Response; 
     8use HTTP::Engine::ResponseFinalizer; 
    79 
    810can_ok "HTTP::Engine::ResponseWriter", 'finalize'; 
    911 
    10 my $c = HTTP::Engine::Context->new; 
    11 $c->req->protocol('HTTP/1.1'); 
    12 $c->req->method('GET'); 
    13 $c->res->body("OK"); 
     12my $req = HTTP::Engine::Request->new; 
     13$req->protocol('HTTP/1.1'); 
     14$req->method('GET'); 
     15 
     16my $res = HTTP::Engine::Response->new(status => '200', body => 'OK'); 
    1417 
    1518tie *STDOUT, 'IO::Scalar', \my $out; 
    1619my $rw = HTTP::Engine::ResponseWriter->new(should_write_response_line => 1); 
    17 $rw->finalize($c); 
     20HTTP::Engine::ResponseFinalizer->finalize( $req, $res ); 
     21$rw->finalize($req, $res); 
    1822untie *STDOUT; 
    1923 
  • lang/perl/HTTP-Engine/trunk/t/010_core/responsewriter-with_io.t

    r13758 r17384  
    33use HTTP::Engine::ResponseWriter; 
    44use HTTP::Engine::Response; 
    5 use HTTP::Engine::Context; 
     5use HTTP::Engine::Request; 
    66use HTTP::Response; 
    77use File::Temp qw/:seekable/; 
     
    3939tie *STDOUT, 'IO::Scalar', \my $out; 
    4040 
    41 my $c = HTTP::Engine::Context->new( 
    42     req => HTTP::Engine::Request->new, 
    43     res => HTTP::Engine::Response->new, 
    44     env => {}, 
     41my $req = HTTP::Engine::Request->new( 
     42    protocol => 'HTTP/1.1', 
     43    method => 'GET', 
    4544); 
    46 $c->req->protocol('HTTP/1.1'); 
    47 $c->req->method('GET'); 
    48 $c->res->body( $tmp ); 
    49 $writer->finalize($c); 
     45my $res = HTTP::Engine::Response->new(body => $tmp, status => 200); 
     46HTTP::Engine::ResponseFinalizer->finalize( $req, $res ); 
     47$writer->finalize($req, $res); 
    5048 
    5149untie *STDOUT; 
  • lang/perl/HTTP-Engine/trunk/t/020_interface/cgi.t

    r13758 r17384  
    2525            args => { }, 
    2626            request_handler => sub { 
    27                 my $c = shift; 
    28                 $c->res->header( 'X-Req-Base' => $c->req->base ); 
    29                 $c->res->body('OK!'); 
     27                my $req = shift; 
     28                HTTP::Engine::Response->new( 
     29                    status  => 200, 
     30                    headers => HTTP::Headers->new( 'X-Req-Base' => $req->base, ), 
     31                    body    => 'OK!', 
     32                ); 
    3033            }, 
    3134        }, 
  • lang/perl/HTTP-Engine/trunk/t/020_interface/lighty-fcgi.t

    r17324 r17384  
    11use strict; 
    22use warnings; 
    3  
    4 # this file is copied from Catalyst. thanks! 
    5  
    6 use File::Path; 
    7 use FindBin; 
    8 use IO::Socket; 
    93use Test::More; 
    10 use t::Utils; 
    11  
    12 plan skip_all => 'set TEST_LIGHTTPD to enable this test'  
    13     unless $ENV{TEST_LIGHTTPD}; 
    14      
    15 eval "use FCGI"; 
    16 plan skip_all => 'FCGI required' if $@; 
    17  
    18 eval "use Test::Harness"; 
    19 plan skip_all => 'Test::Harness required' if $@; 
    20  
    21 my $lighttpd_bin = $ENV{LIGHTTPD_BIN} || `which lighttpd`; 
    22 chomp $lighttpd_bin; 
    23  
    24 plan skip_all => 'Please set LIGHTTPD_BIN to the path to lighttpd' 
    25     unless $lighttpd_bin && -x $lighttpd_bin; 
    26  
    27 plan tests => 1; 
    28  
    29 # clean up 
    30 rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp"; 
    31  
    32 # create a TestApp and copy the test libs into it 
    33 mkdir "$FindBin::Bin/../t/tmp"; 
    34 chdir "$FindBin::Bin/../t/tmp"; 
    35 chdir "$FindBin::Bin/.."; 
    36  
    37 # remove TestApp's tests 
    38 rmtree 't/tmp/TestApp/t'; 
    39  
    40 # Create a temporary lighttpd config 
    41 my $docroot = "$FindBin::Bin/../t/tmp"; 
    42 my $port    = empty_port; 
    43  
    44 # Clean up docroot path 
    45 $docroot =~ s{/t/..}{}; 
    46  
    47 my $conf = <<"END"; 
    48 # basic lighttpd config file for testing fcgi+HTTP::Engine 
    49 server.modules = ( 
    50     "mod_access", 
    51     "mod_fastcgi", 
    52     "mod_accesslog" 
    53 ) 
    54  
    55 server.document-root = "$docroot" 
    56  
    57 server.errorlog    = "$docroot/error.log" 
    58 accesslog.filename = "$docroot/access.log" 
    59  
    60 server.bind = "127.0.0.1" 
    61 server.port = $port 
    62  
    63 # HTTP::Engine app specific fcgi setup 
    64 fastcgi.server = ( 
    65     "" => ( 
    66         "FastCgiTest" => ( 
    67             "socket"          => "$docroot/test.socket", 
    68             "check-local"     => "disable", 
    69             "bin-path"        => "$docroot/test_fastcgi.pl", 
    70             "min-procs"       => 1, 
    71             "max-procs"       => 1, 
    72             "idle-timeout"    => 20, 
    73             "bin-environment" => ( 
    74                 "PERL5LIB" => "$docroot/../../lib" 
    75             ) 
    76         ) 
    77     ) 
    78 ) 
    79 END 
    80  
    81 open(my $lightconf, '>', "$docroot/lighttpd.conf")  
    82   or die "Can't open $docroot/lighttpd.conf: $!"; 
    83 print {$lightconf} $conf or die "Write error: $!"; 
    84 close $lightconf; 
    85  
    86 my $pid = open my $lighttpd, "$lighttpd_bin -D -f $docroot/lighttpd.conf 2>&1 |"  
    87     or die "Unable to spawn lighttpd: $!"; 
    88      
    89 # wait for it to start 
    90 while ( check_port( 'localhost', $port ) != 1 ) { 
    91     diag "Waiting for server to start..."; 
    92     sleep 1; 
    93 } 
     4use LWP::UserAgent; 
     5use t::FCGIUtils; 
    946 
    957# DO TESTS. 
    96 warn "XXX ここでテストする XXXX"; 
     8test_lighty( 
     9    <<'...', 
     10#!/usr/bin/perl 
     11use strict; 
     12use warnings; 
     13use HTTP::Engine; 
     14use HTTP::Engine::Response; 
    9715 
    98 # shut it down 
    99 kill 'INT', $pid; 
    100 close $lighttpd; 
     16HTTP::Engine->new( 
     17    interface => { 
     18        module => 'FCGI', 
     19        args   => { 
     20            nproc => 1, 
     21        }, 
     22        request_handler => sub { 
     23            my $req = shift; 
    10124 
    102 # clean up 
    103 rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp"; 
     25            HTTP::Engine::Response->new( 
     26                body => "OK", 
     27            ); 
     28         } 
     29    }, 
     30)->run; 
     31... 
     32    sub { 
     33        my ($port, ) = @_; 
    10434 
    105 sub check_port { 
    106     my ( $host, $port ) = @_; 
     35        plan tests => 2; 
    10736 
    108     my $remote = IO::Socket::INET->new( 
    109         Proto    => "tcp", 
    110         PeerAddr => $host, 
    111         PeerPort => $port 
    112     ); 
    113     if ($remote) { 
    114         close $remote; 
    115         return 1; 
    116     } 
    117     else { 
    118         return 0; 
    119     } 
    120 } 
     37        my $ua = LWP::UserAgent->new(); 
     38        my $res = $ua->get("http://localhost:$port/"); 
     39        ok $res->is_success; 
     40        is $res->content, "OK"; 
     41    }, 
     42); 
     43 
  • lang/perl/HTTP-Engine/trunk/t/020_interface/poe.t

    r17365 r17384  
    1616HTTP::Engine::Interface::POE->new( 
    1717    request_handler => sub { 
    18         my $c = shift; 
    19         $c->res->body($c->req->method); 
     18        my $req = shift; 
     19        HTTP::Engine::Response->new( 
     20            status => 200, 
     21            body   => $req->method, 
     22        ); 
    2023    }, 
    2124    alias => 'he', 
  • lang/perl/HTTP-Engine/trunk/t/020_interface/server_simple.t

    r17324 r17384  
    88use HTTP::Request::Common qw(POST $DYNAMIC_FILE_UPLOAD); 
    99use HTTP::Engine; 
     10use t::Utils; 
    1011 
    1112my $port = empty_port; 
     
    4647            }, 
    4748            request_handler => sub { 
    48                 my $c = shift; 
    49                 $c->res->body($c->req->upload("test")->slurp()); 
     49                my $req = shift; 
     50                HTTP::Engine::Response->new(body => $req->upload("test")->slurp(), status => 200); 
    5051            }, 
    5152        }, 
  • lang/perl/HTTP-Engine/trunk/t/020_interface/test.t

    r17154 r17384  
    1818            module => 'Test', 
    1919            request_handler => sub { 
    20                 my $c = shift; 
     20                my $req = shift; 
     21                my $res = HTTP::Engine::Response->new( 
     22                    headers => HTTP::Headers->new( 
     23                        'X-Req-Test' => "ping" 
     24                    ), 
     25                    body => 'OK!', 
     26                ); 
    2127                eval $block->code; 
    2228                die $@ if $@; 
    23                 $c->res->header( 'X-Req-Test' => "ping" ); 
    24                 $c->res->body('OK!'); 
     29                return $res; 
    2530            }, 
    2631        }, 
     
    5055OK! 
    5156 
    52 === $c->req->base 
     57=== $req->base 
    5358--- code 
    54 $c->res->header('X-Req-Base' => $c->req->base); 
     59$res->header('X-Req-Base' => $req->base); 
    5560--- response 
    5661Content-Length: 3 
  • lang/perl/HTTP-Engine/trunk/t/020_interface/test_upload.t

    r17210 r17384  
    3535            module => 'Test', 
    3636            request_handler => sub { 
    37                 my $c = shift; 
    38                 $c->res->body('OK!'); 
    39                 return unless $body; 
     37                my $req = shift; 
     38                my $res = HTTP::Engine::Response->new( 
     39                    status => 200, 
     40                    body   => 'OK!', 
     41                ); 
     42                return $res unless $body; 
    4043 
    41                 return unless $upload = $c->req->upload('test_upload_file'); 
     44                return $res unless $upload = $req->upload('test_upload_file'); 
    4245                my $upload_body = $upload->slurp; 
    4346                unless ($body eq $upload_body) { 
    44                     $c->res->body('NG'); 
     47                    $res->body('NG'); 
    4548                } 
     49                return $res; 
    4650            }, 
    4751        }, 
  • lang/perl/HTTP-Engine/trunk/t/030_daemonize/raw_body.t

    r17298 r17384  
    1919        }, 
    2020        request_handler => sub { 
    21             my $c = shift; 
    22             $c->res->body($c->req->raw_body); 
     21            my $req = shift; 
     22            HTTP::Engine::Response->new( 
     23                status => 200, 
     24                body   => $req->raw_body, 
     25            ); 
    2326        }, 
    2427    }, 
  • lang/perl/HTTP-Engine/trunk/t/030_daemonize/upload.t

    r17298 r17384  
    1919        }, 
    2020        request_handler => sub { 
    21             my $c = shift; 
    22             $c->res->body($c->req->upload("test")->slurp()); 
     21            my $req = shift; 
     22            HTTP::Engine::Response->new( 
     23                status => 200, 
     24                body   => $req->upload("test")->slurp(), 
     25            ); 
    2326        }, 
    2427    }, 
  • lang/perl/HTTP-Engine/trunk/t/040_compat/context.t

    r13758 r17384  
    11use strict; 
    22use warnings; 
    3 use HTTP::Engine::Context; 
     3use HTTP::Engine::Compat; 
    44use Scalar::Util qw/refaddr/; 
    55use Test::More tests => 3; 
    66 
    7 my $c = HTTP::Engine::Context->new; 
     7my $c = HTTP::Engine::Compat::Context->new; 
    88is refaddr( $c->req ), refaddr( $c->request ),  'alias'; 
    99is refaddr( $c->res ), refaddr( $c->response ), 'alias'; 
  • lang/perl/HTTP-Engine/trunk/t/040_compat/middleware-import.t

    r17366 r17384  
    33use lib '.'; 
    44use lib 't/testlib'; 
    5 use HTTP::Engine middlewares => ['+t::DummyMiddlewareImport', 'Foo', 'Bar']; 
     5use HTTP::Engine::Compat middlewares => ['+t::DummyMiddlewareImport', 'Foo', 'Bar']; 
    66use Test::More tests => 5; 
    77 
  • lang/perl/HTTP-Engine/trunk/t/040_compat/middleware-import_loadmethods.t

    r13758 r17384  
    22use warnings; 
    33use lib '.'; 
    4 use HTTP::Engine; 
     4use HTTP::Engine::Compat; 
    55use Test::More tests => 1; 
    66 
    7 HTTP::Engine->load_middlewares(qw/+t::DummyMiddlewareImport/); 
     7HTTP::Engine::Compat->load_middlewares(qw/+t::DummyMiddlewareImport/); 
    88 
    99our $setup; 
  • lang/perl/HTTP-Engine/trunk/t/040_compat/middleware-load_middleware.t

    r13758 r17384  
    22use warnings; 
    33use lib '.'; 
    4 use HTTP::Engine; 
     4use HTTP::Engine::Compat; 
    55use Test::More tests => 1; 
    66 
    77our $setup; 
    88 
    9 HTTP::Engine->load_middleware('+t::DummyMiddleware'); 
     9HTTP::Engine::Compat->load_middleware('+t::DummyMiddleware'); 
    1010is $main::setup, 'ok'; 
  • lang/perl/HTTP-Engine/trunk/t/040_compat/middleware-wrap.t

    r17318 r17384  
    22use warnings; 
    33use lib '.'; 
    4 use HTTP::Engine middlewares => ['+t::DummyMiddlewareWrap']; 
     4use HTTP::Engine::Compat middlewares => ['+t::DummyMiddlewareWrap']; 
    55use Test::More tests => 2; 
    66use t::Utils; 
  • lang/perl/HTTP-Engine/trunk/t/040_compat/request-body.t

    r17318 r17384  
    33use Test::More tests => 2; 
    44use t::Utils; 
    5 use HTTP::Engine; 
     5use HTTP::Engine::Compat; 
    66use HTTP::Request; 
    77 
  • lang/perl/HTTP-Engine/trunk/t/040_compat/request-cookie.t

    r17317 r17384  
    33use Test::More tests => 4; 
    44use t::Utils; 
    5 use HTTP::Engine; 
     5use HTTP::Engine::Compat; 
    66use HTTP::Request; 
    77use CGI::Simple::Cookie; 
  • lang/perl/HTTP-Engine/trunk/t/040_compat/response_redirect.t

    r17370 r17384  
    22use warnings; 
    33use Test::More tests => 6; 
    4 use HTTP::Engine::Context; 
     4use HTTP::Engine::Compat; 
     5use HTTP::Engine::Compat::Context; 
    56use HTTP::Engine::ResponseFinalizer; 
    67 
  • lang/perl/HTTP-Engine/trunk/t/Utils.pm

    r17317 r17384  
    88 
    99use Sub::Exporter -setup => { 
    10     exports => [qw/ empty_port daemonize daemonize_all interfaces run_engine /], 
     10    exports => [qw/ empty_port daemonize daemonize_all interfaces run_engine ok_response check_port wait_port /], 
    1111    groups  => { default => [':all'] } 
    1212}; 
     
    8484} 
    8585 
     86sub ok_response { 
     87    HTTP::Engine::Response->new( 
     88        status => 200, 
     89        body => 'ok', 
     90    ); 
     91} 
     92 
     93sub check_port { 
     94    my ( $port ) = @_; 
     95 
     96    my $remote = IO::Socket::INET->new( 
     97        Proto    => "tcp", 
     98        PeerAddr => '127.0.0.1', 
     99        PeerPort => $port 
     100    ); 
     101    if ($remote) { 
     102        close $remote; 
     103        return 1; 
     104    } 
     105    else { 
     106        return 0; 
     107    } 
     108} 
     109 
     110sub wait_port { 
     111    my $port = shift; 
     112 
     113    my $retry = 10; 
     114    while ($retry--) { 
     115        return if check_port($port); 
     116        sleep 1; 
     117    } 
     118    die "cannot open port: $port"; 
     119} 
     120 
    861211; 
  • lang/perl/HTTP-Engine/trunk/tools/benchmark.pl

    r17154 r17384  
    1212        }, 
    1313        request_handler => sub { 
    14             my $c = shift; 
    15             $c->res->status(200); 
     14            my $req = shift; 
     15            HTTP::Engine::Response->new( 
     16                status => 200, 
     17            ) 
    1618        }, 
    1719    } 
  • lang/perl/HTTP-Engine/trunk/tools/profile.pl

    r16135 r17384  
    1010        args            => { port => 9999, }, 
    1111        request_handler => sub { 
    12             my $c = shift; 
    13             $c->res->status(200); 
     12            my $req = shift; 
     13            HTTP::Engine::Response->new( 
     14                status => 200 
     15            ); 
    1416        }, 
    1517    } 
     
    2022$ENV{SERVER_PORT}    = 80; 
    2123 
    22 tie *STDOUT, 'IO::Scalar', \my $out; 
    23 $engine->run; 
    24 untie *STDOUT; 
     24for my $i (0..10000) { 
     25    $engine->run; 
     26} 
    2527