yappoの日記

2008-11-07

no HTTP::Engine::Interface patch

13:18

主に __INTERFACE__ は黒魔術過ぎるのでいやーん派のlestrratさんが書いたパッチ

request_builder response_writer が lazy build になってたりする。

なんで __INTERFACE__ 使ってるかって言うと、Interface のコードがすっきりするってのが大きな理由。

付随して http://d.hatena.ne.jp/yappo/20080825/1219658040 みたいな話題もあるが __INTERFACE__ の件ではあんまし関係無い。

=== lib/HTTP/Engine/Role/Interface.pm
==================================================================
--- lib/HTTP/Engine/Role/Interface.pm	(revision 90339)
+++ lib/HTTP/Engine/Role/Interface.pm	(local)
@@ -1,5 +1,4 @@
 package HTTP::Engine::Role::Interface;
-use strict;
 use Moose::Role;
 use HTTP::Engine::Types::Core qw( Handler );
 use HTTP::Engine::ResponseFinalizer;
@@ -13,6 +12,89 @@
     required => 1,
 );
 
+has request_builder => (
+    is       => 'rw',
+    lazy     => 1,
+    builder  => 'build_request_builder',
+);
+
+has response_writer => (
+    is        => 'rw',
+    lazy      => 1,
+    builder   => 'build_response_writer',
+);
+
+has 'request_builder_spec' => (
+    is => 'rw',
+    isa => 'HashRef',
+    required => 1,
+);
+
+has 'response_writer_spec' => (
+    is => 'rw',
+    isa => 'HashRef',
+    required => 1,
+);
+
+no Moose::Role;
+
+sub build_request_builder {
+    my $self = shift;
+    my $spec = $self->request_builder_spec;
+    my $builder = $spec->{class};
+    $builder = ($builder =~ s/^\+(.+)$//) ? $1 : "HTTP::Engine::RequestBuilder::$builder";
+    Class::MOP::load_class($builder);
+    return $builder->new;
+}
+
+sub build_response_writer {
+    my $self = shift;
+    my $spec = $self->response_writer_spec;
+    my $caller = blessed $self;
+
+    my $writer = Moose::Meta::Class->create( $caller . '::ResponseWriter',
+        superclasses => ['Moose::Object'],
+        cache => 1,
+    );
+
+    {
+        my @roles;
+        my $apply = sub { push @roles, "HTTP::Engine::Role::ResponseWriter::$_[0]" };
+        if ($spec->{finalize}) {
+            $writer->add_method(finalize => $spec->{finalize});
+        } else {
+            if ($spec->{response_line}) {
+                $apply->('ResponseLine');
+            }
+            if (my $code = $spec->{output_body}) {
+                $writer->add_method('output_body' => $code);
+            } else {
+                $apply->('OutputBody');
+            }
+            if (my $code = $spec->{write}) {
+                $writer->add_method('write' => $code);
+            } else {
+                $apply->('WriteSTDOUT');
+            }
+            $apply->('Finalize');
+        }
+        Moose::Util::apply_all_roles($writer, @roles, "HTTP::Engine::Role::ResponseWriter");
+    }
+
+    for my $before (keys %{ $spec->{before} || {} }) {
+        $writer->add_before_method_modifier( $before => $spec->{before}->{$before} );
+    }
+    for my $attribute (keys %{ $spec->{attributes} || {} }) {
+        $writer->add_attribute( $attribute => $spec->{attributes}->{$attribute} );
+    }
+
+    $writer->make_immutable;
+
+    return $writer->new_object->new;
+}
+
+1;
+
 sub handle_request {
     my ($self, %args) = @_;
=== lib/HTTP/Engine/Interface/ServerSimple.pm
==================================================================
--- lib/HTTP/Engine/Interface/ServerSimple.pm	(revision 90339)
+++ lib/HTTP/Engine/Interface/ServerSimple.pm	(local)
@@ -1,14 +1,22 @@
 package HTTP::Engine::Interface::ServerSimple;
-use HTTP::Engine::Interface
-    builder => 'NoEnv',
-    writer  => {
-        response_line => 1,
-    }
-;
-
+use Moose;
 use HTTP::Server::Simple 0.34;
 use HTTP::Server::Simple::CGI;
 
+with 'HTTP::Engine::Role::Interface';
+
+has '+request_builder_spec' => (
+    default => sub { +{
+        class => 'NoEnv'
+    } }
+);
+
+has '+response_writer_spec'  => (
+    default => sub { +{
+        response_line => 1,
+    } }
+);
+
 has host => (
     is      => 'ro',
     isa     => 'Str',
@@ -26,6 +34,9 @@
     isa     => 'Str | Undef',
     default => undef,
 );
+
+__PACKAGE__->meta->make_immutable;
+
 no Moose;
 
 sub run {
@@ -85,8 +96,6 @@
     $server->run;
 }
 
-__INTERFACE__
-
 __END__
 
 =head1 NAME

2008-06-18

no context branch

19:35

old style.

use strict;
use warnings;
use HTTP::Engine;
my $engine = HTTP::Engine->new(
    interface => {
        module => 'ServerSimple',
        args   => {
            host => 'localhost',
            port =>  1978,
        },
        request_handler => sub {
            my $c = shift;
            $c->res->body('hello');
        },
    },
);
$engine->run;

old style with Declare.

use strict;
use warnings;
use HTTPEx::Declare;

interface {
    module => 'ServerSimple',
    args   => {
        host => 'localhost',
        port =>  1978,
    }
};

run {
    my $c = shift;
    $c->res->body('hello');
};

new style.

use strict;
use warnings;
use HTTP::Engine;
use HTTP::Engine::Response;
my $engine = HTTP::Engine->new(
    interface => {
        module => 'ServerSimple',
        args   => {
            host => 'localhost',
            port =>  1978,
        },
        request_handler => sub {
            my $req = shift;
            HTTP::Engine::Response->new( body => 'hello' );
        },
    },
);
$engine->run;

new style with Declare.

use strict;
use warnings;
use HTTPEx::Declare;
use HTTP::Engine::Response;

interface {
    module => 'ServerSimple',
    args   => {
        host => 'localhost',
        port =>  1978,
    }
};

run {
    my $req = shift;
    HTTP::Engine::Response->new( body => 'hello' );
};

we hope simple syntax

use strict;
use warnings;
use HTTPEx::Declare qw( res redirect );

interface {
    module => 'ServerSimple',
    args   => {
        host => 'localhost',
        port =>  1978,
    }
};

run {
    my $req = shift;
    res( body => 'hello' ); # or redirect( location => 'http://example.com/' );
};

onuywtmhqfonuywtmhqf2013/12/17 12:32haugxiuuq.fohjof, <a href="http://www.sscxbvbtmm.com/">juvezoacly</a> , [url=http://www.vgvsqralvh.com/]wzqpauxgcm[/url], http://www.xzhmcspalp.com/ juvezoacly

kbnogjrlnskbnogjrlns2014/04/11 10:40yztwaiuuq.fohjof, <a href="http://www.pccosourup.com/">xqttoxongd</a> , [url=http://www.scyvfqaujb.com/]bijbtdqqbq[/url], http://www.lutdmxzwws.com/ xqttoxongd

2008-06-10

t/32_interface_poe.t テスト通らない

03:36

kanさんへ

もちろんMakefile.PLの依存はちゃんとクリアしてるお

t/32_interface_poe....................NOK 1/1#   Failed test 'response'      
#   in t/32_interface_poe.t at line 34.
#          got: undef
#     expected: 'Content-Length: 3
# Content-Type: text/html
# Status: 200
# X-Req-Base: http://localhost/
# 
# OK!'
# Looks like you failed 1 test of 1.
Sessions were started, but POE::Kernel's run() method was never
called to execute them.  This usually happens because an error
occurred before POE::Kernel->run() could be called.  Please fix
any errors above this notice, and be sure that POE::Kernel->run()
is called.
t/32_interface_poe....................dubious                                
        Test returned status 1 (wstat 256, 0x100)
DIED. FAILED test 1
        Failed 1/1 tests, 0.00% okay

2008-05-17

lighttpd -V

20:19

$ /usr/local/lighttpd/sbin/lighttpd -V
lighttpd-1.4.19 - a light and fast webserver
Build-Date: May 12 2008 16:07:18

Event Handlers:

        + select (generic)
        + poll (Unix)
        + rt-signals (Linux 2.4+)
        + epoll (Linux 2.6)
        - /dev/poll (Solaris)
        - kqueue (FreeBSD)

Network handler:

        + sendfile

Features:

        + IPv6 support
        + zlib support
        + bzip2 support
        + crypt support
        - SSL Support
        + PCRE support
        - mySQL support
        - LDAP support
        - memcached support
        - FAM support
        - LUA support
        - xml support
        - SQLite support
        - GDBM support