libcoro-twiggy-perl-0.03/0000755000000000000000000000000012006206503014025 5ustar rootrootlibcoro-twiggy-perl-0.03/lib/0000775000000000000000000000000011777475666014635 5ustar rootrootlibcoro-twiggy-perl-0.03/lib/Coro/0000775000000000000000000000000012006206503015477 5ustar rootrootlibcoro-twiggy-perl-0.03/lib/Coro/Twiggy.pm0000664000000000000000000001120512006206503017306 0ustar rootrootpackage Coro::Twiggy; use 5.008008; use strict; use warnings; use Twiggy::Server; use Scalar::Util 'weaken'; use Coro; use Data::Dumper; our $VERSION = '0.03'; =head1 NAME Coro::Twiggy - Coro interface for L =head1 SYNOPSIS use Coro::Twiggy; use Plack::Request; use Coro::AnyEvent; my $application = sub { my ($env) = @_; my $req = Plack::Request->new($env); Coro::AnyEvent::sleep 10; ... return [ 200, [ 'Content-Type' => 'text/html' ], [ 'Twiggy response after 10 seconds' ] ] }; my $server = Coro::Twiggy->new(host => '127.0.0.1', port => 8080); $server->register_service( $application ); =head1 DESCRIPTION The server starts Your application in L coroutine and uses its return value to respond to client. Application have to return an B with the following items: =over =item * HTTP-code; =item * an B that contains headers for response; =item * an B that contains body of response. =back To stop server destroy server object =head1 METHODS =cut use constant DEFAULT_SERVICE => sub { [ 503, [ 'Content-Type' => 'text/plain' ], [ 'There is no registered PSGI service' ] ] }; =head2 new Constructor. Returns server. =head3 Named arguments =over =item host =item port =item service PSGI application =back =cut sub new { my ($class, %opts) = @_; my $host = $opts{host}; my $port = $opts{port} || 8080; my $listen = $opts{listen}; my $app = $opts{service} || DEFAULT_SERVICE; my @args; if ($listen) { push @args => listen => $listen; } elsif ($port !~ /^\d+$/) { push @args => listen => [ $port ]; } else { push @args => host => $host, port => $port; } my $ts = Twiggy::Server->new(@args); my $self = bless { ts => $ts, app => $app } => ref($class) || $class; my $this = $self; $ts->register_service( $this->_app ); return $self; } sub DESTROY { my ($self) = @_; delete $self->{ts}{listen_guards}; # hack: Twiggy has no interface to stop delete $self->{ts}; } =head2 register_service (Re)register PSGI application. Until the event server will respond B<503 Service Unavailable>. =cut sub register_service { my ($self, $cb) = @_; $self->{app} = $cb || DEFAULT_SERVICE; } sub _app { my ($self) = @_; weaken $self; sub { my ($env) = @_; sub { my ($cb) = @_; async { return DEFAULT_SERVICE->() unless $self; my @res = eval { $self->{app}->($env, $self) }; my $res = shift @res; if (my $err = $@) { utf8::encode($err) if utf8::is_utf8 $err; $cb->([ 500, [ 'Content-Type' => 'text/plain' ], [ $err ]]); return; } my $msg; unless('ARRAY' eq ref $res) { $msg = 'PSGI application have to return an ARRAYREF'; goto WRONG_RES; } goto WRONG_RES unless @$res >= 2; push @$res => [] unless @$res > 2; goto WRONG_RES unless defined($res->[0]) && $res->[0] =~ /^\d+$/; goto WRONG_RES unless 'ARRAY' eq ref $res->[1]; goto WRONG_RES unless 'ARRAY' eq ref $res->[2]; $cb->( $res ); return; WRONG_RES: $msg ||= "PSGI returned wrong response"; $msg .= "\n\n"; { local $Data::Dumper::Indent = 1; local $Data::Dumper::Terse = 1; local $Data::Dumper::Useqq = 1; local $Data::Dumper::Deepcopy = 1; local $Data::Dumper::Maxdepth = 0; my $dump = Data::Dumper->Dump([ $res, @res ]); utf8::downgrade($dump) if utf8::is_utf8 $dump; $msg .= $dump; } $cb->( [ 500, [ 'Content-Type', 'text/plain' ], [ $msg ]]); return; } } } } 1; =head1 VCS L =head1 AUTHOR Dmitry E. Oboukhov, =head1 COPYRIGHT AND LICENSE Copyright (C) 2012 by Dmitry E. Oboukhov This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut libcoro-twiggy-perl-0.03/MANIFEST0000664000000000000000000000030011777477343015203 0ustar rootrootChanges debian/changelog debian/compat debian/control debian/copyright debian/rules debian/source/format debian/watch lib/Coro/Twiggy.pm Makefile.PL MANIFEST README t/01-use.t t/02-requests.t libcoro-twiggy-perl-0.03/t/0000775000000000000000000000000012006206503014272 5ustar rootrootlibcoro-twiggy-perl-0.03/t/01-use.t0000644000000000000000000000073711777475666015536 0ustar rootroot#!/usr/bin/perl use warnings; use strict; use utf8; use open qw(:std :utf8); use lib qw(lib ../lib); use Test::More tests => 1; use Encode qw(decode encode); BEGIN { # Подготовка объекта тестирования для работы с utf8 my $builder = Test::More->builder; binmode $builder->output, ":utf8"; binmode $builder->failure_output, ":utf8"; binmode $builder->todo_output, ":utf8"; use_ok 'Coro::Twiggy'; } libcoro-twiggy-perl-0.03/t/02-requests.t0000664000000000000000000000766212006206503016564 0ustar rootroot#!/usr/bin/perl use warnings; use strict; use utf8; use open qw(:std :utf8); use lib qw(lib ../lib); use Test::More tests => 45; use Encode qw(decode encode); my $temp_dir; BEGIN { # Подготовка объекта тестирования для работы с utf8 my $builder = Test::More->builder; binmode $builder->output, ":utf8"; binmode $builder->failure_output, ":utf8"; binmode $builder->todo_output, ":utf8"; use_ok 'Coro::Twiggy'; use_ok 'File::Temp', 'tempdir'; use_ok 'File::Path', 'rmtree'; use_ok 'File::Spec::Functions', 'catfile'; use_ok 'Coro'; use_ok 'Coro::AnyEvent'; use_ok 'Coro::Handle'; use_ok 'AnyEvent::Socket'; use_ok 'AnyEvent'; } $temp_dir = tempdir; ok -d $temp_dir, "-d $temp_dir"; my $socket = catfile $temp_dir, 'socket'; { my $server = Coro::Twiggy->new(host => 'unix/', port => $socket); isa_ok $server => 'Coro::Twiggy'; for( 1 .. 10 ) { Coro::AnyEvent::sleep 0.1; last if -S $socket; } ok -S $socket, "-S $socket - socket was opened"; tcp_connect 'unix/', $socket, Coro::rouse_cb; my $cs = unblock +(Coro::rouse_wait)[0]; ok $cs, 'connected to server'; print $cs "GET / HTTP/1.0\015\012\015\12"; my $resp; { local $/; $resp = <$cs> } ok $resp, "response"; like $resp, qr{^HTTP/1\.[01]\s+503}, 'code'; like $resp, qr{no registered PSGI service}, 'message'; my $env; $server->register_service(sub { ($env) = @_; }); tcp_connect 'unix/', $socket, Coro::rouse_cb; $cs = unblock +(Coro::rouse_wait)[0]; ok $cs, 'connected to server'; print $cs "GET / HTTP/1.0\015\012\015\12"; { local $/; $resp = <$cs> } ok $resp, "response"; like $resp, qr{^HTTP/1\.[01]\s+500}, 'code'; like $resp, qr{application have to return an ARRAYREF}, 'message'; ok $env, 'PSGI application was called'; $env = undef; $server->register_service(sub { ($env) = @_; ['abc'] }); tcp_connect 'unix/', $socket, Coro::rouse_cb; $cs = unblock +(Coro::rouse_wait)[0]; ok $cs, 'connected to server'; print $cs "GET / HTTP/1.0\015\012\015\12"; { local $/; $resp = <$cs> } ok $resp, "response"; like $resp, qr{^HTTP/1\.[01]\s+500}, 'code'; like $resp, qr{wrong response}, 'message'; ok $env, 'PSGI application was called'; $env = undef; $server->register_service(sub { ($env) = @_; [200, ['Content-Type', 'text/plain'], ['test passed']] }); tcp_connect 'unix/', $socket, Coro::rouse_cb; $cs = unblock +(Coro::rouse_wait)[0]; ok $cs, 'connected to server'; print $cs "GET / HTTP/1.0\015\012\015\12"; { local $/; $resp = <$cs> } ok $resp, "response"; like $resp, qr{^HTTP/1\.[01]\s+200}, 'code'; like $resp, qr{test passed}, 'message'; ok $env, 'PSGI application was called'; my $started = AnyEvent::now(); $env = undef; $server->register_service(sub { ($env) = @_; Coro::AnyEvent::sleep .5; [200, ['Content-Type', 'text/plain'], ['test passed']] }); tcp_connect 'unix/', $socket, Coro::rouse_cb; $cs = unblock +(Coro::rouse_wait)[0]; ok $cs, 'connected to server'; print $cs "GET / HTTP/1.0\015\012\015\12"; { local $/; $resp = <$cs> } ok $resp, "response"; like $resp, qr{^HTTP/1\.[01]\s+200}, 'code'; like $resp, qr{test passed}, 'message'; ok $env, 'PSGI application was called'; my $delay = AnyEvent::now() - $started; cmp_ok $delay, '>=', 0.5, 'async process took more that 0.5 seconds'; $server->register_service(sub { die "привет" }); tcp_connect 'unix/', $socket, Coro::rouse_cb; $cs = unblock +(Coro::rouse_wait)[0]; ok $cs, 'connected to server'; print $cs "GET / HTTP/1.0\015\012\015\12"; { local $/; $resp = <$cs> } ok $resp, "response"; ok eval { utf8::decode $resp }, 'response was decoded'; like $resp, qr{^HTTP/1\.[01]\s+500}, 'code'; like $resp, qr{привет at}, 'message'; ok $env, 'PSGI application was called'; } Coro::AnyEvent::sleep 0.5; my ($resp, $env); tcp_connect 'unix/', $socket, Coro::rouse_cb; my $cs = Coro::rouse_wait; ok !$cs, 'Socket was closed'; END { if ($temp_dir) { rmtree $temp_dir; ok !-d $temp_dir, "!-d $temp_dir"; } } libcoro-twiggy-perl-0.03/Changes0000664000000000000000000000047112006206503015324 0ustar rootrootRevision history for Perl extension Coro::Twiggy. 0.01 Wed Jul 11 21:34:09 2012 - original version; created by h2xs 1.23 with options -X -n Coro::Twiggy 0.02 Thu Jul 12 11:41:29 MSK 2012 - add debian infrastructure 0.03 Fri Jul 13 22:14:06 MSK 2012 - user could throw exceptions in decoded utf8 libcoro-twiggy-perl-0.03/README0000644000000000000000000000112611777475666014745 0ustar rootrootCoro-Twiggy version 0.01 ======================== INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES This module requires these other modules and libraries: Coro Twiggy::Server COPYRIGHT AND LICENCE Put the correct copyright and licence information here. Copyright (C) 2012 by Dmitry E. Oboukhov This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. libcoro-twiggy-perl-0.03/Makefile.PL0000644000000000000000000000155711777475666016047 0ustar rootrootuse 5.008008; use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( NAME => 'Coro::Twiggy', VERSION_FROM => 'lib/Coro/Twiggy.pm', # finds $VERSION PREREQ_PM => { Coro => '6.07', AnyEvent => 0, Twiggy => '0.1020' }, # e.g., Module::Name => 1.1 ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT_FROM => 'lib/Coro/Twiggy.pm', # retrieve abstract from module AUTHOR => 'Dmitry E. Oboukhov ') : ()), META_MERGE => { resources => { homepage => 'https://github.com/unera/coro-twiggy', bugtracker => 'https://github.com/unera/coro-twiggy/issues', } }, LICENSE => 'perl' );