Show
Ignore:
Timestamp:
05/01/08 13:03:37 (5 years ago)
Author:
tokuhirom
Message:

structure changes :)

Location:
lang/perl/HTTP-Engine/branches/moose
Files:
9 modified

Legend:

Unmodified
Added
Removed

  • lang/perl/HTTP-Engine/branches/moose/Makefile.PL

    r10866 r10867  
    33all_from 'lib/HTTP/Engine.pm'; 
    44 
    5 { 
    6     no warnings 'redefine'; 
    7     if ($Module::Install::VERSION > 0.70) { 
    8         *recommends_hack = sub { $_[0] } 
    9     } else { 
    10         *recommends_hack = \&recommends; 
    11     } 
    12 } 
    13      
    14  
    15 requires 'Class::Accessor::Fast'; 
    16 requires 'Class::Component'; 
     5requires 'Moose' => 0.40; 
     6requires 'MooseX::Object::Pluggable'; 
    177requires 'Scalar::Util'; 
    188 
    … …  
    2515requires 'CGI::Simple::Cookie'; 
    2616requires 'HTTP::Body'; 
     17requires 'HTTP::Headers'; 
    2718requires 'URI'; 
    2819 

  • lang/perl/HTTP-Engine/branches/moose/examples/moose-dumper.pl

    r10841 r10867  
    55use HTTP::Engine; 
    66use HTTP::Engine::Interface::ServerSimple; 
    7 use Moose::Util 'apply_all_roles'; 
    87use HTTP::Engine::Plugin::DebugScreen; 
    98 
    10  
    11 apply_all_roles('HTTP::Engine', 'HTTP::Engine::Plugin::DebugScreen'); 
    12  
    13 HTTP::Engine->new( 
    14     interface => HTTP::Engine::Interface::ServerSimple->new(port => 9999), 
     9my $engine = HTTP::Engine::Interface::ServerSimple->new( 
     10    port    => 9999, 
    1511    handler => sub { 
    16         my $c = shift; 
    17         my $req_dump = Dumper($c->req); 
    18         my $raw = $c->req->raw_body; 
    19         my $body = <<"..."; 
     12        my $c        = shift; 
     13        my $req_dump = Dumper( $c->req ); 
     14        my $raw      = $c->req->raw_body; 
     15        my $body     = <<"..."; 
    2016    <form method="post"> 
    2117        <input type="text" name="foo" /> 
    … …  
    2824        $c->res->body($body); 
    2925    }, 
    30 )->run; 
     26); 
     27$engine->load_plugins(qw/DebugScreen/); 
     28$engine->run; 
     29 

  • lang/perl/HTTP-Engine/branches/moose/lib/HTTP/Engine.pm

    r10864 r10867  
    44use base 'HTTPEx'; 
    55our $VERSION = '0.0.3'; 
    6  
    7 use HTTP::Engine::Context; 
    8 use HTTP::Engine::Request; 
    9 use HTTP::Engine::Request::Upload; 
    10 use HTTP::Engine::Response; 
    11  
    12 has handler => ( 
    13     is       => 'rw', 
    14     isa      => 'CodeRef', 
    15     required => 1, 
    16 ); 
    17  
    18 has interface => ( 
    19     is       => 'rw', 
    20     does     => 'HTTP::Engine::Role::Interface', 
    21     required => 1, 
    22     handles  => [ qw(prepare finalize) ], 
    23 ); 
    24  
    25 has context_class => ( 
    26     is => 'rw', 
    27     isa => 'Str', 
    28     default => 'HTTP::Engine::Context', 
    29 ); 
    30  
    31 has request_class => ( 
    32     is => 'rw', 
    33     isa => 'Str', 
    34     default => 'HTTP::Engine::Request', 
    35 ); 
    36  
    37 has response_class => ( 
    38     is => 'rw', 
    39     isa => 'Str', 
    40     default => 'HTTP::Engine::Response', 
    41 ); 
    42  
    43 sub handle_request { 
    44     my $self = shift; 
    45  
    46     $self->interface->initialize(); 
    47  
    48     my %env = @_; 
    49        %env = %ENV unless %env; 
    50  
    51     my $context = $self->context_class->new( 
    52         engine => $self, 
    53         req    => $self->request_class->new(), 
    54         res    => $self->response_class->new(), 
    55         env    => \%env, 
    56     ); 
    57  
    58     $self->prepare( $context ); 
    59  
    60     my $ret = eval { 
    61         $self->call_handler($context); 
    62     }; 
    63     if (my $e = $@) { 
    64         $self->handle_error( $context, $e); 
    65     } 
    66     $self->finalize( $context ); 
    67  
    68     $ret; 
    69 } 
    70  
    71 sub run { 
    72     my $self = shift; 
    73     $self->interface->run($self); 
    74 } 
    75  
    76 sub finalize_headers { 
    77     my($self, $c) = @_; 
    78     return if $c->res->{_finalized_headers}; 
    79  
    80     # Handle redirects 
    81     if (my $location = $c->res->redirect ) { 
    82         $self->log( debug => qq/Redirecting to "$location"/ ); 
    83         $c->res->header( Location => $self->absolute_url($c, $location) ); 
    84         $c->res->body($c->res->status . ': Redirect') unless $c->res->body; 
    85     } 
    86  
    87     # Content-Length 
    88     $c->res->content_length(0); 
    89     if ($c->res->body && !$c->res->content_length) { 
    90         # get the length from a filehandle 
    91         if (Scalar::Util::blessed($c->res->body) && $c->res->body->can('read')) { 
    92             if (my $stat = stat $c->res->body) { 
    93                 $c->res->content_length($stat->size); 
    94             } else { 
    95                 $self->log( warn => 'Serving filehandle without a content-length' ); 
    96             } 
    97         } else { 
    98             $c->res->content_length(bytes::length($c->res->body)); 
    99         } 
    100     } 
    101  
    102     $c->res->content_type('text/html') unless $c->res->content_type; 
    103  
    104     # Errors 
    105     if ($c->res->status =~ /^(1\d\d|[23]04)$/) { 
    106         $c->res->headers->remove_header("Content-Length"); 
    107         $c->res->body(''); 
    108     } 
    109  
    110     $self->finalize_cookies($c); 
    111     $self->finalize_output_headers($c); 
    112  
    113     # Done 
    114     $c->res->{_finalized_headers} = 1; 
    115 } 
    116  
    117 # hook me! 
    118 sub call_handler { 
    119     my ($self, $context) = @_; 
    120     $self->handler->($context); 
    121 } 
    1226 
    12371; 

  • lang/perl/HTTP-Engine/branches/moose/lib/HTTP/Engine/Context.pm

    r10825 r10867  
    1212has engine => ( 
    1313    is       => 'rw', 
    14     isa      => 'HTTP::Engine', 
     14    does     => 'HTTP::Engine::Role::Interface', 
    1515    required => 1, 
    1616    weakref  => 1, 

  • lang/perl/HTTP-Engine/branches/moose/lib/HTTP/Engine/Interface/CGI.pm

    r10808 r10867  
    22use Moose; 
    33with 'HTTP::Engine::Role::Interface'; 
     4use Scalar::Util qw/blessed/; 
    45 
    56has read_position => ( 
    … …  
    3839 
    3940sub run { 
    40     my ($self, $engine) = @_; 
    41     $engine->handle_request(); 
    42 } 
    43  
    44 sub prepare { 
    45     my ($self, $context) = @_; 
    46  
    47     for my $method (qw/ request connection query_parameters headers cookie path body body_parameters parameters uploads /) { 
    48         my $method = "prepare_$method"; 
    49         $self->$method($context); 
    50     } 
     41    my ($self, ) = @_; 
     42    $self->handle_request(); 
    5143} 
    5244 
    … …  
    280272# private methods 
    281273 
    282 sub read_chunk { shift; *STDIN->sysread(@_) } 
     274sub read_chunk { 
     275    my $self = shift; 
     276    if (blessed(*STDIN)) { 
     277        *STDIN->sysread(@_); 
     278    } else { 
     279        STDIN->sysread(@_); 
     280    } 
     281} 
    283282#Apache sub read_chunk { shift->apache->read(@_) } 
    284283 
    … …  
    297296 
    298297    my $remaining = $self->read_length - $self->read_position; 
    299     $maxlength ||= $self->chunksize; 
     298    $maxlength ||= $self->chunk_size; 
    300299 
    301300    # Are we done reading? 
    … …  
    321320 
    322321    # Set the output handle to autoflush 
    323     *STDOUT->autoflush(1); 
     322    if (blessed *STDOUT) { 
     323        *STDOUT->autoflush(1); 
     324    } 
    324325} 
    325326 

  • lang/perl/HTTP-Engine/branches/moose/lib/HTTP/Engine/Interface/ServerSimple.pm

    r10808 r10867  
    1313 
    1414sub run { 
    15     my ($self, $engine) = @_; 
     15    my ($self, ) = @_; 
    1616 
    1717    my $simple_meta = Class::MOP::Class->create_anon_class( 
    … …  
    1919        methods => { 
    2020            handler => sub { 
    21                 $engine->handle_request; 
     21                $self->handle_request; 
    2222            } 
    2323        }, 
    … …  
    2727} 
    2828 
    29 sub finalize_output_headers { 
    30     my ( $self, $engine ) = @_; 
    31  
    32     $self->write_response_line($engine); 
    33     $self->SUPER::finalize_output_headers($engine); 
    34 } 
    35  
    36 sub prepare_write { 
    37     # nop. do not *STDOUT->autoflush(1); 
    38 } 
     29before 'finalize_output_headers' => sub { 
     30    my ($self, $c) = @_; 
     31    $self->write_response_line($c); 
     32}; 
    3933 
    40341; 

  • lang/perl/HTTP-Engine/branches/moose/lib/HTTP/Engine/Plugin/DebugScreen.pm

    r10827 r10867  
    11package HTTP::Engine::Plugin::DebugScreen; 
    22use Moose::Role; 
    3 use Carp::Always; 
     3use Carp; 
     4 
     5around call_handler => sub { 
     6    my ($next, @args) = @_; 
     7    local $SIG{__DIE__} = \&Carp::confess; 
     8    $next->(@args); 
     9}; 
    410 
    511around handle_error => sub { 

  • lang/perl/HTTP-Engine/branches/moose/lib/HTTP/Engine/Request.pm

    r10859 r10867  
    11package HTTP::Engine::Request; 
    22use Moose; 
     3with 'MooseX::Object::Pluggable'; 
    34use Carp; 
    45use IO::Socket qw[AF_INET inet_aton]; 
    … …  
    146147sub parameters { 
    147148    my ($self, $params) = @_; 
     149    $self->{parameters} ||= {}; 
     150 
    148151    if ($params) { 
    149152        if (ref $params) { 
    150153            $self->{parameters} = $params; 
    151154        } else { 
    152             $self->context->log->warn( 
     155            warn( 
    153156                "Attempt to retrieve '$params' with req->params(), " . 
    154157                "you probably meant to call req->param('$params')" ); 

  • lang/perl/HTTP-Engine/branches/moose/lib/HTTP/Engine/Role/Interface.pm

    r10860 r10867  
    22use strict; 
    33use Moose::Role; 
     4with 'MooseX::Object::Pluggable'; 
    45 
    5 # PUBLIC INTERFACES: 
    6 #    ->run($engine) 
    7 #    ->prepare($context) 
    8 #    ->finalize($context) 
     6requires 'run', 'finalize_cookies', 'finalize_output_body', 'finalize_output_headers', 'prepare_body'; 
     7requires map { "prepare_$_" } qw/request connection query_parameters headers cookie path body body_parameters parameters uploads/; 
    98 
    10 requires 'run', 'prepare', 'finalize_cookies', 'finalize_output_body', 'finalize_output_headers'; 
     9around 'new' => sub { 
     10    my ($next, @args) = @_; 
     11    my $self = $next->(@args); 
     12    $self->_plugin_app_ns(['HTTP::Engine']); 
     13    $self; 
     14}; 
     15 
     16use HTTP::Engine::Context; 
     17use HTTP::Engine::Request; 
     18use HTTP::Engine::Request::Upload; 
     19use HTTP::Engine::Response; 
     20 
     21has handler => ( 
     22    is       => 'rw', 
     23    isa      => 'CodeRef', 
     24    required => 1, 
     25); 
     26 
     27has context_class => ( 
     28    is => 'rw', 
     29    isa => 'Str', 
     30    default => 'HTTP::Engine::Context', 
     31); 
     32 
     33has request_class => ( 
     34    is => 'rw', 
     35    isa => 'Str', 
     36    default => 'HTTP::Engine::Request', 
     37); 
     38 
     39has response_class => ( 
     40    is => 'rw', 
     41    isa => 'Str', 
     42    default => 'HTTP::Engine::Response', 
     43); 
     44 
     45sub handle_request { 
     46    my $self = shift; 
     47 
     48    $self->initialize(); 
     49 
     50    my %env = @_; 
     51       %env = %ENV unless %env; 
     52 
     53    my $context = $self->context_class->new( 
     54        engine => $self, 
     55        req    => $self->request_class->new(), 
     56        res    => $self->response_class->new(), 
     57        env    => \%env, 
     58    ); 
     59 
     60    $self->prepare( $context ); 
     61 
     62    my $ret = eval { 
     63        $self->call_handler($context); 
     64    }; 
     65    if (my $e = $@) { 
     66        $self->handle_error( $context, $e); 
     67    } 
     68    $self->finalize( $context ); 
     69 
     70    $ret; 
     71} 
     72 
     73# hook me! 
     74sub handle_error { 
     75    my ($self, $context, $error) = @_; 
     76    print STDERR $error; 
     77} 
     78 
     79# hook me! 
     80sub call_handler { 
     81    my ($self, $context) = @_; 
     82    $self->handler->($context); 
     83} 
     84 
     85sub prepare { 
     86    my ($self, $context) = @_; 
     87 
     88    for my $method (qw/ request connection query_parameters headers cookie path body body_parameters parameters uploads /) { 
     89        my $method = "prepare_$method"; 
     90        $self->$method($context); 
     91    } 
     92} 
    1193 
    1294sub finalize {