@@ -1,5 +1,32 @@
This file documents the revision history for Perl extension Mojolicious.
+1.67 2011-07-27 00:00:00
+ - Documentation improvements.
+ - Fixed version command.
+ - Fixed small Mojo::DOM bug. (akron)
+
+1.66 2011-07-27 00:00:00
+ - Added EXPERIMENTAL detect method to Mojo::IOWatcher.
+ - Improved Mojo::IOLoop::Resolver efficiency.
+ - Improved documentation.
+ - Fixed typos. (crab)
+
+1.65 2011-07-25 00:00:00
+ - Added EXPERIMENTAL modules Mojo::IOLoop::Client,
+ Mojo::IOLoop::EventEmitter, Mojo::IOLoop::Server and
+ Mojo::IOLoop::Stream, which contain extracted functionality from
+ Mojo::IOLoop.
+ - Added EXPERIMENTAL module Mojo::IOWatcher::EV. (xantus)
+ - Removed modules Mojo::IOWatcher::Epoll and Mojo::IOWatcher::KQueue,
+ since Mojo::IOWatcher::EV is a much better alternative.
+ - Renamed Mojo::Resolver to Mojo::IOLoop::Resolver.
+ - Improved Mojolicious::Routes to automatically disable the routing
+ cache if conditions are used.
+ - Improved route constraint alternatives.
+ - Improved documentation browser CSS. (judofyr)
+ - Improved documentation.
+ - Fixed small bug in get command.
+
1.64 2011-07-10 00:00:00
- Added EXPERIMENTAL module Mojo::DOM::HTML.
- Improved documentation.
@@ -14,7 +41,7 @@ This file documents the revision history for Perl extension Mojolicious.
- Improved documentation.
1.61 2011-07-09 00:00:00
- - Added Mojo::HTML module, which contains extracted functionality
+ - Added module Mojo::HTML, which contains extracted functionality
from Mojo::DOM.
- Improved documentation.
@@ -74,9 +101,9 @@ This file documents the revision history for Perl extension Mojolicious.
disabling format detection.
1.49 2011-06-30 00:00:00
- - Added EXPERIMENTAL Mojo::IOWatcher and Mojo::Resolver modules,
+ - Added EXPERIMENTAL modules Mojo::IOWatcher and Mojo::Resolver,
which contain extracted functionality from Mojo::IOLoop.
- - Added EXPERIMENTAL Mojo::Transactor module, which contains
+ - Added EXPERIMENTAL module Mojo::Transactor, which contains
extracted functionality from Mojo::UserAgent.
- Added EXPERIMENTAL support for simple alternative placeholder
values to routes.
@@ -339,7 +366,7 @@ This file documents the revision history for Perl extension Mojolicious.
- Fixed a serious Mojo::DOM bug. (moritz)
1.14 2011-03-17 00:00:00
- - Added support for multiple dns servers to Mojo::IOLoop.
+ - Added support for multiple DNS servers to Mojo::IOLoop.
- Added config helper to Mojolicious::Plugin::Config.
- Changed resolv.conf parser in Mojo::IOLoop to use the first
nameserver.
@@ -948,7 +975,6 @@ This file documents the revision history for Perl extension Mojolicious.
- Added transparent kqueue and epoll support to daemons and client.
- Added support for listening to multiple locations to the daemons.
mojo daemon --listen http://127.0.0.1:3000
- mojo daemon --listen http://127.0.0.1:3000,file:///tmp/my.sock
mojo daemon --listen http://*:3000,http://*:3001,http://*:3002
mojo daemon --listen http://[::1]:3000
mojo daemon --listen https://*:443:/x/server.crt:/x/server.key
@@ -28,9 +28,13 @@ lib/Mojo/Headers.pm
lib/Mojo/HelloWorld.pm
lib/Mojo/Home.pm
lib/Mojo/IOLoop.pm
+lib/Mojo/IOLoop/Client.pm
+lib/Mojo/IOLoop/EventEmitter.pm
+lib/Mojo/IOLoop/Resolver.pm
+lib/Mojo/IOLoop/Server.pm
+lib/Mojo/IOLoop/Stream.pm
lib/Mojo/IOWatcher.pm
-lib/Mojo/IOWatcher/Epoll.pm
-lib/Mojo/IOWatcher/KQueue.pm
+lib/Mojo/IOWatcher/EV.pm
lib/Mojo/JSON.pm
lib/Mojo/Loader.pm
lib/Mojo/Log.pm
@@ -39,7 +43,6 @@ lib/Mojo/Message/Request.pm
lib/Mojo/Message/Response.pm
lib/Mojo/Parameters.pm
lib/Mojo/Path.pm
-lib/Mojo/Resolver.pm
lib/Mojo/Server.pm
lib/Mojo/Server/CGI.pm
lib/Mojo/Server/Daemon.pm
@@ -152,6 +155,7 @@ LICENSE
Makefile.PL
MANIFEST This list of files
MANIFEST.SKIP
+MYMETA.json
MYMETA.yml
README.pod
script/hypnotoad
@@ -179,6 +183,7 @@ t/mojo/cookie.t
t/mojo/cookiejar.t
t/mojo/date.t
t/mojo/dom.t
+t/mojo/eventemitter.t
t/mojo/fastcgi.t
t/mojo/headers.t
t/mojo/home.t
@@ -186,8 +191,7 @@ t/mojo/hypnotoad.t
t/mojo/ioloop.t
t/mojo/ioloop_tls.t
t/mojo/iowatcher.t
-t/mojo/iowatcher_epoll.t
-t/mojo/iowatcher_kqueue.t
+t/mojo/iowatcher_ev.t
t/mojo/json.t
t/mojo/lib/BaseTest/Base1.pm
t/mojo/lib/BaseTest/Base2.pm
@@ -285,4 +289,5 @@ t/mojolicious/websocket_proxy_lite_app.t
t/mojolicious/websocket_tls_proxy_lite_app.t
t/pod.t
t/pod_coverage.t
-META.yml Module meta-data (added by MakeMaker)
+META.yml Module YAML meta-data (added by MakeMaker)
+META.json Module JSON meta-data (added by MakeMaker)
@@ -0,0 +1,86 @@
+{
+ "abstract" : "The Web In A Box!",
+ "author" : [
+ "Sebastian Riedel <sri@cpan.org>"
+ ],
+ "dynamic_config" : 1,
+ "generated_by" : "ExtUtils::MakeMaker version 6.58, CPAN::Meta::Converter version 2.110930",
+ "license" : [
+ "artistic_2"
+ ],
+ "meta-spec" : {
+ "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+ "version" : "2"
+ },
+ "name" : "Mojolicious",
+ "no_index" : {
+ "directory" : [
+ "t",
+ "inc",
+ "t"
+ ]
+ },
+ "prereqs" : {
+ "build" : {
+ "requires" : {}
+ },
+ "configure" : {
+ "requires" : {}
+ },
+ "runtime" : {
+ "requires" : {
+ "B" : 0,
+ "Carp" : 0,
+ "Cwd" : 0,
+ "Data::Dumper" : 0,
+ "Digest::MD5" : 0,
+ "Encode" : 0,
+ "Errno" : 0,
+ "Exporter" : 0,
+ "ExtUtils::MakeMaker" : 0,
+ "Fcntl" : 0,
+ "File::Basename" : 0,
+ "File::Copy" : 0,
+ "File::Find" : 0,
+ "File::Path" : 0,
+ "File::Spec" : 0,
+ "File::Temp" : 0,
+ "FindBin" : 0,
+ "Getopt::Long" : 0,
+ "I18N::LangTags" : 0,
+ "I18N::LangTags::Detect" : 0,
+ "IO::File" : 0,
+ "IO::Poll" : 0,
+ "IO::Socket" : 0,
+ "IO::Socket::INET" : 0,
+ "List::Util" : 0,
+ "Locale::Maketext" : 0,
+ "MIME::Base64" : 0,
+ "MIME::QuotedPrint" : 0,
+ "POSIX" : 0,
+ "Scalar::Util" : 0,
+ "Socket" : 0,
+ "Sys::Hostname" : 0,
+ "Test::Harness" : 0,
+ "Test::More" : 0,
+ "Time::HiRes" : 0,
+ "perl" : "5.008007"
+ }
+ }
+ },
+ "release_status" : "stable",
+ "resources" : {
+ "bugtracker" : {
+ "web" : "http://github.com/kraih/mojo/issues"
+ },
+ "homepage" : "http://mojolicio.us",
+ "license" : [
+ "http://dev.perl.org/licenses/"
+ ],
+ "repository" : {
+ "url" : "http://github.com/kraih/mojo"
+ },
+ "x_MailingList" : "http://groups.google.com/group/mojolicious"
+ },
+ "version" : "1.67"
+}
@@ -1,63 +1,62 @@
---- #YAML:1.0
-name: Mojolicious
-version: 1.64
-abstract: The Web In A Box!
+---
+abstract: 'The Web In A Box!'
author:
- - Sebastian Riedel <sri@cpan.org>
-license: artistic_2
-distribution_type: module
-configure_requires: {}
-build_requires: {}
+ - 'Sebastian Riedel <sri@cpan.org>'
+build_requires: {}
+configure_requires: {}
+dynamic_config: 1
+generated_by: 'ExtUtils::MakeMaker version 6.58, CPAN::Meta::Converter version 2.110930'
+license: artistic_2
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
+name: Mojolicious
+no_index:
+ directory:
+ - t
+ - inc
+ - t
requires:
- B: 0
- Carp: 0
- Cwd: 0
- Data::Dumper: 0
- Digest::MD5: 0
- Encode: 0
- Errno: 0
- Exporter: 0
- ExtUtils::MakeMaker: 0
- Fcntl: 0
- File::Basename: 0
- File::Copy: 0
- File::Find: 0
- File::Path: 0
- File::Spec: 0
- File::Temp: 0
- FindBin: 0
- Getopt::Long: 0
- I18N::LangTags: 0
- I18N::LangTags::Detect: 0
- IO::File: 0
- IO::Poll: 0
- IO::Socket: 0
- IO::Socket::INET: 0
- IO::Socket::UNIX: 0
- List::Util: 0
- Locale::Maketext: 0
- MIME::Base64: 0
- MIME::QuotedPrint: 0
- perl: 5.008007
- POSIX: 0
- Scalar::Util: 0
- Socket: 0
- Sys::Hostname: 0
- Test::Harness: 0
- Test::More: 0
- Time::HiRes: 0
+ B: 0
+ Carp: 0
+ Cwd: 0
+ Data::Dumper: 0
+ Digest::MD5: 0
+ Encode: 0
+ Errno: 0
+ Exporter: 0
+ ExtUtils::MakeMaker: 0
+ Fcntl: 0
+ File::Basename: 0
+ File::Copy: 0
+ File::Find: 0
+ File::Path: 0
+ File::Spec: 0
+ File::Temp: 0
+ FindBin: 0
+ Getopt::Long: 0
+ I18N::LangTags: 0
+ I18N::LangTags::Detect: 0
+ IO::File: 0
+ IO::Poll: 0
+ IO::Socket: 0
+ IO::Socket::INET: 0
+ List::Util: 0
+ Locale::Maketext: 0
+ MIME::Base64: 0
+ MIME::QuotedPrint: 0
+ POSIX: 0
+ Scalar::Util: 0
+ Socket: 0
+ Sys::Hostname: 0
+ Test::Harness: 0
+ Test::More: 0
+ Time::HiRes: 0
+ perl: 5.008007
resources:
- bugtracker: http://github.com/kraih/mojo/issues
- homepage: http://mojolicio.us
- license: http://dev.perl.org/licenses/
- MailingList: http://groups.google.com/group/mojolicious
- repository: http://github.com/kraih/mojo
-no_index:
- directory:
- - t
- - inc
- - t
-generated_by: ExtUtils::MakeMaker version 6.57_05
-meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: 1.4
+ bugtracker: http://github.com/kraih/mojo/issues
+ homepage: http://mojolicio.us
+ license: http://dev.perl.org/licenses/
+ repository: http://github.com/kraih/mojo
+ x_MailingList: http://groups.google.com/group/mojolicious
+version: 1.67
@@ -0,0 +1,87 @@
+{
+ "abstract" : "The Web In A Box!",
+ "author" : [
+ "Sebastian Riedel <sri@cpan.org>"
+ ],
+ "dynamic_config" : 0,
+ "generated_by" : "ExtUtils::MakeMaker version 6.58, CPAN::Meta::Converter version 2.110930",
+ "license" : [
+ "artistic_2"
+ ],
+ "meta-spec" : {
+ "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+ "version" : "2"
+ },
+ "name" : "Mojolicious",
+ "no_index" : {
+ "directory" : [
+ "t",
+ "inc",
+ "t"
+ ]
+ },
+ "prereqs" : {
+ "build" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : 0
+ }
+ },
+ "configure" : {
+ "requires" : {}
+ },
+ "runtime" : {
+ "requires" : {
+ "B" : 0,
+ "Carp" : 0,
+ "Cwd" : 0,
+ "Data::Dumper" : 0,
+ "Digest::MD5" : 0,
+ "Encode" : 0,
+ "Errno" : 0,
+ "Exporter" : 0,
+ "ExtUtils::MakeMaker" : 0,
+ "Fcntl" : 0,
+ "File::Basename" : 0,
+ "File::Copy" : 0,
+ "File::Find" : 0,
+ "File::Path" : 0,
+ "File::Spec" : 0,
+ "File::Temp" : 0,
+ "FindBin" : 0,
+ "Getopt::Long" : 0,
+ "I18N::LangTags" : 0,
+ "I18N::LangTags::Detect" : 0,
+ "IO::File" : 0,
+ "IO::Poll" : 0,
+ "IO::Socket" : 0,
+ "IO::Socket::INET" : 0,
+ "List::Util" : 0,
+ "Locale::Maketext" : 0,
+ "MIME::Base64" : 0,
+ "MIME::QuotedPrint" : 0,
+ "POSIX" : 0,
+ "Scalar::Util" : 0,
+ "Socket" : 0,
+ "Sys::Hostname" : 0,
+ "Test::Harness" : 0,
+ "Test::More" : 0,
+ "Time::HiRes" : 0
+ }
+ }
+ },
+ "release_status" : "stable",
+ "resources" : {
+ "bugtracker" : {
+ "web" : "http://github.com/kraih/mojo/issues"
+ },
+ "homepage" : "http://mojolicio.us",
+ "license" : [
+ "http://dev.perl.org/licenses/"
+ ],
+ "repository" : {
+ "url" : "http://github.com/kraih/mojo"
+ },
+ "x_MailingList" : "http://groups.google.com/group/mojolicious"
+ },
+ "version" : "1.67"
+}
@@ -2,11 +2,11 @@
abstract: 'The Web In A Box!'
author:
- 'Sebastian Riedel <sri@cpan.org>'
-build_requires: {}
+build_requires:
+ ExtUtils::MakeMaker: 0
configure_requires: {}
-distribution_type: module
dynamic_config: 0
-generated_by: 'ExtUtils::MakeMaker version 6.57_05'
+generated_by: 'ExtUtils::MakeMaker version 6.58, CPAN::Meta::Converter version 2.110930'
license: artistic_2
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -42,7 +42,6 @@ requires:
IO::Poll: 0
IO::Socket: 0
IO::Socket::INET: 0
- IO::Socket::UNIX: 0
List::Util: 0
Locale::Maketext: 0
MIME::Base64: 0
@@ -54,11 +53,10 @@ requires:
Test::Harness: 0
Test::More: 0
Time::HiRes: 0
- perl: 5.008007
resources:
- MailingList: http://groups.google.com/group/mojolicious
bugtracker: http://github.com/kraih/mojo/issues
homepage: http://mojolicio.us
license: http://dev.perl.org/licenses/
repository: http://github.com/kraih/mojo
-version: 1.64
+ x_MailingList: http://groups.google.com/group/mojolicious
+version: 1.67
@@ -68,7 +68,6 @@ WriteMakefile(
'IO::Poll' => 0,
'IO::Socket' => 0,
'IO::Socket::INET' => 0,
- 'IO::Socket::UNIX' => 0,
'List::Util' => 0,
'Locale::Maketext' => 0,
'MIME::Base64' => 0,
@@ -38,8 +38,8 @@ TLS, Bonjour, IDNA, Comet (long polling), chunking and multipart support.
=item *
-Built-in async IO web server supporting epoll, kqueue, UNIX domain sockets
-and hot deployment, perfect for embedding.
+Built-in async I/O web server supporting libev and hot deployment, perfect
+for embedding.
=item *
@@ -122,9 +122,10 @@ Web development for humans, making hard things possible and everything fun.
__DATA__
@@ clock.html.ep
- % my ($second, $minute, $hour) = (localtime(time))[0, 1, 2];
+ % use Time::Piece;
+ % my $now = localtime;
<%= link_to clock => begin %>
- The time is <%= $hour %>:<%= $minute %>:<%= $second %>.
+ The time is <%= $now->hms %>.
<% end %>
=head2 Growing
@@ -200,7 +201,7 @@ especially when working in a team.
# All common HTTP verbs are supported
$example->post('/title')->to('#title');
- # ... and much, much more
+ # ...and much, much more
# (including multiple, auto-discovered controllers)
$r->websocket('/echo')->to('realtime#echo');
}
@@ -210,9 +211,10 @@ especially when working in a team.
Through all of these changes, your action code and templates can stay almost
exactly the same.
- % my ($second, $minute, $hour) = (localtime(time))[0, 1, 2];
+ % use Time::Piece;
+ % my $now = localtime;
<%= link_to clock => begin %>
- The time is <%= $hour %>:<%= $minute %>:<%= $second %>.
+ The time is <%= $now->hms %>.
<% end %>
Mojolicious has been designed from the ground up for a fun and unique
@@ -52,7 +52,7 @@ Mojo::IOLoop->listen(
print <<'EOF';
Starting server on port 3000.
Try something like "ab -c 30 -n 100000 -k http://127.0.0.1:3000/" for testing.
-On a MacBook Pro 13" this results in about 25k req/s.
+On a MacBook Pro 13" this results in about 20k req/s.
EOF
# Start loop
@@ -240,19 +240,17 @@ sub run {
for my $namespace (@{$self->namespaces}) {
# Search
- if (my $modules = Mojo::Loader->search($namespace)) {
- for my $module (@$modules) {
-
- # Load
- if (my $e = Mojo::Loader->load($module)) { die $e }
-
- # Seen
- my $command = $module;
- $command =~ s/^$namespace\:://;
- push @$commands, [$command => $module]
- unless $seen->{$command};
- $seen->{$command} = 1;
- }
+ for my $module (@{Mojo::Loader->search($namespace)}) {
+
+ # Load
+ if (my $e = Mojo::Loader->load($module)) { die $e }
+
+ # Seen
+ my $command = $module;
+ $command =~ s/^$namespace\:://;
+ push @$commands, [$command => $module]
+ unless $seen->{$command};
+ $seen->{$command} = 1;
}
}
@@ -2,7 +2,6 @@ package Mojo::DOM::Collection;
use Mojo::Base -base;
use overload 'bool' => sub {1}, '""' => sub { shift->to_xml }, fallback => 1;
-# "Hi, Super Nintendo Chalmers!"
sub new {
my $class = shift;
bless shift, ref $class || $class;
@@ -88,6 +88,9 @@ $HTML_BLOCK{$_}++ for @BLOCK_TAGS;
has [qw/charset xml/];
has tree => sub { ['root'] };
+# "No one believes me.
+# I believe you, dad.
+# Then can you stop the cats from swearing?"
sub parse {
my ($self, $html) = @_;
@@ -99,7 +99,7 @@ sub append { shift->_add(1, @_) }
sub append_content {
my ($self, $new) = @_;
my $tree = $self->tree;
- push @$tree, @{_parent($self->_parse("$new"), $tree->[3])};
+ push @$tree, @{_parent($self->_parse("$new"), $tree)};
return $self;
}
@@ -175,6 +175,7 @@ sub content_xml {
return $result;
}
+# "But I was going to loot you a present."
sub find {
my ($self, $selector) = @_;
@@ -254,7 +255,7 @@ sub prepend_content {
my ($self, $new) = @_;
my $tree = $self->tree;
splice @$tree, $tree->[0] eq 'root' ? 1 : 4, 0,
- @{_parent($self->_parse("$new"), $tree->[3])};
+ @{_parent($self->_parse("$new"), $tree)};
return $self;
}
@@ -378,6 +379,7 @@ sub type {
return $self;
}
+# "I want to set the record straight, I thought the cop was a prostitute."
sub xml {
my $self = shift;
return $self->[0]->xml if @_ == 0;
@@ -102,6 +102,7 @@ sub add {
return $self;
}
+sub cache_control { scalar shift->header('Cache-Control' => @_) }
sub connection { scalar shift->header(Connection => @_) }
sub content_disposition { scalar shift->header('Content-Disposition' => @_) }
sub content_length { scalar shift->header('Content-Length' => @_) }
@@ -116,6 +117,7 @@ sub cookie { scalar shift->header(Cookie => @_) }
sub date { scalar shift->header(Date => @_) }
sub dnt { scalar shift->header(DNT => @_) }
sub expect { scalar shift->header(Expect => @_) }
+sub expires { scalar shift->header(Expires => @_) }
sub from_hash {
my $self = shift;
@@ -379,6 +381,13 @@ Add one or more header lines.
Shortcut for the C<Authorization> header.
+=head2 C<cache_control>
+
+ my $cache_control = $headers->cache_control;
+ $headers = $headers->cache_control('max-age=1, no-cache');
+
+Shortcut for the C<Cache-Control> header.
+
=head2 C<connection>
my $connection = $headers->connection;
@@ -450,6 +459,13 @@ Note that this method is EXPERIMENTAL and might change without warning!
Shortcut for the C<Expect> header.
+=head2 C<expires>
+
+ my $expires = $headers->expires;
+ $headers = $headers->expires('Thu, 01 Dec 1994 16:00:00 GMT');
+
+Shortcut for the C<Expires> header.
+
=head2 C<from_hash>
$headers = $headers->from_hash({'Content-Type' => 'text/html'});
@@ -0,0 +1,256 @@
+package Mojo::IOLoop::Client;
+use Mojo::Base 'Mojo::IOLoop::EventEmitter';
+
+use IO::Socket::INET;
+use Scalar::Util 'weaken';
+use Socket qw/IPPROTO_TCP SO_ERROR TCP_NODELAY/;
+
+# IPv6 support requires IO::Socket::IP
+use constant IPV6 => $ENV{MOJO_NO_IPV6}
+ ? 0
+ : eval 'use IO::Socket::IP 0.06 (); 1';
+
+# TLS support requires IO::Socket::SSL
+use constant TLS => $ENV{MOJO_NO_TLS}
+ ? 0
+ : eval 'use IO::Socket::SSL 1.43 "inet4"; 1';
+use constant TLS_READ => TLS ? IO::Socket::SSL::SSL_WANT_READ() : 0;
+use constant TLS_WRITE => TLS ? IO::Socket::SSL::SSL_WANT_WRITE() : 0;
+
+has resolver => sub {
+ require Mojo::IOLoop::Resolver;
+ Mojo::IOLoop::Resolver->new;
+};
+
+sub DESTROY {
+ my $self = shift;
+ return if $self->{connected};
+ return unless my $resolver = $self->resolver;
+ return unless my $loop = $resolver->ioloop;
+ return unless my $watcher = $loop->iowatcher;
+ $watcher->cancel($self->{timer}) if $self->{timer};
+ $watcher->remove($self->{handle}) if $self->{handle};
+}
+
+sub connect {
+ my $self = shift;
+ my $args = ref $_[0] ? $_[0] : {@_};
+
+ # Lookup
+ if (!$args->{handle} && (my $address = $args->{address})) {
+ $self->resolver->lookup(
+ $address => sub {
+ $args->{address} = $_[1] || $args->{address};
+ $self->_connect($args);
+ }
+ );
+ }
+
+ # Connect
+ else { $self->_connect($args) }
+}
+
+sub _connect {
+ my ($self, $args) = @_;
+
+ # New socket
+ my $handle;
+ my $watcher = $self->resolver->ioloop->iowatcher;
+ my $timeout = $args->{timeout} || 3;
+ unless ($handle = $args->{handle}) {
+ my %options = (
+ Blocking => 0,
+ PeerAddr => $args->{address},
+ PeerPort => $args->{port} || ($args->{tls} ? 443 : 80),
+ Proto => 'tcp',
+ %{$args->{args} || {}}
+ );
+ $options{PeerAddr} =~ s/[\[\]]//g if $options{PeerAddr};
+ my $class = IPV6 ? 'IO::Socket::IP' : 'IO::Socket::INET';
+ return $self->emit(error => "Couldn't connect.")
+ unless $handle = $class->new(%options);
+
+ # Timer
+ $self->{timer} =
+ $watcher->timer($timeout,
+ sub { $self->emit(error => 'Connect timeout.') });
+
+ # IPv6 needs an early start
+ $handle->connect if IPV6;
+ }
+
+ # Non-blocking
+ $handle->blocking(0);
+
+ # Disable Nagle's algorithm
+ setsockopt $handle, IPPROTO_TCP, TCP_NODELAY, 1;
+
+ # TLS
+ if ($args->{tls}) {
+
+ # No TLS support
+ return $self->emit(
+ error => 'IO::Socket::SSL 1.43 required for TLS support.')
+ unless TLS;
+
+ # Upgrade
+ weaken $self;
+ my %options = (
+ SSL_startHandshake => 0,
+ SSL_error_trap => sub {
+ my $handle = delete $self->{handle};
+ my $watcher = $self->resolver->ioloop->iowatcher;
+ $watcher->remove($handle);
+ $watcher->cancel($self->{timer});
+ close $handle;
+ $self->emit(error => $_[1]);
+ },
+ SSL_cert_file => $args->{tls_cert},
+ SSL_key_file => $args->{tls_key},
+ SSL_verify_mode => 0x00,
+ SSL_create_ctx_callback =>
+ sub { Net::SSLeay::CTX_sess_set_cache_size(shift, 128) },
+ Timeout => $timeout,
+ %{$args->{tls_args} || {}}
+ );
+ $self->{tls} = 1;
+ return $self->emit(error => 'TLS upgrade failed.')
+ unless $handle = IO::Socket::SSL->start_SSL($handle, %options);
+ }
+
+ # Start writing right away
+ $self->{handle} = $handle;
+ $watcher->add(
+ $handle,
+ on_readable => sub { $self->_connecting },
+ on_writable => sub { $self->_connecting }
+ );
+}
+
+sub _connecting {
+ my $self = shift;
+
+ # Switch between reading and writing
+ my $handle = $self->{handle};
+ my $watcher = $self->resolver->ioloop->iowatcher;
+ if ($self->{tls} && !$handle->connect_SSL) {
+ my $error = $IO::Socket::SSL::SSL_ERROR;
+ if ($error == TLS_READ) { $watcher->not_writing($handle) }
+ elsif ($error == TLS_WRITE) { $watcher->writing($handle) }
+ return;
+ }
+
+ # Check for errors
+ return $self->emit(error => $! = $handle->sockopt(SO_ERROR))
+ unless $handle->connected;
+
+ # Connected
+ $self->{connected} = 1;
+ $watcher->cancel($self->{timer}) if $self->{timer};
+ $watcher->remove($handle);
+ $self->emit(connect => $handle);
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Mojo::IOLoop::Client - IOLoop Socket Client
+
+=head1 SYNOPSIS
+
+ use Mojo::IOLoop::Client;
+
+ # Create socket connection
+ my $client = Mojo::IOLoop::Client->new;
+ $client->on(connect => sub {
+ my ($self, $handle) = @_;
+ ...
+ });
+ $client->on(error => sub {
+ my ($self, $error) = @_;
+ ...
+ });
+ $client->connect(address => 'mojolicio.us', port => 80);
+
+=head1 DESCRIPTION
+
+L<Mojo::IOLoop::Client> performs non-blocking socket connections for
+L<Mojo::IOLoop>.
+Note that this module is EXPERIMENTAL and might change without warning!
+
+=head1 ATTRIBUTES
+
+L<Mojo::IOLoop::Client> implements the following attributes.
+
+=head2 C<resolver>
+
+ my $resolver = $client->resolver;
+ $client = $client->resolver(Mojo::IOLoop::Resolver->new);
+
+DNS stub resolver, usually a L<Mojo::IOLoop::Resolver> object.
+
+=head1 METHODS
+
+L<Mojo::IOLoop::Client> inherits all methods from
+L<Mojo::IOLoop::EventEmitter> and implements the following new ones.
+
+=head2 C<connect>
+
+ $client->connect(
+ address => '127.0.0.1',
+ port => 3000
+ );
+
+Open a socket connection to a remote host.
+Note that TLS support depends on L<IO::Socket::SSL> and IPv6 support on
+L<IO::Socket::IP>.
+
+These options are currently available:
+
+=over 2
+
+=item C<address>
+
+Address or host name of the peer to connect to.
+
+=item C<handle>
+
+Use an already prepared handle.
+
+=item C<port>
+
+Port to connect to.
+
+=item C<tls>
+
+Enable TLS.
+
+=item C<tls_cert>
+
+Path to the TLS certificate file.
+
+=item C<tls_key>
+
+Path to the TLS key file.
+
+=back
+
+=head1 EVENTS
+
+L<Mojo::IOLoop::Client> can emit the following events.
+
+=head2 C<connect>
+
+Emitted once the connection is established.
+
+=head2 C<error>
+
+Emitted if an error happens on the connection.
+
+=head1 SEE ALSO
+
+L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>.
+
+=cut
@@ -0,0 +1,143 @@
+package Mojo::IOLoop::EventEmitter;
+use Mojo::Base -base;
+
+use Scalar::Util 'weaken';
+
+use constant DEBUG => $ENV{MOJO_EVENTEMITTER_DEBUG} || 0;
+
+# "Back you robots!
+# Nobody ruins my family vacation but me!
+# And maybe the boy."
+sub emit {
+ my $self = shift;
+ my $name = shift;
+
+ # Emit event sequentially to all subscribers
+ my @subscribers = @{$self->subscribers($name)};
+ warn "EMIT $name (" . scalar(@subscribers) . ")\n" if DEBUG;
+ for my $cb (@subscribers) {
+ $self->emit('error', qq/Event "$name" failed: $@/)
+ if !eval { $self->$cb(@_); 1 } && $name ne 'error';
+ }
+
+ return $self;
+}
+
+sub on {
+ my ($self, $name, $cb) = @_;
+ my $subscribers = $self->{events}->{$name} ||= [];
+ push @$subscribers, $cb;
+ return $cb;
+}
+
+sub once {
+ my ($self, $name, $cb) = @_;
+ my $wrapper;
+ $wrapper = sub {
+ my $self = shift;
+ $self->$cb(@_);
+ $self->unsubscribe($name => $wrapper);
+ };
+ $self->on($name => $wrapper);
+ weaken $wrapper;
+ return $wrapper;
+}
+
+sub subscribers {
+ my ($self, $name) = @_;
+ $self->{events}->{error} ||= [sub { warn $_[1] }] if $name eq 'error';
+ return [@{$self->{events}->{$name} || []}];
+}
+
+sub unsubscribe {
+ my ($self, $name, $cb) = @_;
+ my $subscribers = $self->{events}->{$name} || [];
+ my @callbacks;
+ for my $subscriber (@$subscribers) {
+ next if $cb eq $subscriber;
+ push @callbacks, $subscriber;
+ }
+ $self->{events}->{$name} = \@callbacks;
+ return $self;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Mojo::IOLoop::EventEmitter - IOLoop Event Emitter
+
+=head1 SYNOPSIS
+
+ use Mojo::IOLoop::EventEmitter;
+
+ # Create new event emitter
+ my $e = Mojo::IOLoop::EventEmitter->new;
+
+ # Subscribe to events
+ $e->on(error => sub {
+ my ($self, $error) = @_;
+ warn "Catched: $error";
+ });
+ $e->on(test => sub {
+ my ($self, $message) = @_;
+ die "test: $message";
+ });
+
+ # Emit events
+ $e->emit(test => 'Hello!');
+
+=head1 DESCRIPTION
+
+L<Mojo::IOLoop::EventEmitter> is the event emitter used by L<Mojo::IOLoop>.
+Note that this module is EXPERIMENTAL and might change without warning!
+
+=head1 METHODS
+
+L<Mojo::IOLoop::EventEmitter> inherits all methods from L<Mojo::Base> and
+implements the following new ones.
+
+=head2 C<emit>
+
+ $e->emit('foo');
+ $e->emit('foo', 123);
+
+Emit event.
+
+=head2 C<on>
+
+ my $cb = $e->on(foo => sub {...});
+
+Subscribe to event.
+
+=head2 C<once>
+
+ my $cb = $e->once(foo => sub {...});
+
+Subscribe to event and unsubscribe again after it has been emitted once.
+
+=head2 C<subscribers>
+
+ my $subscribers = $e->subscribers('foo');
+
+All subscribers for event.
+
+=head2 C<unsubscribe>
+
+ $e->unsubscribe(foo => $cb);
+
+Unsubscribe from event.
+
+=head1 DEBUGGING
+
+You can set the C<MOJO_EVENTEMITTER_DEBUG> environment variable to get some
+advanced diagnostics information printed to C<STDERR>.
+
+ MOJO_EVENTEMITTER_DEBUG=1
+
+=head1 SEE ALSO
+
+L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>.
+
+=cut
@@ -0,0 +1,408 @@
+package Mojo::IOLoop::Resolver;
+use Mojo::Base -base;
+
+use IO::File;
+use IO::Socket::INET;
+use List::Util 'first';
+use Mojo::URL;
+use Scalar::Util 'weaken';
+
+use constant DEBUG => $ENV{MOJO_RESOLVER_DEBUG} || 0;
+
+# "AF_INET6" requires Socket6 or Perl 5.12
+use constant IPV6_AF_INET6 => eval { Socket::AF_INET6() }
+ || eval { require Socket6 and Socket6::AF_INET6() };
+
+# "inet_pton" requires Socket6 or Perl 5.12
+BEGIN {
+
+ # Socket
+ if (defined &Socket::inet_pton) { *inet_pton = \&Socket::inet_pton }
+
+ # Socket6
+ elsif (eval { require Socket6 and defined &Socket6::inet_pton }) {
+ *inet_pton = \&Socket6::inet_pton;
+ }
+}
+
+# IPv6 DNS support requires "AF_INET6" and "inet_pton"
+use constant IPV6 => defined IPV6_AF_INET6 && defined &inet_pton;
+
+has ioloop => sub {
+ require Mojo::IOLoop;
+ Mojo::IOLoop->singleton;
+};
+has timeout => 3;
+
+# DNS server (default to Google Public DNS)
+my $SERVERS = ['8.8.8.8', '8.8.4.4'];
+
+# Try to detect DNS server
+if (-r '/etc/resolv.conf') {
+ my $file = IO::File->new('< /etc/resolv.conf');
+ my @servers;
+ for my $line (<$file>) {
+
+ # New DNS server
+ if ($line =~ /^nameserver\s+(\S+)$/) {
+ push @servers, $1;
+ warn qq/DETECTED DNS SERVER ($1)\n/ if DEBUG;
+ }
+ }
+ unshift @$SERVERS, @servers;
+}
+
+# User defined DNS server
+unshift @$SERVERS, $ENV{MOJO_DNS_SERVER} if $ENV{MOJO_DNS_SERVER};
+
+# Always start with first DNS server
+my $CURRENT_SERVER = 0;
+
+# DNS record types
+my $DNS_TYPES = {
+ '*' => 0x00ff,
+ A => 0x0001,
+ AAAA => 0x001c,
+ CNAME => 0x0005,
+ MX => 0x000f,
+ NS => 0x0002,
+ PTR => 0x000c,
+ TXT => 0x0010
+};
+
+# "localhost"
+our $LOCALHOST = '127.0.0.1';
+
+sub DESTROY { shift->_cleanup }
+
+sub lookup {
+ my ($self, $name, $cb) = @_;
+
+ # "localhost"
+ weaken $self;
+ return $self->ioloop->timer(0 => sub { $self->$cb($LOCALHOST) })
+ if $name eq 'localhost';
+
+ # IPv4
+ $self->resolve(
+ $name, 'A',
+ sub {
+ my ($self, $records) = @_;
+
+ # Success
+ my $result = first { $_->[0] eq 'A' } @$records;
+ return $self->$cb($result->[1]) if $result;
+
+ # IPv6
+ $self->resolve(
+ $name, 'AAAA',
+ sub {
+ my ($self, $records) = @_;
+
+ # Success
+ my $result = first { $_->[0] eq 'AAAA' } @$records;
+ return $self->$cb($result->[1]) if $result;
+
+ # Nothing
+ $self->$cb();
+ }
+ );
+ }
+ );
+}
+
+# "I can't believe it! Reading and writing actually paid off!"
+sub resolve {
+ my ($self, $name, $type, $cb) = @_;
+
+ # No lookup required or record type not supported
+ my $server = $self->servers;
+ my $t = $DNS_TYPES->{$type};
+ my $ipv4 = $name =~ $Mojo::URL::IPV4_RE ? 1 : 0;
+ my $ipv6 = IPV6 && $name =~ $Mojo::URL::IPV6_RE ? 1 : 0;
+ my $loop = $self->ioloop;
+ weaken $self;
+ return $loop->timer(0 => sub { $self->$cb([]) })
+ if !$server || !$t || ($t ne $DNS_TYPES->{PTR} && ($ipv4 || $ipv6));
+
+ # Build request
+ warn "RESOLVE $type $name ($server)\n" if DEBUG;
+ my $tx;
+ do { $tx = int rand 0x10000 } while ($self->{requests}->{$tx});
+
+ # Header (one question with recursion)
+ my $req = pack 'nnnnnn', $tx, 0x0100, 1, 0, 0, 0;
+
+ # Reverse
+ my @parts = split /\./, $name;
+ if ($t eq $DNS_TYPES->{PTR}) {
+
+ # IPv4
+ if ($ipv4) { @parts = reverse 'arpa', 'in-addr', @parts }
+
+ # IPv6
+ elsif ($ipv6) {
+ @parts = reverse 'arpa', 'ip6', split //, unpack 'H32',
+ inet_pton(IPV6_AF_INET6, $name);
+ }
+ }
+
+ # Query (Internet)
+ for my $part (@parts) { $req .= pack 'C/a*', $part if defined $part }
+ $req .= pack 'Cnn', 0, $t, 0x0001;
+
+ # Send request
+ $self->_bind($server);
+ $self->{requests}->{$tx} = {
+ cb => $cb,
+ timer => $loop->timer(
+ $self->timeout => sub {
+ my $loop = shift;
+ warn "RESOLVE TIMEOUT ($server)\n" if DEBUG;
+ $CURRENT_SERVER++;
+ $self->_cleanup;
+ }
+ )
+ };
+ $loop->write($self->{id} => $req);
+}
+
+# "I wonder where Bart is, his dinner's getting all cold... and eaten."
+sub servers {
+ my $self = shift;
+
+ # New servers
+ if (@_) {
+ @$SERVERS = @_;
+ $CURRENT_SERVER = 0;
+ }
+
+ # List all
+ return @$SERVERS if wantarray;
+
+ # Current server
+ $CURRENT_SERVER = 0 unless $SERVERS->[$CURRENT_SERVER];
+ return $SERVERS->[$CURRENT_SERVER];
+}
+
+sub _bind {
+ my ($self, $server) = @_;
+
+ # Reuse socket
+ return if $self->{id};
+
+ # New socket
+ my $loop = $self->ioloop;
+ weaken $self;
+ my $id = $self->{id} = $loop->connect(
+ address => $server,
+ port => 53,
+ on_close => sub { $self->_cleanup },
+ on_error => sub {
+ my ($loop, $id) = @_;
+ warn "RESOLVE FAILURE ($server)\n" if DEBUG;
+ $CURRENT_SERVER++;
+ $self->_cleanup;
+ },
+ on_read => sub {
+ my ($loop, $id, $chunk) = @_;
+
+ # Parse response
+ my @packet = unpack 'nnnnnna*', $chunk;
+ warn "ANSWERS $packet[3] ($server)\n" if DEBUG;
+ return unless my $r = delete $self->{requests}->{$packet[0]};
+ $loop->drop($r->{timer});
+
+ # Questions
+ my $content = $packet[6];
+ for (1 .. $packet[2]) {
+ my $n;
+ do { ($n, $content) = unpack 'C/aa*', $content } while ($n ne '');
+ $content = (unpack 'nna*', $content)[2];
+ }
+
+ # Answers
+ my @answers;
+ for (1 .. $packet[3]) {
+
+ # Parse
+ (my ($t, $ttl, $a), $content) =
+ (unpack 'nnnNn/aa*', $content)[1, 3, 4, 5];
+ my @answer = _parse_answer($t, $a, $chunk, $content);
+
+ # No answer
+ next unless @answer;
+
+ # Answer
+ push @answers, [@answer, $ttl];
+ warn "ANSWER $answer[0] $answer[1]\n" if DEBUG;
+ }
+ $r->{cb}->($self, \@answers);
+ },
+ args => {Proto => 'udp', Type => SOCK_DGRAM}
+ );
+ $loop->connection_timeout($id => 0);
+}
+
+sub _cleanup {
+ my $self = shift;
+ return unless my $loop = $self->ioloop;
+ $loop->drop(delete $self->{id}) if $self->{id};
+ for my $tx (keys %{$self->{requests}}) {
+ my $r = delete $self->{requests}->{$tx};
+ $r->{cb}->($self, []);
+ }
+}
+
+sub _parse_answer {
+ my ($t, $a, $packet, $rest) = @_;
+
+ # A
+ if ($t eq $DNS_TYPES->{A}) { return A => join('.', unpack 'C4', $a) }
+
+ # AAAA
+ elsif ($t eq $DNS_TYPES->{AAAA}) {
+ return AAAA => sprintf('%x:%x:%x:%x:%x:%x:%x:%x', unpack('n*', $a));
+ }
+
+ # TXT
+ elsif ($t eq $DNS_TYPES->{TXT}) { return TXT => unpack('(C/a*)*', $a) }
+
+ # Offset
+ my $offset = length($packet) - length($rest) - length($a);
+
+ # CNAME
+ my $type;
+ if ($t eq $DNS_TYPES->{CNAME}) { $type = 'CNAME' }
+
+ # MX
+ elsif ($t eq $DNS_TYPES->{MX}) {
+ $type = 'MX';
+ $offset += 2;
+ }
+
+ # NS
+ elsif ($t eq $DNS_TYPES->{NS}) { $type = 'NS' }
+
+ # PTR
+ elsif ($t eq $DNS_TYPES->{PTR}) { $type = 'PTR' }
+
+ # Domain name
+ return $type => _parse_name($packet, $offset) if $type;
+
+ # Not supported
+ return;
+}
+
+sub _parse_name {
+ my ($packet, $offset) = @_;
+
+ # Elements
+ my @elements;
+ for (1 .. 128) {
+
+ # Element length
+ my $len = ord substr $packet, $offset++, 1;
+
+ # Offset
+ if ($len >= 0xc0) {
+ $offset = (unpack 'n', substr $packet, ++$offset - 2, 2) & 0x3fff;
+ }
+
+ # Element
+ elsif ($len) {
+ push @elements, substr $packet, $offset, $len;
+ $offset += $len;
+ }
+
+ # Zero length element (the end)
+ else { return join '.', @elements }
+ }
+
+ return;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Mojo::IOLoop::Resolver - IOLoop DNS Stub Resolver
+
+=head1 SYNOPSIS
+
+ use Mojo::IOLoop::Resolver;
+
+=head1 DESCRIPTION
+
+L<Mojo::IOLoop::Resolver> is a minimalistic async I/O DNS stub resolver used
+by L<Mojo:IOLoop>.
+Note that this module is EXPERIMENTAL and might change without warning!
+
+=head1 ATTRIBUTES
+
+L<Mojo::IOLoop::Resolver> implements the following attributes.
+
+=head2 C<ioloop>
+
+ my $ioloop = $resolver->ioloop;
+ $resolver = $resolver->ioloop(Mojo::IOLoop->new);
+
+Loop object to use for I/O operations, by default a L<Mojo::IOLoop> object
+will be used.
+
+=head2 C<timeout>
+
+ my $timeout = $resolver->timeout;
+ $resolver = $resolver->timeout(5);
+
+Maximum time in seconds a C<DNS> lookup can take, defaults to C<3>.
+
+=head1 METHODS
+
+L<Mojo::IOLoop::Resolver> inherits all methods from L<Mojo::Base> and
+implements the following new ones.
+
+=head2 C<servers>
+
+ my @all = $resolver->servers;
+ my $current = $resolver->servers;
+ $resolver->servers('8.8.8.8', '8.8.4.4');
+
+IP addresses of C<DNS> servers used for lookups, defaults to the value of
+C<MOJO_DNS_SERVER>, auto detection, C<8.8.8.8> or C<8.8.4.4>.
+
+=head2 C<lookup>
+
+ $resolver->lookup('mojolicio.us' => sub {...});
+
+Lookup C<IPv4> or C<IPv6> address for domain.
+
+ $resolver->lookup('mojolicio.us' => sub {
+ my ($loop, $address) = @_;
+ print "Address: $address\n";
+ Mojo::IOLoop->stop;
+ });
+ Mojo::IOLoop->start;
+
+=head2 C<resolve>
+
+ $resolver->resolve('mojolicio.us', 'A', sub {...});
+
+Resolve domain into C<A>, C<AAAA>, C<CNAME>, C<MX>, C<NS>, C<PTR> or C<TXT>
+records, C<*> will query for all at once.
+Since this is a "stub resolver" it depends on a recursive name server for DNS
+resolution.
+
+=head1 DEBUGGING
+
+You can set the C<MOJO_RESOLVER_DEBUG> environment variable to get some
+advanced diagnostics information printed to C<STDERR>.
+
+ MOJO_RESOLVER_DEBUG=1
+
+=head1 SEE ALSO
+
+L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>.
+
+=cut
@@ -0,0 +1,376 @@
+package Mojo::IOLoop::Server;
+use Mojo::Base 'Mojo::IOLoop::EventEmitter';
+
+use Carp 'croak';
+use File::Spec;
+use IO::File;
+use IO::Socket::INET;
+use Scalar::Util 'weaken';
+use Socket qw/IPPROTO_TCP TCP_NODELAY/;
+
+# IPv6 support requires IO::Socket::IP
+use constant IPV6 => $ENV{MOJO_NO_IPV6}
+ ? 0
+ : eval 'use IO::Socket::IP 0.06 (); 1';
+
+# TLS support requires IO::Socket::SSL
+use constant TLS => $ENV{MOJO_NO_TLS}
+ ? 0
+ : eval 'use IO::Socket::SSL 1.43 "inet4"; 1';
+use constant TLS_READ => TLS ? IO::Socket::SSL::SSL_WANT_READ() : 0;
+use constant TLS_WRITE => TLS ? IO::Socket::SSL::SSL_WANT_WRITE() : 0;
+
+# Default TLS cert (20.03.2010)
+# (openssl req -new -x509 -keyout cakey.pem -out cacert.pem -nodes -days 7300)
+use constant CERT => <<EOF;
+-----BEGIN CERTIFICATE-----
+MIIDbzCCAtigAwIBAgIJAM+kFv1MwalmMA0GCSqGSIb3DQEBBQUAMIGCMQswCQYD
+VQQGEwJERTEWMBQGA1UECBMNTmllZGVyc2FjaHNlbjESMBAGA1UEBxMJSGFtYmVy
+Z2VuMRQwEgYDVQQKEwtNb2pvbGljaW91czESMBAGA1UEAxMJbG9jYWxob3N0MR0w
+GwYJKoZIhvcNAQkBFg5rcmFpaEBjcGFuLm9yZzAeFw0xMDAzMjAwMDQ1MDFaFw0z
+MDAzMTUwMDQ1MDFaMIGCMQswCQYDVQQGEwJERTEWMBQGA1UECBMNTmllZGVyc2Fj
+aHNlbjESMBAGA1UEBxMJSGFtYmVyZ2VuMRQwEgYDVQQKEwtNb2pvbGljaW91czES
+MBAGA1UEAxMJbG9jYWxob3N0MR0wGwYJKoZIhvcNAQkBFg5rcmFpaEBjcGFuLm9y
+ZzCBnzANBgkqhkiG9w0BAQEFAAOBjQAwgYkCgYEAzu9mOiyUJB2NBuf1lZxViNM2
+VISqRAoaXXGOBa6RgUoVfA/n81RQlgvVA0qCSQHC534DdYRk3CdyJR9UGPuxF8k4
+CckOaHWgcJJsd8H0/q73PjbA5ItIpGTTJNh8WVpFDjHTJmQ5ihwddap4/offJxZD
+dPrMFtw1ZHBRug5tHUECAwEAAaOB6jCB5zAdBgNVHQ4EFgQUo+Re5wuuzVFqH/zV
+cxRGXL0j5K4wgbcGA1UdIwSBrzCBrIAUo+Re5wuuzVFqH/zVcxRGXL0j5K6hgYik
+gYUwgYIxCzAJBgNVBAYTAkRFMRYwFAYDVQQIEw1OaWVkZXJzYWNoc2VuMRIwEAYD
+VQQHEwlIYW1iZXJnZW4xFDASBgNVBAoTC01vam9saWNpb3VzMRIwEAYDVQQDEwls
+b2NhbGhvc3QxHTAbBgkqhkiG9w0BCQEWDmtyYWloQGNwYW4ub3JnggkAz6QW/UzB
+qWYwDAYDVR0TBAUwAwEB/zANBgkqhkiG9w0BAQUFAAOBgQCZZcOeAobctD9wtPtO
+40CKHpiGYEM3rh7VvBhjTcVnX6XlLvffIg3uTrVRhzmlEQCZz3O5TsBzfMAVnjYz
+llhwgRF6Xn8ict9L8yKDoGSbw0Q7HaCb8/kOe0uKhcSDUd3PjJU0ZWgc20zcGFA9
+R65bABoJ2vU1rlQFmjs0RT4UcQ==
+-----END CERTIFICATE-----
+EOF
+
+# Default TLS key (20.03.2010)
+# (openssl req -new -x509 -keyout cakey.pem -out cacert.pem -nodes -days 7300)
+use constant KEY => <<EOF;
+-----BEGIN RSA PRIVATE KEY-----
+MIICXAIBAAKBgQDO72Y6LJQkHY0G5/WVnFWI0zZUhKpEChpdcY4FrpGBShV8D+fz
+VFCWC9UDSoJJAcLnfgN1hGTcJ3IlH1QY+7EXyTgJyQ5odaBwkmx3wfT+rvc+NsDk
+i0ikZNMk2HxZWkUOMdMmZDmKHB11qnj+h98nFkN0+swW3DVkcFG6Dm0dQQIDAQAB
+AoGAeLmd8C51tqQu1GqbEc+E7zAZsDE9jDhArWdELfhsFvt7kUdOUN1Nrlv0x9i+
+LY2Dgb44kmTM2suAgjvGulSMOYBGosZcM0w3ES76nmeAVJ1NBFhbZTCJqo9svoD/
+NKdctRflUuvFSWimoui+vj9D5p/4lvAMdBHUWj5FlQsYiOECQQD/FRXtsDetptFu
+Vp8Kw+6bZ5+efcjVfciTp7fQKI2xZ2n1QyloaV4zYXgDC2y3fMYuRigCGrX9XeFX
+oGHGMyYFAkEAz635I8f4WQa/wvyl/SR5agtDVnkJqMHMgOuykytiF8NFbDSkJv+b
+1VfyrWcfK/PVsSGBI67LCMDoP+PZBVOjDQJBAIInoCjH4aEZnYNPb5duojFpjmiw
+helpZQ7yZTgxeRssSUR8IITGPuq4sSPckHyPjg/OfFuWhYXigTjU/Q7EyoECQERT
+Dykna9wWLVZ/+jgLHOq3Y+L6FSRxBc/QO0LRvgblVlygAPVXmLQaqBtGVuoF4WLS
+DANqSR/LH12Nn2NyPa0CQBbzoHgx2i3RncWoq1EeIg2mSMevEcjA6sxgYmsyyzlv
+AnqxHi90n/p912ynLg2SjBq+03GaECeGzC/QqKK2gtA=
+-----END RSA PRIVATE KEY-----
+EOF
+
+has iowatcher => sub {
+ require Mojo::IOLoop;
+ Mojo::IOLoop->singleton->iowatcher;
+};
+
+sub DESTROY {
+ my $self = shift;
+ if (my $cert = $self->{cert}) { unlink $cert if -w $cert }
+ if (my $key = $self->{key}) { unlink $key if -w $key }
+ return unless my $watcher = $self->iowatcher;
+ $self->pause if $self->{handle};
+ $watcher->remove($_) for values %{$self->{handles}};
+}
+
+# "Have you ever seen that Blue Man Group? Total ripoff of the Smurfs.
+# And the Smurfs, well, they SUCK."
+sub listen {
+ my $self = shift;
+ my $args = ref $_[0] ? $_[0] : {@_};
+
+ # Look for reusable file descriptor
+ my $reuse = my $port = $args->{port} || 3000;
+ $ENV{MOJO_REUSE} ||= '';
+ my $fd;
+ if ($ENV{MOJO_REUSE} =~ /(?:^|\,)$reuse\:(\d+)/) { $fd = $1 }
+
+ # Allow file descriptor inheritance
+ local $^F = 1000;
+
+ # Reuse file descriptor
+ my $handle;
+ my $class = IPV6 ? 'IO::Socket::IP' : 'IO::Socket::INET';
+ if (defined $fd) {
+ $handle = $class->new;
+ $handle->fdopen($fd, 'r')
+ or croak "Can't open file descriptor $fd: $!";
+ }
+
+ # New socket
+ else {
+ my %options = (
+ Listen => $args->{backlog} || SOMAXCONN,
+ LocalAddr => $args->{address} || '0.0.0.0',
+ LocalPort => $port,
+ Proto => 'tcp',
+ ReuseAddr => 1,
+ Type => SOCK_STREAM,
+ %{$args->{args} || {}}
+ );
+ $options{LocalAddr} =~ s/[\[\]]//g;
+ $handle = $class->new(%options)
+ or croak "Can't create listen socket: $!";
+ $fd = fileno $handle;
+ $reuse = ",$reuse" if length $ENV{MOJO_REUSE};
+ $ENV{MOJO_REUSE} .= "$reuse:$fd";
+ }
+ $self->{handle} = $handle;
+
+ # TLS
+ if ($args->{tls}) {
+
+ # No TLS support
+ croak "IO::Socket::SSL 1.43 required for TLS support" unless TLS;
+
+ # Options
+ my %options = (
+ SSL_startHandshake => 0,
+ SSL_cert_file => $args->{tls_cert} || $self->_cert_file,
+ SSL_key_file => $args->{tls_key} || $self->_key_file,
+ );
+ %options = (
+ SSL_verify_callback => $args->{tls_verify},
+ SSL_ca_file => -T $args->{tls_ca} ? $args->{tls_ca} : undef,
+ SSL_ca_path => -d $args->{tls_ca} ? $args->{tls_ca} : undef,
+ SSL_verify_mode => $args->{tls_ca} ? 0x03 : undef,
+ %options
+ ) if $args->{tls_ca};
+ $self->{tls} = {%options, %{$args->{tls_args} || {}}};
+ }
+}
+
+sub generate_port {
+
+ # Try random ports
+ my $port = 1 . int(rand 10) . int(rand 10) . int(rand 10) . int(rand 10);
+ while ($port++ < 30000) {
+ return $port
+ if IO::Socket::INET->new(
+ Listen => 5,
+ LocalAddr => '127.0.0.1',
+ LocalPort => $port,
+ Proto => 'tcp'
+ );
+ }
+
+ return;
+}
+
+sub pause {
+ my $self = shift;
+ $self->iowatcher->remove($self->{handle});
+}
+
+sub resume {
+ my $self = shift;
+ weaken $self;
+ $self->iowatcher->add($self->{handle},
+ on_readable => sub { $self->_accept });
+}
+
+sub _accept {
+ my $self = shift;
+
+ # Accept
+ my $handle = $self->{handle}->accept;
+ return $self->emit(accept => $handle) unless my $tls = $self->{tls};
+
+ # Start TLS handshake
+ weaken $self;
+ $tls->{SSL_error_trap} = sub {
+ my $handle = delete $self->{handles}->{$handle};
+ $self->iowatcher->remove($handle);
+ close $handle;
+ };
+ $handle = IO::Socket::SSL->start_SSL($handle, %$tls);
+ $self->iowatcher->add(
+ $handle,
+ on_readable => sub { $self->_tls($handle) },
+ on_writable => sub { $self->_tls($handle) }
+ );
+ $self->{handles}->{$handle} = $handle;
+
+ # Non-blocking
+ $handle->blocking(0);
+
+ # Disable Nagle's algorithm
+ setsockopt($handle, IPPROTO_TCP, TCP_NODELAY, 1) unless $self->{file};
+}
+
+sub _cert_file {
+ my $self = shift;
+
+ # Check if temporary TLS cert file already exists
+ my $cert = $self->{cert};
+ return $cert if $cert && -r $cert;
+
+ # Create temporary TLS cert file
+ $cert = File::Spec->catfile($ENV{MOJO_TMPDIR} || File::Spec->tmpdir,
+ 'mojocert.pem');
+ croak qq/Can't create temporary TLS cert file "$cert"/
+ unless my $file = IO::File->new("> $cert");
+ print $file CERT;
+
+ $self->{cert} = $cert;
+}
+
+sub _key_file {
+ my $self = shift;
+
+ # Check if temporary TLS key file already exists
+ my $key = $self->{key};
+ return $key if $key && -r $key;
+
+ # Create temporary TLS key file
+ $key = File::Spec->catfile($ENV{MOJO_TMPDIR} || File::Spec->tmpdir,
+ 'mojokey.pem');
+ croak qq/Can't create temporary TLS key file "$key"/
+ unless my $file = IO::File->new("> $key");
+ print $file KEY;
+
+ $self->{key} = $key;
+}
+
+sub _tls {
+ my ($self, $handle) = @_;
+
+ # Accept
+ if ($handle->accept_SSL) {
+ $self->iowatcher->remove($handle);
+ delete $self->{handles}->{$handle};
+ return $self->emit(accept => $handle);
+ }
+
+ # Switch between reading and writing
+ my $error = $IO::Socket::SSL::SSL_ERROR;
+ if ($error == TLS_READ) { $self->iowatcher->not_writing($handle) }
+ elsif ($error == TLS_WRITE) { $self->iowatcher->writing($handle) }
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Mojo::IOLoop::Server - IOLoop Socket Server
+
+=head1 SYNOPSIS
+
+ use Mojo::IOLoop::Server;
+
+ # Create listen socket
+ my $server = Mojo::IOLoop::Server->new;
+ $server->on(accept => sub {
+ my ($self, $handle) = @_;
+ ...
+ });
+ $server->listen(port => 3000);
+
+ # Start and stop accepting connections
+ $server->resume;
+ $server->pause;
+
+=head1 DESCRIPTION
+
+L<Mojo::IOLoop::Server> accepts incoming socket connections for
+L<Mojo::IOLoop>.
+Note that this module is EXPERIMENTAL and might change without warning!
+
+=head1 ATTRIBUTES
+
+L<Mojo::IOLoop::Server> implements the following attributes.
+
+=head2 C<iowatcher>
+
+ my $watcher = $server->iowatcher;
+ $server = $server->iowatcher(Mojo::IOWatcher->new);
+
+Low level event watcher, usually a L<Mojo::IOWatcher> or
+L<Mojo::IOWatcher::EV> object.
+
+=head1 METHODS
+
+L<Mojo::IOLoop::Server> inherits all methods from
+L<Mojo::IOLoop::EventEmitter> and implements the following new ones.
+
+=head2 C<listen>
+
+ $server->listen(port => 3000);
+
+Create a new listen socket.
+Note that TLS support depends on L<IO::Socket::SSL> and IPv6 support on
+L<IO::Socket::IP>.
+
+These options are currently available:
+
+=over 2
+
+=item C<address>
+
+Local address to listen on, defaults to all.
+
+=item C<backlog>
+
+Maximum backlog size, defaults to C<SOMAXCONN>.
+
+=item C<port>
+
+Port to listen on.
+
+=item C<tls>
+
+Enable TLS.
+
+=item C<tls_cert>
+
+Path to the TLS cert file, defaulting to a built-in test certificate.
+
+=item C<tls_key>
+
+Path to the TLS key file, defaulting to a built-in test key.
+
+=item C<tls_ca>
+
+Path to TLS certificate authority file or directory.
+
+=back
+
+=head2 C<generate_port>
+
+ my $port = $server->generate_port;
+
+Find a free TCP port.
+
+=head2 C<pause>
+
+ $server->pause;
+
+Stop accepting connections.
+
+=head2 C<resume>
+
+ $server->resume;
+
+Start accepting connections.
+
+=head1 EVENTS
+
+L<Mojo::IOLoop::Server> can emit the following events.
+
+=head2 C<accept>
+
+Emitted for each accepted connection.
+
+=head1 SEE ALSO
+
+L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>.
+
+=cut
@@ -0,0 +1,271 @@
+package Mojo::IOLoop::Stream;
+use Mojo::Base 'Mojo::IOLoop::EventEmitter';
+
+use Errno qw/EAGAIN EINTR ECONNRESET EWOULDBLOCK/;
+use Scalar::Util 'weaken';
+
+use constant CHUNK_SIZE => $ENV{MOJO_CHUNK_SIZE} || 131072;
+
+# Windows
+use constant WINDOWS => $^O eq 'MSWin32' || $^O =~ /cygwin/ ? 1 : 0;
+
+has iowatcher => sub {
+ require Mojo::IOLoop;
+ Mojo::IOLoop->singleton->iowatcher;
+};
+
+sub DESTROY {
+ my $self = shift;
+ $self->pause;
+ $self->emit('close') if $self->{handle};
+}
+
+# "And America has so many enemies.
+# Iran, Iraq, China, Mordor, the hoochies that laid low Tiger Woods,
+# undesirable immigrants - by which I mean everyone that came after me,
+# including my children..."
+sub new {
+ my $self = shift->SUPER::new;
+ $self->{handle} = shift;
+ $self->{handle}->blocking(0);
+ $self->{buffer} = '';
+ return $self;
+}
+
+sub handle { shift->{handle} }
+
+sub is_finished {
+ my $self = shift;
+ return if length $self->{buffer};
+ return if @{$self->subscribers('drain')};
+ return 1;
+}
+
+sub pause {
+ my $self = shift;
+ return unless my $handle = $self->{handle};
+ return unless my $watcher = $self->iowatcher;
+ $watcher->remove($handle);
+}
+
+sub resume {
+ my $self = shift;
+ weaken $self;
+ $self->iowatcher->add(
+ $self->{handle},
+ on_readable => sub { $self->_read },
+ on_writable => sub { $self->_write }
+ );
+}
+
+sub steal_handle {
+ my $self = shift;
+ $self->pause;
+ return delete $self->{handle};
+}
+
+sub write {
+ my ($self, $chunk, $cb) = @_;
+
+ # Prepare chunk for writing
+ $self->{buffer} .= $chunk;
+
+ # UNIX only quick write
+ unless (WINDOWS) {
+ local $self->{quick} = 1 if $cb;
+ $self->_write;
+ }
+
+ # Write with roundtrip
+ if ($cb) { $self->once(drain => $cb) }
+ else { return unless length $self->{buffer} }
+
+ # Start writing
+ return unless my $handle = $self->{handle};
+ $self->iowatcher->writing($handle);
+}
+
+sub _read {
+ my $self = shift;
+
+ # Read
+ my $read = $self->{handle}->sysread(my $buffer, CHUNK_SIZE, 0);
+
+ # Error
+ unless (defined $read) {
+
+ # Retry
+ return if $! == EAGAIN || $! == EINTR || $! == EWOULDBLOCK;
+
+ # Connection reset
+ return $self->emit('close') if $! == ECONNRESET;
+
+ # Read error
+ return $self->emit(error => $!);
+ }
+
+ # EOF
+ return $self->emit('close') if $read == 0;
+
+ # Handle read
+ $self->emit(read => $buffer);
+}
+
+sub _write {
+ my $self = shift;
+
+ # Handle drain
+ $self->emit('drain') if !length $self->{buffer} && !$self->{quick};
+
+ # Write as much as possible
+ my $handle = $self->{handle};
+ if (length $self->{buffer}) {
+ my $written = $handle->syswrite($self->{buffer});
+
+ # Error
+ unless (defined $written) {
+
+ # Retry
+ return if $! == EAGAIN || $! == EINTR || $! == EWOULDBLOCK;
+
+ # Close
+ return $self->emit('close')
+ if $handle->can('connected') && !$handle->connected;
+
+ # Write error
+ return $self->emit(error => $!);
+ }
+
+ # Remove written chunk from buffer
+ substr $self->{buffer}, 0, $written, '';
+ }
+
+ # Stop writing
+ return
+ if length $self->{buffer}
+ || $self->{quick}
+ || @{$self->subscribers('drain')};
+ $self->iowatcher->not_writing($handle);
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Mojo::IOLoop::Stream - IOLoop Stream
+
+=head1 SYNOPSIS
+
+ use Mojo::IOLoop::Stream;
+
+ # Create stream
+ my $stream = Mojo::IOLoop::Stream->new($handle);
+ $stream->on(read => sub {
+ my ($self, $chunk) = @_;
+ ...
+ });
+ $stream->on(close => sub {
+ my $self = shift;
+ ...
+ });
+ $stream->on(error => sub {
+ my ($self, $error) = @_;
+ ...
+ });
+
+ # Start and stop watching for new data
+ $stream->resume;
+ $stream->pause;
+
+=head1 DESCRIPTION
+
+L<Mojo::IOLoop::Stream> is a container for streaming handles used by
+L<Mojo::IOLoop>.
+Note that this module is EXPERIMENTAL and might change without warning!
+
+=head1 ATTRIBUTES
+
+L<Mojo::IOLoop::Stream> implements the following attributes.
+
+=head2 C<iowatcher>
+
+ my $watcher = $stream->iowatcher;
+ $stream = $stream->iowatcher(Mojo::IOWatcher->new);
+
+Low level event watcher, usually a L<Mojo::IOWatcher> or
+L<Mojo::IOWatcher::EV> object.
+
+=head1 METHODS
+
+L<Mojo::IOLoop::Stream> inherits all methods from
+L<Mojo::IOLoop::EventEmitter> and implements the following new ones.
+
+=head2 C<new>
+
+ my $stream = Mojo::IOLoop::Stream->new($handle);
+
+Construct a new L<Mojo::IOLoop::Stream> object.
+
+=head2 C<handle>
+
+ my $handle = $stream->handle;
+
+Get handle for stream.
+
+=head2 C<is_finished>
+
+ my $finished = $stream->is_finished;
+
+Check if stream is in a state where it is safe to close or steal the handle.
+
+=head2 C<pause>
+
+ $stream->pause;
+
+Stop watching for new data on the stream.
+
+=head2 C<resume>
+
+ $stream->resume;
+
+Start watching for new data on the stream.
+
+=head2 C<steal_handle>
+
+ my $handle = $stream->steal_handle;
+
+Steal handle from stream and prevent it from getting closed automatically.
+
+=head2 C<write>
+
+ $stream->write('Hello!');
+
+Write data to stream, the optional drain callback will be invoked once all
+data has been written.
+
+=head1 EVENTS
+
+L<Mojo::IOLoop::Stream> can emit the following events.
+
+=head2 C<close>
+
+Emitted if the stream gets closed.
+
+=head2 C<drain>
+
+Emitted once all data has been written.
+
+=head2 C<error>
+
+Emitted if an error happens on the stream.
+
+=head2 C<read>
+
+Emitted if new data arrives on the stream.
+
+=head1 SEE ALSO
+
+L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>.
+
+=cut
@@ -1,110 +1,22 @@
package Mojo::IOLoop;
use Mojo::Base -base;
-use Carp 'croak';
-use Errno qw/EAGAIN EINTR ECONNRESET EWOULDBLOCK/;
-use File::Spec;
-use IO::File;
-use IO::Socket::INET;
-use IO::Socket::UNIX;
+use Mojo::IOLoop::Client;
+use Mojo::IOLoop::Resolver;
+use Mojo::IOLoop::Server;
+use Mojo::IOLoop::Stream;
use Mojo::IOWatcher;
-use Mojo::Resolver;
use Scalar::Util 'weaken';
-use Socket qw/IPPROTO_TCP TCP_NODELAY/;
use Time::HiRes 'time';
-use constant DEBUG => $ENV{MOJO_IOLOOP_DEBUG} || 0;
-use constant CHUNK_SIZE => $ENV{MOJO_CHUNK_SIZE} || 131072;
-
-# IPv6 support requires IO::Socket::IP
-use constant IPV6 => $ENV{MOJO_NO_IPV6}
- ? 0
- : eval 'use IO::Socket::IP 0.06 (); 1';
-
-# Epoll support requires IO::Epoll
-use constant EPOLL => $ENV{MOJO_POLL}
- ? 0
- : eval 'use Mojo::IOWatcher::Epoll; 1';
-
-# KQueue support requires IO::KQueue
-use constant KQUEUE => $ENV{MOJO_POLL}
- ? 0
- : eval 'use Mojo::IOWatcher::KQueue; 1';
-
-# TLS support requires IO::Socket::SSL
-use constant TLS => $ENV{MOJO_NO_TLS}
- ? 0
- : eval 'use IO::Socket::SSL 1.43 "inet4"; 1';
-use constant TLS_READ => TLS ? IO::Socket::SSL::SSL_WANT_READ() : 0;
-use constant TLS_WRITE => TLS ? IO::Socket::SSL::SSL_WANT_WRITE() : 0;
-
-# Windows
-use constant WINDOWS => $^O eq 'MSWin32' || $^O =~ /cygwin/ ? 1 : 0;
-
-# Default TLS cert (20.03.2010)
-# (openssl req -new -x509 -keyout cakey.pem -out cacert.pem -nodes -days 7300)
-use constant CERT => <<EOF;
------BEGIN CERTIFICATE-----
-MIIDbzCCAtigAwIBAgIJAM+kFv1MwalmMA0GCSqGSIb3DQEBBQUAMIGCMQswCQYD
-VQQGEwJERTEWMBQGA1UECBMNTmllZGVyc2FjaHNlbjESMBAGA1UEBxMJSGFtYmVy
-Z2VuMRQwEgYDVQQKEwtNb2pvbGljaW91czESMBAGA1UEAxMJbG9jYWxob3N0MR0w
-GwYJKoZIhvcNAQkBFg5rcmFpaEBjcGFuLm9yZzAeFw0xMDAzMjAwMDQ1MDFaFw0z
-MDAzMTUwMDQ1MDFaMIGCMQswCQYDVQQGEwJERTEWMBQGA1UECBMNTmllZGVyc2Fj
-aHNlbjESMBAGA1UEBxMJSGFtYmVyZ2VuMRQwEgYDVQQKEwtNb2pvbGljaW91czES
-MBAGA1UEAxMJbG9jYWxob3N0MR0wGwYJKoZIhvcNAQkBFg5rcmFpaEBjcGFuLm9y
-ZzCBnzANBgkqhkiG9w0BAQEFAAOBjQAwgYkCgYEAzu9mOiyUJB2NBuf1lZxViNM2
-VISqRAoaXXGOBa6RgUoVfA/n81RQlgvVA0qCSQHC534DdYRk3CdyJR9UGPuxF8k4
-CckOaHWgcJJsd8H0/q73PjbA5ItIpGTTJNh8WVpFDjHTJmQ5ihwddap4/offJxZD
-dPrMFtw1ZHBRug5tHUECAwEAAaOB6jCB5zAdBgNVHQ4EFgQUo+Re5wuuzVFqH/zV
-cxRGXL0j5K4wgbcGA1UdIwSBrzCBrIAUo+Re5wuuzVFqH/zVcxRGXL0j5K6hgYik
-gYUwgYIxCzAJBgNVBAYTAkRFMRYwFAYDVQQIEw1OaWVkZXJzYWNoc2VuMRIwEAYD
-VQQHEwlIYW1iZXJnZW4xFDASBgNVBAoTC01vam9saWNpb3VzMRIwEAYDVQQDEwls
-b2NhbGhvc3QxHTAbBgkqhkiG9w0BCQEWDmtyYWloQGNwYW4ub3JnggkAz6QW/UzB
-qWYwDAYDVR0TBAUwAwEB/zANBgkqhkiG9w0BAQUFAAOBgQCZZcOeAobctD9wtPtO
-40CKHpiGYEM3rh7VvBhjTcVnX6XlLvffIg3uTrVRhzmlEQCZz3O5TsBzfMAVnjYz
-llhwgRF6Xn8ict9L8yKDoGSbw0Q7HaCb8/kOe0uKhcSDUd3PjJU0ZWgc20zcGFA9
-R65bABoJ2vU1rlQFmjs0RT4UcQ==
------END CERTIFICATE-----
-EOF
-
-# Default TLS key (20.03.2010)
-# (openssl req -new -x509 -keyout cakey.pem -out cacert.pem -nodes -days 7300)
-use constant KEY => <<EOF;
------BEGIN RSA PRIVATE KEY-----
-MIICXAIBAAKBgQDO72Y6LJQkHY0G5/WVnFWI0zZUhKpEChpdcY4FrpGBShV8D+fz
-VFCWC9UDSoJJAcLnfgN1hGTcJ3IlH1QY+7EXyTgJyQ5odaBwkmx3wfT+rvc+NsDk
-i0ikZNMk2HxZWkUOMdMmZDmKHB11qnj+h98nFkN0+swW3DVkcFG6Dm0dQQIDAQAB
-AoGAeLmd8C51tqQu1GqbEc+E7zAZsDE9jDhArWdELfhsFvt7kUdOUN1Nrlv0x9i+
-LY2Dgb44kmTM2suAgjvGulSMOYBGosZcM0w3ES76nmeAVJ1NBFhbZTCJqo9svoD/
-NKdctRflUuvFSWimoui+vj9D5p/4lvAMdBHUWj5FlQsYiOECQQD/FRXtsDetptFu
-Vp8Kw+6bZ5+efcjVfciTp7fQKI2xZ2n1QyloaV4zYXgDC2y3fMYuRigCGrX9XeFX
-oGHGMyYFAkEAz635I8f4WQa/wvyl/SR5agtDVnkJqMHMgOuykytiF8NFbDSkJv+b
-1VfyrWcfK/PVsSGBI67LCMDoP+PZBVOjDQJBAIInoCjH4aEZnYNPb5duojFpjmiw
-helpZQ7yZTgxeRssSUR8IITGPuq4sSPckHyPjg/OfFuWhYXigTjU/Q7EyoECQERT
-Dykna9wWLVZ/+jgLHOq3Y+L6FSRxBc/QO0LRvgblVlygAPVXmLQaqBtGVuoF4WLS
-DANqSR/LH12Nn2NyPa0CQBbzoHgx2i3RncWoq1EeIg2mSMevEcjA6sxgYmsyyzlv
-AnqxHi90n/p912ynLg2SjBq+03GaECeGzC/QqKK2gtA=
------END RSA PRIVATE KEY-----
-EOF
-
-has [qw/accept_timeout connect_timeout/] => 3;
-has iowatcher => sub {
-
- # "kqueue"
- if (KQUEUE) {
- warn "KQUEUE MAINLOOP\n" if DEBUG;
- return Mojo::IOWatcher::KQueue->new;
- }
-
- # "epoll"
- if (EPOLL) {
- warn "EPOLL MAINLOOP\n" if DEBUG;
- return Mojo::IOWatcher::Epoll->new;
- }
+use constant DEBUG => $ENV{MOJO_IOLOOP_DEBUG} || 0;
- # "poll"
- warn "POLL MAINLOOP\n" if DEBUG;
- Mojo::IOWatcher->new;
+has client_class => 'Mojo::IOLoop::Client';
+has connect_timeout => 3;
+has iowatcher => sub {
+ my $class = Mojo::IOWatcher->detect;
+ warn "MAINLOOP ($class)\n" if DEBUG;
+ $class->new;
};
has max_accepts => 0;
has max_connections => 1000;
@@ -112,21 +24,17 @@ has [qw/on_lock on_unlock/] => sub {
sub {1}
};
has resolver => sub {
- my $self = shift;
- weaken $self;
- Mojo::Resolver->new(ioloop => $self);
+ my $resolver = Mojo::IOLoop::Resolver->new(ioloop => shift);
+ weaken $resolver->{ioloop};
+ return $resolver;
};
-has timeout => '0.025';
+has server_class => 'Mojo::IOLoop::Server';
+has stream_class => 'Mojo::IOLoop::Stream';
+has timeout => '0.025';
# Singleton
our $LOOP;
-sub DESTROY {
- my $self = shift;
- if (my $cert = $self->{cert}) { unlink $cert if -w $cert }
- if (my $key = $self->{key}) { unlink $key if -w $key }
-}
-
sub new {
my $class = shift;
@@ -152,78 +60,96 @@ sub connect {
my $self = shift;
$self = $self->singleton unless ref $self;
my $args = ref $_[0] ? $_[0] : {@_};
- $args->{proto} ||= 'tcp';
-
- # New connection
- my $c = {
- buffer => '',
- on_connect => $args->{on_connect},
- connecting => 1,
- tls => $args->{tls},
- tls_cert => $args->{tls_cert},
- tls_key => $args->{tls_key}
- };
- (my $id) = "$c" =~ /0x([\da-f]+)/;
- $self->{cs}->{$id} = $c;
-
- # Register callbacks
- for my $name (qw/close error read/) {
- my $cb = $args->{"on_$name"};
- my $event = "on_$name";
- $self->$event($id => $cb) if $cb;
- }
- # Lookup
- if (!$args->{handle} && (my $address = $args->{address})) {
- weaken $self;
- $self->resolver->lookup(
- $address => sub {
- my $resolver = shift;
- $args->{address} = shift || $args->{address};
- $self->_connect($id, $args);
- }
- );
- }
+ # New client
+ my $client = $self->client_class->new;
+ (my $id) = "$client" =~ /0x([\da-f]+)/;
+ $id = $args->{id} if $args->{id};
+ my $c = $self->{connections}->{$id} ||= {};
+ $c->{client} = $client;
+ $client->resolver($self->resolver);
+ weaken $client->{resolver};
+
+ # Events
+ $c->{close} ||= delete $args->{on_close};
+ $c->{connect} ||= delete $args->{on_connect};
+ $c->{error} ||= delete $args->{on_error};
+ $c->{read} ||= delete $args->{on_read};
+ weaken $self;
+ $client->on(
+ connect => sub {
+ my $handle = pop;
+
+ # New stream
+ my $c = $self->{connections}->{$id};
+ delete $c->{client};
+ my $stream = $c->{stream} = $self->stream_class->new($handle);
+ $stream->iowatcher($self->iowatcher);
+ weaken $stream->{iowatcher};
+
+ # Events
+ $stream->on(
+ close => sub {
+ $c->{close}->($self, $id) if $c->{close};
+ $self->drop($id);
+ }
+ );
+ weaken $c;
+ $stream->on(
+ error => sub {
+ my $c = delete $self->{connections}->{$id};
+ $c->{error}->($self, $id, pop) if $c->{error};
+ }
+ );
+ $stream->on(
+ read => sub {
+ my $c = $self->{connections}->{$id};
+ $c->{active} = time;
+ $c->{read}->($self, $id, pop) if $c->{read};
+ }
+ );
+
+ # Connected
+ $stream->resume;
+ $self->write($id, @$_) for @{$c->{write} || []};
+ $c->{connect}->($self, $id) if $c->{connect};
+ }
+ );
+ $client->on(
+ error => sub {
+ my $c = delete $self->{connections}->{$id};
+ $c->{error}->($self, $id, pop) if $c->{error};
+ }
+ );
# Connect
- else { $self->_connect($id, $args) }
+ $args->{timeout} ||= $self->connect_timeout;
+ $client->connect($args);
return $id;
}
sub connection_timeout {
my ($self, $id, $timeout) = @_;
- return unless my $c = $self->{cs}->{$id};
- $c->{timeout} = $timeout and return $self if $timeout;
+ return unless my $c = $self->{connections}->{$id};
+ $c->{timeout} = $timeout and return $self if defined $timeout;
$c->{timeout};
}
sub drop {
my ($self, $id) = @_;
$self = $self->singleton unless ref $self;
-
- # Drop connections gracefully
- if (my $c = $self->{cs}->{$id}) { return $c->{finish} = 1 }
-
- # Drop everything else right away
+ if (my $c = $self->{connections}->{$id}) { return $c->{finish} = 1 }
$self->_drop($id);
}
-sub generate_port {
-
- # Try random ports
- my $port = 1 . int(rand 10) . int(rand 10) . int(rand 10) . int(rand 10);
- while ($port++ < 30000) {
- return $port
- if IO::Socket::INET->new(
- Listen => 5,
- LocalAddr => '127.0.0.1',
- LocalPort => $port,
- Proto => 'tcp'
- );
- }
+sub generate_port { Mojo::IOLoop::Server->generate_port }
- return;
+sub handle {
+ my ($self, $id) = @_;
+ return unless my $c = $self->{connections}->{$id};
+ return unless my $stream = $c->{stream};
+ return $stream->handle;
}
sub is_running {
@@ -239,109 +165,75 @@ sub listen {
$self = $self->singleton unless ref $self;
my $args = ref $_[0] ? $_[0] : {@_};
- # No TLS support
- croak "IO::Socket::SSL 1.43 required for TLS support"
- if $args->{tls} && !TLS;
-
- # Look for reusable file descriptor
- my $file = $args->{file};
- my $port = $args->{port} || 3000;
- my $reuse = defined $file ? $file : $port;
- $ENV{MOJO_REUSE} ||= '';
- my $fd;
- if ($ENV{MOJO_REUSE} =~ /(?:^|\,)$reuse\:(\d+)/) { $fd = $1 }
-
- # Stop listening so the new socket has a chance to join
- $self->_not_listening;
-
- # Allow file descriptor inheritance
- local $^F = 1000;
+ # New server
+ my $server = $self->server_class->new;
+ (my $id) = "$server" =~ /0x([\da-f]+)/;
+ $self->{servers}->{$id} = $server;
+ $server->iowatcher($self->iowatcher);
+ weaken $server->{iowatcher};
+
+ # Events
+ my $accept = delete $args->{on_accept};
+ my $close = delete $args->{on_close};
+ my $error = delete $args->{on_error};
+ my $read = delete $args->{on_read};
+ weaken $self;
+ $server->on(
+ accept => sub {
+ my $handle = pop;
+
+ # New stream
+ my $stream = $self->stream_class->new($handle);
+ (my $id) = "$stream" =~ /0x([\da-f]+)/;
+ my $c = $self->{connections}->{$id} ||= {};
+ $c->{stream} = $stream;
+ $stream->iowatcher($self->iowatcher);
+ weaken $stream->{iowatcher};
+
+ # Events
+ $c->{close} = $close;
+ $c->{error} = $error;
+ $c->{read} = $read;
+ $stream->on(
+ close => sub {
+ my $c = delete $self->{connections}->{$id};
+ $c->{close}->($self, $id) if $c->{close};
+ }
+ );
+ $stream->on(
+ error => sub {
+ my $c = delete $self->{connections}->{$id};
+ $c->{error}->($self, $id, pop) if $c->{error};
+ }
+ );
+ $stream->on(
+ read => sub {
+ my $c = $self->{connections}->{$id};
+ $c->{active} = time;
+ $c->{read}->($self, $id, pop) if $c->{read};
+ }
+ );
- # Listen on UNIX domain socket
- my $handle;
- my %options = (
- Listen => $args->{backlog} || SOMAXCONN,
- Proto => 'tcp',
- Type => SOCK_STREAM,
- %{$args->{args} || {}}
+ # Accept and enforce limit
+ $stream->resume;
+ $accept->($self, $id) if $accept;
+ $self->max_connections(0)
+ if defined $self->{accepts} && --$self->{accepts} == 0;
+ $self->_not_listening;
+ }
);
- if (defined $file) {
- $options{Local} = $file;
- $handle =
- defined $fd
- ? IO::Socket::UNIX->new
- : IO::Socket::UNIX->new(%options)
- or croak "Can't create listen socket: $!";
- }
-
- # Listen on TCP port
- else {
- $options{LocalAddr} = $args->{address} || '0.0.0.0';
- $options{LocalPort} = $port;
- $options{Proto} = 'tcp';
- $options{ReuseAddr} = 1;
- $options{LocalAddr} =~ s/[\[\]]//g;
- my $class = IPV6 ? 'IO::Socket::IP' : 'IO::Socket::INET';
- $handle = defined $fd ? $class->new : $class->new(%options)
- or croak "Can't create listen socket: $!";
- }
- # Reuse file descriptor
- if (defined $fd) {
- $handle->fdopen($fd, 'r')
- or croak "Can't open file descriptor $fd: $!";
- }
- else {
- $fd = fileno $handle;
- $reuse = ",$reuse" if length $ENV{MOJO_REUSE};
- $ENV{MOJO_REUSE} .= "$reuse:$fd";
- }
-
- # New connection
- my $c = {
- file => $args->{file} ? 1 : 0,
- on_accept => $args->{on_accept},
- on_close => $args->{on_close},
- on_error => $args->{on_error},
- on_read => $args->{on_read},
- };
- (my $id) = "$c" =~ /0x([\da-f]+)/;
- $self->{listen}->{$id} = $c;
- $c->{handle} = $handle;
- $self->{reverse}->{$handle} = $id;
-
- # TLS
- if ($args->{tls}) {
- my %options = (
- SSL_startHandshake => 0,
- SSL_cert_file => $args->{tls_cert} || $self->_cert_file,
- SSL_key_file => $args->{tls_key} || $self->_key_file,
- );
- %options = (
- SSL_verify_callback => $args->{tls_verify},
- SSL_ca_file => -T $args->{tls_ca} ? $args->{tls_ca} : undef,
- SSL_ca_path => -d $args->{tls_ca} ? $args->{tls_ca} : undef,
- SSL_verify_mode => $args->{tls_ca} ? 0x03 : undef,
- %options
- ) if $args->{tls_ca};
- $c->{tls} = {%options, %{$args->{tls_args} || {}}};
- }
-
- # Accept limit
+ # Listen
+ $server->listen($args);
$self->{accepts} = $self->max_accepts if $self->max_accepts;
+ $self->_not_listening;
return $id;
}
sub local_info {
my ($self, $id) = @_;
-
- # UNIX domain socket info
- return {} unless my $c = $self->{cs}->{$id};
- return {} unless my $handle = $c->{handle};
- return {path => $handle->hostpath} if $handle->can('hostpath');
-
- # TCP socket info
+ return {} unless my $handle = $self->handle($id);
return {address => $handle->sockhost, port => $handle->sockport};
}
@@ -349,34 +241,26 @@ sub on_close { shift->_event(close => @_) }
sub on_error { shift->_event(error => @_) }
sub on_read { shift->_event(read => @_) }
-sub recurring {
- my ($self, $after, $cb) = @_;
- $self = $self->singleton unless ref $self;
- weaken $self;
- return $self->iowatcher->recurring($after => sub { $self->$cb(pop) });
-}
-
sub one_tick {
my ($self, $timeout) = @_;
$timeout = $self->timeout unless defined $timeout;
# Housekeeping
$self->_listening;
- my $connections = $self->{cs} ||= {};
+ my $connections = $self->{connections} ||= {};
while (my ($id, $c) = each %$connections) {
# Connection needs to be finished
- if ($c->{finish} && !length $c->{buffer} && !$c->{drain}) {
+ if ($c->{finish} && (!$c->{stream} || $c->{stream}->is_finished)) {
$self->_drop($id);
next;
}
- # Read only
- $self->_not_writing($id) if delete $c->{read_only};
-
# Connection timeout
my $time = $c->{active} ||= time;
- $self->_drop($id) if (time - $time) >= ($c->{timeout} || 15);
+ $c->{timeout} = 15 unless defined $c->{timeout};
+ next unless my $timeout = $c->{timeout};
+ $self->_drop($id) if (time - $time) >= $timeout;
}
# Graceful shutdown
@@ -386,21 +270,16 @@ sub one_tick {
$self->iowatcher->one_tick($timeout);
}
-sub handle {
- my ($self, $id) = @_;
- return unless my $c = $self->{cs}->{$id};
- return $c->{handle};
+sub recurring {
+ my ($self, $after, $cb) = @_;
+ $self = $self->singleton unless ref $self;
+ weaken $self;
+ return $self->iowatcher->recurring($after => sub { $self->$cb(pop) });
}
sub remote_info {
my ($self, $id) = @_;
-
- # UNIX domain socket info
- return {} unless my $c = $self->{cs}->{$id};
- return {} unless my $handle = $c->{handle};
- return {path => $handle->peerpath} if $handle->can('peerpath');
-
- # TCP socket info
+ return {} unless my $handle = $self->handle($id);
return {address => $handle->peerhost, port => $handle->peerport};
}
@@ -425,43 +304,12 @@ sub start_tls {
my $id = shift;
my $args = ref $_[0] ? $_[0] : {@_};
- # No TLS support
- unless (TLS) {
- $self->_error($id, 'IO::Socket::SSL 1.43 required for TLS support.');
- return;
- }
-
- # Cleanup
- $self->drop($id) and return unless my $c = $self->{cs}->{$id};
- $self->drop($id) and return unless my $handle = $c->{handle};
- delete $self->{reverse}->{$handle};
- my $watcher = $self->iowatcher->remove($handle);
-
- # TLS upgrade
- weaken $self;
- my %options = (
- SSL_startHandshake => 0,
- SSL_error_trap => sub { $self->_error($id, $_[1]) },
- SSL_cert_file => $args->{tls_cert},
- SSL_key_file => $args->{tls_key},
- SSL_verify_mode => 0x00,
- SSL_create_ctx_callback =>
- sub { Net::SSLeay::CTX_sess_set_cache_size(shift, 128) },
- Timeout => $self->connect_timeout,
- %{$args->{tls_args} || {}}
- );
- $self->drop($id) and return
- unless my $new = IO::Socket::SSL->start_SSL($handle, %options);
- $c->{handle} = $new;
- $self->{reverse}->{$new} = $id;
- $c->{tls_connect} = 1;
- $watcher->add(
- $new,
- on_readable => sub { $self->_read($id) },
- on_writable => sub { $self->_write($id) }
- )->writing($new);
-
- return $id;
+ # Steal handle and upgrade to TLS
+ my $stream = delete $self->{connections}->{$id}->{stream};
+ $args->{handle} = $stream->steal_handle;
+ $args->{id} = $id;
+ $args->{tls} = 1;
+ $self->connect($args);
}
sub stop {
@@ -472,9 +320,9 @@ sub stop {
sub test {
my ($self, $id) = @_;
- return unless my $c = $self->{cs}->{$id};
- return unless my $handle = $c->{handle};
- return $self->iowatcher->is_readable($handle);
+ return unless my $c = $self->{connections}->{$id};
+ return unless my $stream = $c->{stream};
+ return $self->iowatcher->is_readable($stream->handle);
}
sub timer {
@@ -487,410 +335,64 @@ sub timer {
sub write {
my ($self, $id, $chunk, $cb) = @_;
- # Prepare chunk for writing
- my $c = $self->{cs}->{$id};
- $c->{buffer} .= $chunk;
-
- # UNIX only quick write
- unless (WINDOWS) {
- $c->{drain} = 0 if $cb;
- $self->_write($id);
- }
-
- # Write with roundtrip
- $c->{drain} = $cb if $cb;
- $self->_writing($id) if $cb || length $c->{buffer};
-}
-
-sub _accept {
- my ($self, $listen) = @_;
-
- # Accept
- my $handle = $listen->accept or return;
- my $r = $self->{reverse};
- my $l = $self->{listen}->{$r->{$listen}};
-
- # New connection
- my $c = {buffer => ''};
- (my $id) = "$c" =~ /0x([\da-f]+)/;
- $self->{cs}->{$id} = $c;
-
- # TLS handshake
- weaken $self;
- if (my $tls = $l->{tls}) {
- $tls->{SSL_error_trap} = sub { $self->_error($id, $_[1]) };
- $handle = IO::Socket::SSL->start_SSL($handle, %$tls);
- $c->{tls_accept} = 1;
- }
-
- # Start watching for events
- $self->iowatcher->add(
- $handle,
- on_readable => sub { $self->_read($id) },
- on_writable => sub { $self->_write($id) }
- );
- $c->{handle} = $handle;
- $r->{$handle} = $id;
-
- # Non-blocking
- $handle->blocking(0);
-
- # Disable Nagle's algorithm
- setsockopt($handle, IPPROTO_TCP, TCP_NODELAY, 1) unless $l->{file};
-
- # Register callbacks
- for my $name (qw/on_close on_error on_read/) {
- my $cb = $l->{$name};
- $self->$name($id => $cb) if $cb;
- }
-
- # Accept limit
- $self->max_connections(0)
- if defined $self->{accepts} && --$self->{accepts} == 0;
-
- # Accept callback
- warn "ACCEPTED $id\n" if DEBUG;
- if ((my $cb = $c->{on_accept} = $l->{on_accept}) && !$l->{tls}) {
- $self->_sandbox('accept', $cb, $id);
- }
-
- # Stop listening
- $self->_not_listening;
-}
-
-sub _cert_file {
- my $self = shift;
-
- # Check if temporary TLS cert file already exists
- my $cert = $self->{cert};
- return $cert if $cert && -r $cert;
-
- # Create temporary TLS cert file
- $cert = File::Spec->catfile($ENV{MOJO_TMPDIR} || File::Spec->tmpdir,
- 'mojocert.pem');
- croak qq/Can't create temporary TLS cert file "$cert"/
- unless my $file = IO::File->new("> $cert");
- print $file CERT;
-
- $self->{cert} = $cert;
-}
-
-sub _connect {
- my ($self, $id, $args) = @_;
-
- # New handle
- my $handle;
- return unless my $c = $self->{cs}->{$id};
- unless ($handle = $args->{handle}) {
-
- # New socket
- my %options = (
- Blocking => 0,
- PeerAddr => $args->{address},
- PeerPort => $args->{port} || ($args->{tls} ? 443 : 80),
- Proto => $args->{proto},
- Type => $args->{proto} eq 'udp' ? SOCK_DGRAM : SOCK_STREAM,
- %{$args->{args} || {}}
- );
- $options{PeerAddr} =~ s/[\[\]]//g if $options{PeerAddr};
- my $class = IPV6 ? 'IO::Socket::IP' : 'IO::Socket::INET';
- return $self->_error($id, "Couldn't connect.")
- unless $handle = $class->new(%options);
-
- # Timer
- $c->{connect_timer} =
- $self->timer($self->connect_timeout,
- sub { shift->_error($id, 'Connect timeout.') });
-
- # IPv6 needs an early start
- $handle->connect if IPV6;
+ # Write right away
+ my $c = $self->{connections}->{$id};
+ $c->{active} = time;
+ if (my $stream = $c->{stream}) {
+ return $stream->write($chunk) unless $cb;
+ weaken $self;
+ return $stream->write($chunk, sub { $self->$cb($id) });
}
- $c->{handle} = $handle;
- $self->{reverse}->{$handle} = $id;
-
- # Non-blocking
- $handle->blocking(0);
- # Start writing right away
- $self->iowatcher->add(
- $handle,
- on_readable => sub { $self->_read($id) },
- on_writable => sub { $self->_write($id) }
- )->writing($handle);
-
- # Start TLS
- if ($args->{tls}) { $self->start_tls($id => $args) }
+ # Delayed write
+ $c->{write} ||= [];
+ push @{$c->{write}}, [$chunk, $cb];
}
sub _drop {
my ($self, $id) = @_;
-
- # Cancel timer
return $self unless my $watcher = $self->iowatcher;
return $self if $watcher->cancel($id);
-
- # Drop listen socket
- my $c = $self->{cs}->{$id};
- if ($c) { return if $c->{drop}++ }
- elsif ($c = delete $self->{listen}->{$id}) {
- return $self unless $self->{listening};
- delete $self->{listening};
- }
-
- # Delete associated timers
- if (my $t = $c->{connect_timer} || $c->{accept_timer}) { $self->_drop($t) }
-
- # Drop handle
- if (my $handle = $c->{handle}) {
- warn "DISCONNECTED $id\n" if DEBUG;
-
- # Handle close
- if (my $cb = $c->{close}) { $self->_sandbox('close', $cb, $id) }
-
- # Cleanup
- delete $self->{cs}->{$id};
- delete $self->{reverse}->{$handle};
- $watcher->remove($handle);
- close $handle;
- }
-
+ if (delete $self->{servers}->{$id}) { delete $self->{listening} }
+ else { delete((delete($self->{connections}->{$id}) || {})->{stream}) }
return $self;
}
-sub _error {
- my ($self, $id, $error) = @_;
- $error ||= 'Unknown error, probably harmless.';
- warn qq/ERROR $id "$error"\n/ if DEBUG;
-
- # Handle error
- return unless my $c = $self->{cs}->{$id};
- if (my $cb = $c->{error}) { $self->_sandbox('error', $cb, $id, $error) }
- else { warn "Unhandled event error: $error" and return }
- $self->_drop($id);
-}
-
sub _event {
my ($self, $event, $id, $cb) = @_;
- return unless my $c = $self->{cs}->{$id};
+ return unless my $c = $self->{connections}->{$id};
$c->{$event} = $cb if $cb;
return $self;
}
-sub _key_file {
- my $self = shift;
-
- # Check if temporary TLS key file already exists
- my $key = $self->{key};
- return $key if $key && -r $key;
-
- # Create temporary TLS key file
- $key = File::Spec->catfile($ENV{MOJO_TMPDIR} || File::Spec->tmpdir,
- 'mojokey.pem');
- croak qq/Can't create temporary TLS key file "$key"/
- unless my $file = IO::File->new("> $key");
- print $file KEY;
-
- $self->{key} = $key;
-}
-
sub _listening {
my $self = shift;
- # Already listening or no listen sockets
+ # Check if we should be listening
return if $self->{listening};
- my $listen = $self->{listen} ||= {};
- return unless keys %$listen;
-
- # Check if we are allowed to listen and lock
- my $i = keys %{$self->{cs}};
+ my $servers = $self->{servers} ||= {};
+ return unless keys %$servers;
+ my $i = keys %{$self->{connections}};
return unless $i < $self->max_connections;
return unless $self->on_lock->($self, !$i);
- # Listen
- weaken $self;
- my $watcher = $self->iowatcher;
- for my $lid (keys %$listen) {
- $watcher->add($listen->{$lid}->{handle},
- on_readable => sub { $self->_accept(pop) });
- }
+ # Start listening
+ $_->resume for values %$servers;
$self->{listening} = 1;
}
sub _not_listening {
my $self = shift;
- # Check if we are listening and unlock
+ # Check if we are listening
return unless delete $self->{listening};
$self->on_unlock->($self);
# Stop listening
- my $listen = $self->{listen} || {};
- $self->iowatcher->remove($listen->{$_}->{handle}) for keys %$listen;
+ $_->pause for values %{$self->{servers} || {}};
delete $self->{listening};
}
-sub _not_writing {
- my ($self, $id) = @_;
- return unless my $c = $self->{cs}->{$id};
- return $c->{read_only} = 1 if length $c->{buffer} || $c->{drain};
- return unless my $handle = $c->{handle};
- $self->iowatcher->not_writing($handle);
-}
-
-sub _read {
- my ($self, $id) = @_;
-
- # Check if everything is ready to read
- my $c = $self->{cs}->{$id};
- return $self->_tls_accept($id) if $c->{tls_accept};
- return $self->_tls_connect($id) if $c->{tls_connect};
- return unless defined(my $handle = $c->{handle});
-
- # Read
- my $read = $handle->sysread(my $buffer, CHUNK_SIZE, 0);
-
- # Error
- unless (defined $read) {
-
- # Retry
- return if $! == EAGAIN || $! == EINTR || $! == EWOULDBLOCK;
-
- # Connection reset
- return $self->_drop($id) if $! == ECONNRESET;
-
- # Read error
- return $self->_error($id, $!);
- }
-
- # EOF
- return $self->_drop($id) if $read == 0;
-
- # Handle read
- if (my $cb = $c->{read}) { $self->_sandbox('read', $cb, $id, $buffer) }
-
- # Active
- $c->{active} = time;
-}
-
-sub _sandbox {
- my $self = shift;
- my $event = shift;
- my $cb = shift;
- my $id = shift;
-
- # Sandbox event
- unless (eval { $self->$cb($id, @_); 1 }) {
- my $message = qq/Event "$event" failed for connection "$id": $@/;
- $event eq 'error'
- ? ($self->_drop($id) and warn $message)
- : $self->_error($id, $message);
- }
-}
-
-sub _tls_accept {
- my ($self, $id) = @_;
-
- # Accepted
- my $c = $self->{cs}->{$id};
- if ($c->{handle}->accept_SSL) {
-
- # Handle TLS accept
- delete $c->{tls_accept};
- if (my $cb = $c->{on_accept}) { $self->_sandbox('accept', $cb, $id) }
- return;
- }
-
- # Switch between reading and writing
- $self->_tls_error($id);
-}
-
-sub _tls_connect {
- my ($self, $id) = @_;
-
- # Connected
- my $c = $self->{cs}->{$id};
- if ($c->{handle}->connect_SSL) {
-
- # Handle TLS connect
- delete $c->{tls_connect};
- if (my $cb = $c->{on_connect}) { $self->_sandbox('connect', $cb, $id) }
- return;
- }
-
- # Switch between reading and writing
- $self->_tls_error($id);
-}
-
-sub _tls_error {
- my ($self, $id) = @_;
- my $error = $IO::Socket::SSL::SSL_ERROR;
- if ($error == TLS_READ) { $self->_not_writing($id) }
- elsif ($error == TLS_WRITE) { $self->_writing($id) }
-}
-
-sub _write {
- my ($self, $id) = @_;
-
- # Check if we are ready for writing
- my $c = $self->{cs}->{$id};
- return $self->_tls_accept($id) if $c->{tls_accept};
- return $self->_tls_connect($id) if $c->{tls_connect};
- return unless my $handle = $c->{handle};
-
- # Connected
- if ($c->{connecting}) {
- delete $c->{connecting};
- my $timer = delete $c->{connect_timer};
- $self->_drop($timer) if $timer;
-
- # Disable Nagle's algorithm
- setsockopt $handle, IPPROTO_TCP, TCP_NODELAY, 1;
-
- # Handle connect
- warn "CONNECTED $id\n" if DEBUG;
- if (!$c->{tls} && (my $cb = $c->{on_connect})) {
- $self->_sandbox('connect', $cb, $id);
- }
- }
-
- # Handle drain
- if (!length $c->{buffer} && (my $cb = delete $c->{drain})) {
- $self->_sandbox('drain', $cb, $id);
- }
-
- # Write as much as possible
- if (length $c->{buffer}) {
- my $written = $handle->syswrite($c->{buffer});
-
- # Error
- unless (defined $written) {
-
- # Retry
- return if $! == EAGAIN || $! == EINTR || $! == EWOULDBLOCK;
-
- # Write error
- return $self->_error($id, $!);
- }
-
- # Remove written chunk from buffer
- substr $c->{buffer}, 0, $written, '';
-
- # Active
- $c->{active} = time;
- }
-
- # Not writing
- $self->_not_writing($id) unless exists $c->{drain} || length $c->{buffer};
-}
-
-sub _writing {
- my ($self, $id) = @_;
- my $c = $self->{cs}->{$id};
- delete $c->{read_only};
- return unless my $handle = $c->{handle};
- $self->iowatcher->writing($handle);
-}
-
1;
__END__
@@ -951,8 +453,8 @@ L<Mojo::IOLoop> is a very minimalistic reactor that has been reduced to the
absolute minimal feature set required to build solid and scalable async TCP
clients and servers.
-Optional modules L<IO::KQueue>, L<IO::Epoll>, L<IO::Socket::IP> and
-L<IO::Socket::SSL> are supported transparently and used if installed.
+Optional modules L<EV>, L<IO::Socket::IP> and L<IO::Socket::SSL> are
+supported transparently and used if installed.
A TLS certificate and key are also built right in to make writing test
servers as easy as possible.
@@ -961,20 +463,21 @@ servers as easy as possible.
L<Mojo::IOLoop> implements the following attributes.
-=head2 C<accept_timeout>
+=head2 C<client_class>
- my $timeout = $loop->accept_timeout;
- $loop = $loop->accept_timeout(5);
+ my $class = $loop->client_class;
+ $loop = $loop->client_class('Mojo::IOLoop::Client');
-Maximum time in seconds a connection can take to be accepted before being
-dropped, defaults to C<3>.
+Class to be used for performing non-blocking socket connections with the
+C<connect> method, defaults to L<Mojo::IOLoop::Client>.
+Note that this attribute is EXPERIMENTAL and might change without warning!
=head2 C<connect_timeout>
my $timeout = $loop->connect_timeout;
$loop = $loop->connect_timeout(5);
-Maximum time in seconds a conenction can take to be connected before being
+Maximum time in seconds a connection can take to be connected before being
dropped, defaults to C<3>.
=head2 C<iowatcher>
@@ -982,8 +485,8 @@ dropped, defaults to C<3>.
my $watcher = $loop->iowatcher;
$loop = $loop->iowatcher(Mojo::IOWatcher->new);
-Low level event watcher, usually a L<Mojo::IOWatcher>,
-L<Mojo::IOWatcher::KQueue> or L<Mojo::IOLoop::Epoll> object.
+Low level event watcher, usually a L<Mojo::IOWatcher> or
+L<Mojo::IOWatcher::EV> object.
Replacing the event watcher of the singleton loop makes all new loops use the
same type of event watcher.
Note that this attribute is EXPERIMENTAL and might change without warning!
@@ -1041,9 +544,26 @@ Note that exceptions in this callback are not captured.
=head2 C<resolver>
my $resolver = $loop->resolver;
- $loop = $loop->resolver(Mojo::Resolver->new);
+ $loop = $loop->resolver(Mojo::IOLoop::Resolver->new);
-DNS stub resolver, usually a L<Mojo::Resolver> object.
+DNS stub resolver, usually a L<Mojo::IOLoop::Resolver> object.
+Note that this attribute is EXPERIMENTAL and might change without warning!
+
+=head2 C<server_class>
+
+ my $class = $loop->server_class;
+ $loop = $loop->server_class('Mojo::IOLoop::Server');
+
+Class to be used for accepting incoming connections with the C<listen>
+method, defaults to L<Mojo::IOLoop::Server>.
+Note that this attribute is EXPERIMENTAL and might change without warning!
+
+=head2 C<stream_class>
+
+ my $class = $loop->stream_class;
+ $loop = $loop->stream_class('Mojo::IOLoop::Stream');
+
+Class to be used for streaming handles, defaults to L<Mojo::IOLoop::Stream>.
Note that this attribute is EXPERIMENTAL and might change without warning!
=head2 C<timeout>
@@ -1105,7 +625,7 @@ Callback to be invoked if the connection gets closed.
=item C<on_error>
-Callback to be invoked if an error event happens on the connection.
+Callback to be invoked if an error happens on the connection.
=item C<on_read>
@@ -1115,10 +635,6 @@ Callback to be invoked if new data arrives on the connection.
Port to connect to.
-=item C<proto>
-
-Protocol to use, defaults to C<tcp>.
-
=item C<tls>
Enable TLS.
@@ -1178,7 +694,6 @@ Check if loop is running.
my $id = Mojo::IOLoop->listen(port => 3000);
my $id = $loop->listen(port => 3000);
my $id = $loop->listen({port => 3000});
- my $id = $loop->listen(file => '/foo/myapp.sock');
my $id = $loop->listen(
port => 443,
tls => 1,
@@ -1202,10 +717,6 @@ Local address to listen on, defaults to all.
Maximum backlog size, defaults to C<SOMAXCONN>.
-=item C<file>
-
-A unix domain socket to listen on.
-
=item C<on_accept>
Callback to be invoked for each accepted connection.
@@ -1216,7 +727,7 @@ Callback to be invoked if the connection gets closed.
=item C<on_error>
-Callback to be invoked if an error event happens on the connection.
+Callback to be invoked if an error happens on the connection.
=item C<on_read>
@@ -1276,7 +787,7 @@ Callback to be invoked if the connection gets closed.
$loop = $loop->on_error($id => sub {...});
-Callback to be invoked if an error event happens on the connection.
+Callback to be invoked if an error happens on the connection.
=head2 C<on_read>
@@ -1357,7 +868,7 @@ if the loop is already running.
=head2 C<start_tls>
- my $id = $loop->start_tls($id);
+ $loop->start_tls($id);
Start new TLS connection inside old connection.
Note that TLS support depends on L<IO::Socket::SSL>.
@@ -0,0 +1,164 @@
+package Mojo::IOWatcher::EV;
+use Mojo::Base 'Mojo::IOWatcher';
+
+use EV;
+use Scalar::Util 'weaken';
+
+my $SINGLETON;
+
+sub DESTROY { undef $SINGLETON }
+
+# We have to fall back to Mojo::IOWatcher, since EV is unique
+sub new { $SINGLETON++ ? Mojo::IOWatcher->new : shift->SUPER::new }
+
+sub not_writing {
+ my ($self, $handle) = @_;
+
+ my $fd = fileno $handle;
+ my $h = $self->{handles}->{$fd};
+ my $w = $h->{watcher};
+ if ($w) { $w->set($fd, EV::READ) if delete $h->{writing} }
+ else {
+ weaken $self;
+ $h->{watcher} = EV::io($fd, EV::READ, sub { $self->_io($fd, @_) });
+ }
+
+ return $self;
+}
+
+# "Wow, Barney. You brought a whole beer keg.
+# Yeah... where do I fill it up?"
+sub one_tick {
+ my ($self, $timeout) = @_;
+ my $w = EV::timer($timeout, 0, sub { EV::unloop(EV::BREAK_ONE) });
+ EV::loop;
+ undef $w;
+}
+
+sub recurring { shift->_timer(shift, 1, @_) }
+
+sub remove {
+ my ($self, $handle) = @_;
+ delete $self->{handles}->{fileno $handle};
+ return $self;
+}
+
+sub timer { shift->_timer(shift, 0, @_) }
+
+sub writing {
+ my ($self, $handle) = @_;
+
+ my $fd = fileno $handle;
+ my $h = $self->{handles}->{$fd};
+ my $w = $h->{watcher};
+ if ($w) { $w->set($fd, EV::WRITE | EV::READ) }
+ else {
+ weaken $self;
+ $h->{watcher} =
+ EV::io($fd, EV::WRITE | EV::READ, sub { $self->_io($fd, @_) });
+ }
+ $h->{writing} = 1;
+
+ return $self;
+}
+
+sub _io {
+ my ($self, $fd, $w, $revents) = @_;
+ my $h = $self->{handles}->{$fd};
+ $self->_sandbox('Read', $h->{on_readable}, $h->{handle})
+ if EV::READ &$revents;
+ $self->_sandbox('Write', $h->{on_writable}, $h->{handle})
+ if EV::WRITE &$revents;
+}
+
+sub _timer {
+ my $self = shift;
+ my $after = shift || '0.0001';
+ my $recurring = shift;
+ my $cb = shift;
+
+ my $id = $self->SUPER::_timer($cb);
+ weaken $self;
+ $self->{timers}->{$id}->{watcher} = EV::timer(
+ $after,
+ $recurring ? $after : 0,
+ sub {
+ my $w = shift;
+ $self->_sandbox("Timer $id", $self->{timers}->{$id}->{cb}, $id);
+ delete $self->{timers}->{$id} unless $recurring;
+ }
+ );
+
+ return $id;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Mojo::IOWatcher::EV - EV Async I/O Watcher
+
+=head1 SYNOPSIS
+
+ use Mojo::IOWatcher::EV;
+
+=head1 DESCRIPTION
+
+L<Mojo::IOWatcher::EV> is a minimalistic async I/O watcher with C<libev>
+support.
+Note that this module is EXPERIMENTAL and might change without warning!
+
+=head1 METHODS
+
+L<Mojo::IOWatcher::EV> inherits all methods from L<Mojo::IOWatcher> and
+implements the following new ones.
+
+=head2 C<new>
+
+ my $watcher = Mojo::IOWatcher::EV->new;
+
+Construct a new L<Mojo::IOWatcher::EV> object.
+
+=head2 C<not_writing>
+
+ $watcher = $watcher->not_writing($handle);
+
+Only watch handle for readable events.
+
+=head2 C<one_tick>
+
+ $watcher->one_tick('0.25');
+
+Run for exactly one tick and watch for I/O and timer events.
+
+=head2 C<recurring>
+
+ my $id = $watcher->recurring(3 => sub {...});
+
+Create a new recurring timer, invoking the callback repeatedly after a given
+amount of seconds.
+
+=head2 C<remove>
+
+ $watcher = $watcher->remove($handle);
+
+Remove handle.
+
+=head2 C<timer>
+
+ my $id = $watcher->timer(3 => sub {...});
+
+Create a new timer, invoking the callback after a given amount of seconds.
+
+=head2 C<writing>
+
+ $watcher = $watcher->writing($handle);
+
+Watch handle for readable and writable events.
+
+=head1 SEE ALSO
+
+L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>.
+
+=cut
@@ -1,37 +0,0 @@
-package Mojo::IOWatcher::Epoll;
-use Mojo::Base 'Mojo::IOWatcher';
-
-use IO::Epoll 0.02 ':compat';
-use Time::HiRes 'usleep';
-
-# "And America has so many enemies.
-# Iran, Iraq, China, Mordor, the hoochies that laid low Tiger Woods,
-# undesirable immigrants - by which I mean everyone that came after me,
-# including my children..."
-sub _poll { shift->{poll} ||= IO::Epoll->new }
-
-1;
-__END__
-
-=head1 NAME
-
-Mojo::IOWatcher::Epoll - Epoll Async IO Watcher
-
-=head1 SYNOPSIS
-
- use Mojo::IOWatcher::Epoll;
-
-=head1 DESCRIPTION
-
-L<Mojo::IOWatcher> is a minimalistic async io watcher with C<epoll> support.
-Note that this module is EXPERIMENTAL and might change without warning!
-
-=head1 METHODS
-
-L<Mojo::IOWatcher::Epoll> inherits all methods from L<Mojo::IOWatcher>.
-
-=head1 SEE ALSO
-
-L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>.
-
-=cut
@@ -1,113 +0,0 @@
-package Mojo::IOWatcher::KQueue;
-use Mojo::Base 'Mojo::IOWatcher';
-
-use IO::KQueue 0.34;
-
-# "Wow, Barney. You brought a whole beer keg.
-# Yeah... where do I fill it up?"
-sub not_writing {
- my ($self, $handle) = @_;
-
- my $fd = fileno $handle;
- my $h = $self->{handles}->{$fd};
- my $kqueue = $self->_kqueue;
- $kqueue->EV_SET($fd, EVFILT_READ, EV_ADD)
- unless defined $h->{writing};
- $kqueue->EV_SET($fd, EVFILT_WRITE, EV_DELETE) if $h->{writing};
- $h->{writing} = 0;
-
- return $self;
-}
-
-sub remove {
- my ($self, $handle) = @_;
-
- my $fd = fileno $handle;
- my $h = delete $self->{handles}->{$fd};
- my $kqueue = $self->_kqueue;
- $kqueue->EV_SET($fd, EVFILT_READ, EV_DELETE) if defined $h->{writing};
- $kqueue->EV_SET($fd, EVFILT_WRITE, EV_DELETE) if $h->{writing};
-
- return $self;
-}
-
-sub watch {
- my ($self, $timeout) = @_;
-
- my @ret;
- eval { @ret = $self->_kqueue->kevent(1000 * $timeout) };
- for my $kev (@ret) {
- my ($fd, $filter, $flags, $fflags) = @$kev;
- my $h = $self->{handles}->{$fd};
- $self->_sandbox('Read', $h->{on_readable}, $h->{handle})
- if $filter == EVFILT_READ || $flags == EV_EOF;
- $self->_sandbox('Write', $h->{on_writable}, $h->{handle})
- if $filter == EVFILT_WRITE;
- }
-}
-
-sub writing {
- my ($self, $handle) = @_;
-
- my $fd = fileno $handle;
- my $h = $self->{handles}->{$fd};
- $self->_kqueue->EV_SET($fd, EVFILT_READ, EV_ADD)
- unless defined $h->{writing};
- $self->_kqueue->EV_SET($fd, EVFILT_WRITE, EV_ADD) unless $h->{writing};
- $h->{writing} = 1;
-
- return $self;
-}
-
-sub _kqueue { shift->{kqueue} ||= IO::KQueue->new }
-
-1;
-__END__
-
-=head1 NAME
-
-Mojo::IOWatcher::KQueue - KQueue Async IO Watcher
-
-=head1 SYNOPSIS
-
- use Mojo::IOWatcher::KQueue;
-
-=head1 DESCRIPTION
-
-L<Mojo::IOWatcher> is a minimalistic async io watcher with C<kqueue> support.
-Note that this module is EXPERIMENTAL and might change without warning!
-
-=head1 METHODS
-
-L<Mojo::IOWatcher::KQueue> inherits all methods from L<Mojo::IOWatcher> and
-implements the following new ones.
-
-=head2 C<not_writing>
-
- $watcher = $watcher->not_writing($handle);
-
-Only watch handle for readable events.
-
-=head2 C<remove>
-
- $watcher = $watcher->remove($handle);
-
-Remove handle.
-
-=head2 C<watch>
-
- $watcher->watch('0.25');
-
-Run for exactly one tick and watch only for io events.
-
-=head2 C<writing>
-
- $watcher = $watcher->writing($handle);
-
-Watch handle for readable and writable events.
-
-=head1 SEE ALSO
-
-L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>.
-
-=cut
@@ -30,6 +30,12 @@ sub cancel {
return;
}
+sub detect {
+ my $try = $ENV{MOJO_IOWATCHER} || 'Mojo::IOWatcher::EV';
+ return $try if eval "use $try; 1";
+ return 'Mojo::IOWatcher';
+}
+
sub is_readable {
my ($self, $handle) = @_;
@@ -50,7 +56,7 @@ sub not_writing {
my $poll = $self->_poll;
$poll->remove($handle)
if delete $self->{handles}->{fileno $handle}->{writing};
- $poll->mask($handle, $self->POLLIN);
+ $poll->mask($handle, POLLIN);
return $self;
}
@@ -59,8 +65,17 @@ sub not_writing {
sub one_tick {
my ($self, $timeout) = @_;
- # IO
- $self->watch($timeout);
+ # I/O
+ my $poll = $self->_poll;
+ $poll->poll($timeout);
+ my $handles = $self->{handles};
+ $self->_sandbox('Read', $handles->{fileno $_}->{on_readable}, $_)
+ for $poll->handles(POLLIN | POLLHUP | POLLERR);
+ $self->_sandbox('Write', $handles->{fileno $_}->{on_writable}, $_)
+ for $poll->handles(POLLOUT);
+
+ # Wait for timeout
+ usleep 1000000 * $timeout unless keys %{$self->{handles}};
# Timers
my $timers = $self->{timers} || {};
@@ -82,10 +97,7 @@ sub one_tick {
}
}
-sub recurring {
- my $self = shift;
- $self->_event(timers => pop, after => pop, recurring => time);
-}
+sub recurring { shift->_timer(pop, after => pop, recurring => time) }
sub remove {
my ($self, $handle) = @_;
@@ -96,48 +108,25 @@ sub remove {
# "Bart, how did you get a cellphone?
# The same way you got me, by accident on a golf course."
-sub timer {
- my $self = shift;
- $self->_event(timers => pop, after => pop, started => time);
-}
-
-sub watch {
- my ($self, $timeout) = @_;
-
- # Check for IO events
- my $poll = $self->_poll;
- $poll->poll($timeout);
- my $handles = $self->{handles};
- $self->_sandbox('Read', $handles->{fileno $_}->{on_readable}, $_)
- for $poll->handles($self->POLLIN | $self->POLLHUP | $self->POLLERR);
- $self->_sandbox('Write', $handles->{fileno $_}->{on_writable}, $_)
- for $poll->handles($self->POLLOUT);
-
- # Wait for timeout
- usleep 1000000 * $timeout unless keys %{$self->{handles}};
-}
+sub timer { shift->_timer(pop, after => pop, started => time) }
sub writing {
my ($self, $handle) = @_;
my $poll = $self->_poll;
$poll->remove($handle);
- $poll->mask($handle, $self->POLLIN | $self->POLLOUT);
+ $poll->mask($handle, POLLIN | POLLOUT);
$self->{handles}->{fileno $handle}->{writing} = 1;
return $self;
}
-sub _event {
+sub _timer {
my $self = shift;
- my $pool = shift;
my $cb = shift;
-
- # Events have an id for easy removal
- my $e = {cb => $cb, @_};
- (my $id) = "$e" =~ /0x([\da-f]+)/;
- $self->{$pool}->{$id} = $e;
-
+ my $t = {cb => $cb, @_};
+ (my $id) = "$t" =~ /0x([\da-f]+)/;
+ $self->{timers}->{$id} = $t;
return $id;
}
@@ -155,13 +144,13 @@ __END__
=head1 NAME
-Mojo::IOWatcher - Async IO Watcher
+Mojo::IOWatcher - Async I/O Watcher
=head1 SYNOPSIS
use Mojo::IOWatcher;
- # Watch if io handles become readable or writable
+ # Watch if I/O handles become readable or writable
my $watcher = Mojo::IOWatcher->new;
$watcher->add($handle, on_readable => sub {
my ($watcher, $handle) = @_;
@@ -180,10 +169,9 @@ Mojo::IOWatcher - Async IO Watcher
=head1 DESCRIPTION
-L<Mojo::IOWatcher> is a minimalistic async io watcher and the foundation of
+L<Mojo::IOWatcher> is a minimalistic async I/O watcher and the foundation of
L<Mojo::IOLoop>.
-L<Mojo::IOWatcher::KQueue> and L<Mojo::IOWatcher::Epoll> are good examples
-for its extensibility.
+L<Mojo::IOWatcher::EV> is a good example for its extensibility.
Note that this module is EXPERIMENTAL and might change without warning!
=head1 METHODS
@@ -195,7 +183,7 @@ following new ones.
$watcher = $watcher->add($handle, on_readable => sub {...});
-Add handles and watch for io events.
+Add handles and watch for I/O events.
These options are currently available:
@@ -217,6 +205,14 @@ Callback to be invoked once the handle becomes writable.
Cancel timer.
+=head2 C<detect>
+
+ my $class = Mojo::IOWatcher->detect;
+
+Detect and load the best watcher implementation available, will try the value
+of C<MOJO_IOWATCHER> or L<Mojo::IOWatcher::EV>.
+Note that this method is EXPERIMENTAL and might change without warning!
+
=head2 C<is_readable>
my $readable = $watcher->is_readable($handle);
@@ -234,7 +230,7 @@ Only watch handle for readable events.
$watcher->one_tick('0.25');
-Run for exactly one tick and watch for io and timer events.
+Run for exactly one tick and watch for I/O and timer events.
=head2 C<recurring>
@@ -255,12 +251,6 @@ Remove handle.
Create a new timer, invoking the callback after a given amount of seconds.
-=head2 C<watch>
-
- $watcher->watch('0.25');
-
-Run for exactly one tick and watch only for io events.
-
=head2 C<writing>
$watcher = $watcher->writing($handle);
@@ -63,7 +63,6 @@ sub search {
}
}
- return unless @$modules;
return $modules;
}
@@ -78,9 +77,14 @@ Mojo::Loader - Loader
use Mojo::Loader;
+ # Find modules in a namespace
my $loader = Mojo::Loader->new;
- my $modules = $loader->search('Some::Namespace');
- $loader->load($modules->[0]);
+ for my $module (@{$loader->search('Some::Namespace')}) {
+
+ # And load them safely
+ my $e = $loader->load($module);
+ warn qq/Loading "$module" failed: $e/ if ref $e;
+ }
=head1 DESCRIPTION
@@ -109,8 +113,6 @@ loaded.
Search for modules in a namespace non-recursively.
- $loader->load($_) for @{$loader->search('MyApp::Namespace')};
-
=head1 SEE ALSO
L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>.
@@ -1,391 +0,0 @@
-package Mojo::Resolver;
-use Mojo::Base -base;
-
-use List::Util 'first';
-use Mojo::IOLoop;
-use Mojo::URL;
-
-use constant DEBUG => $ENV{MOJO_RESOLVER_DEBUG} || 0;
-
-# "AF_INET6" requires Socket6 or Perl 5.12
-use constant IPV6_AF_INET6 => eval { Socket::AF_INET6() }
- || eval { require Socket6 and Socket6::AF_INET6() };
-
-# "inet_pton" requires Socket6 or Perl 5.12
-BEGIN {
-
- # Socket
- if (defined &Socket::inet_pton) { *inet_pton = \&Socket::inet_pton }
-
- # Socket6
- elsif (eval { require Socket6 and defined &Socket6::inet_pton }) {
- *inet_pton = \&Socket6::inet_pton;
- }
-}
-
-# IPv6 DNS support requires "AF_INET6" and "inet_pton"
-use constant IPV6 => defined IPV6_AF_INET6 && defined &inet_pton;
-
-has ioloop => sub { Mojo::IOLoop->new };
-has timeout => 3;
-
-# DNS server (default to Google Public DNS)
-my $SERVERS = ['8.8.8.8', '8.8.4.4'];
-
-# Try to detect DNS server
-if (-r '/etc/resolv.conf') {
- my $file = IO::File->new('< /etc/resolv.conf');
- my @servers;
- for my $line (<$file>) {
-
- # New DNS server
- if ($line =~ /^nameserver\s+(\S+)$/) {
- push @servers, $1;
- warn qq/DETECTED DNS SERVER ($1)\n/ if DEBUG;
- }
- }
- unshift @$SERVERS, @servers;
-}
-
-# User defined DNS server
-unshift @$SERVERS, $ENV{MOJO_DNS_SERVER} if $ENV{MOJO_DNS_SERVER};
-
-# Always start with first DNS server
-my $CURRENT_SERVER = 0;
-
-# DNS record types
-my $DNS_TYPES = {
- '*' => 0x00ff,
- A => 0x0001,
- AAAA => 0x001c,
- CNAME => 0x0005,
- MX => 0x000f,
- NS => 0x0002,
- PTR => 0x000c,
- TXT => 0x0010
-};
-
-# "localhost"
-our $LOCALHOST = '127.0.0.1';
-
-sub lookup {
- my ($self, $name, $cb) = @_;
-
- # "localhost"
- my $loop = $self->ioloop;
- return $loop->timer(0 => sub { shift->$cb($LOCALHOST) })
- if $name eq 'localhost';
-
- # IPv4
- $self->resolve(
- $name, 'A',
- sub {
- my ($self, $records) = @_;
-
- # Success
- my $result = first { $_->[0] eq 'A' } @$records;
- return $self->$cb($result->[1]) if $result;
-
- # IPv6
- $self->resolve(
- $name, 'AAAA',
- sub {
- my ($self, $records) = @_;
-
- # Success
- my $result = first { $_->[0] eq 'AAAA' } @$records;
- return $self->$cb($result->[1]) if $result;
-
- # Pass through
- $self->$cb();
- }
- );
- }
- );
-}
-
-# "I can't believe it! Reading and writing actually paid off!"
-sub resolve {
- my ($self, $name, $type, $cb) = @_;
-
- # No lookup required or record type not supported
- my $ipv4 = $name =~ $Mojo::URL::IPV4_RE ? 1 : 0;
- my $ipv6 = IPV6 && $name =~ $Mojo::URL::IPV6_RE ? 1 : 0;
- my $t = $DNS_TYPES->{$type};
- my $server = $self->servers;
- my $loop = $self->ioloop;
- if (!$server || !$t || ($t ne $DNS_TYPES->{PTR} && ($ipv4 || $ipv6))) {
- $loop->timer(0 => sub { $self->$cb([]) });
- return $self;
- }
-
- # Request
- warn "RESOLVE $type $name ($server)\n" if DEBUG;
- my $timer;
- my $tx = int rand 0x10000;
- my $id = $loop->connect(
- address => $server,
- port => 53,
- proto => 'udp',
- on_connect => sub {
- my ($loop, $id) = @_;
-
- # Header (one question with recursion)
- my $req = pack 'nnnnnn', $tx, 0x0100, 1, 0, 0, 0;
-
- # Reverse
- my @parts = split /\./, $name;
- if ($t eq $DNS_TYPES->{PTR}) {
-
- # IPv4
- if ($ipv4) { @parts = reverse 'arpa', 'in-addr', @parts }
-
- # IPv6
- elsif ($ipv6) {
- @parts = reverse 'arpa', 'ip6', split //, unpack 'H32',
- inet_pton(IPV6_AF_INET6, $name);
- }
- }
-
- # Query (Internet)
- for my $part (@parts) {
- $req .= pack 'C/a*', $part if defined $part;
- }
- $req .= pack 'Cnn', 0, $t, 0x0001;
- $loop->write($id => $req);
- },
- on_error => sub {
- my ($loop, $id) = @_;
- warn "FAILED $type $name ($server)\n" if DEBUG;
- $CURRENT_SERVER++;
- $loop->drop($timer) if $timer;
- $self->$cb([]);
- },
- on_read => sub {
- my ($loop, $id, $chunk) = @_;
-
- # Cleanup
- $loop->drop($id);
- $loop->drop($timer) if $timer;
-
- # Check answers
- my @packet = unpack 'nnnnnna*', $chunk;
- warn "ANSWERS $packet[3] ($server)\n" if DEBUG;
- return $self->$cb([]) unless $packet[0] eq $tx;
-
- # Questions
- my $content = $packet[6];
- for (1 .. $packet[2]) {
- my $n;
- do { ($n, $content) = unpack 'C/aa*', $content } while ($n ne '');
- $content = (unpack 'nna*', $content)[2];
- }
-
- # Answers
- my @answers;
- for (1 .. $packet[3]) {
-
- # Parse
- (my ($t, $ttl, $a), $content) =
- (unpack 'nnnNn/aa*', $content)[1, 3, 4, 5];
- my @answer = _parse_answer($t, $a, $chunk, $content);
-
- # No answer
- next unless @answer;
-
- # Answer
- push @answers, [@answer, $ttl];
- warn "ANSWER $answer[0] $answer[1]\n" if DEBUG;
- }
- $self->$cb(\@answers);
- }
- );
-
- # Timer
- $timer = $loop->timer(
- $self->timeout => sub {
- my $loop = shift;
- warn "RESOLVE TIMEOUT ($server)\n" if DEBUG;
-
- # Abort
- $CURRENT_SERVER++;
- $loop->drop($id);
- $self->$cb([]);
- }
- );
-
- return $self;
-}
-
-# "I wonder where Bart is, his dinner's getting all cold... and eaten."
-sub servers {
- my $self = shift;
-
- # New servers
- if (@_) {
- @$SERVERS = @_;
- $CURRENT_SERVER = 0;
- return $self;
- }
-
- # List all
- return @$SERVERS if wantarray;
-
- # Current server
- $CURRENT_SERVER = 0 unless $SERVERS->[$CURRENT_SERVER];
- return $SERVERS->[$CURRENT_SERVER];
-}
-
-# Answer helper for "resolve"
-sub _parse_answer {
- my ($t, $a, $packet, $rest) = @_;
-
- # A
- if ($t eq $DNS_TYPES->{A}) { return A => join('.', unpack 'C4', $a) }
-
- # AAAA
- elsif ($t eq $DNS_TYPES->{AAAA}) {
- return AAAA => sprintf('%x:%x:%x:%x:%x:%x:%x:%x', unpack('n*', $a));
- }
-
- # TXT
- elsif ($t eq $DNS_TYPES->{TXT}) { return TXT => unpack('(C/a*)*', $a) }
-
- # Offset
- my $offset = length($packet) - length($rest) - length($a);
-
- # CNAME
- my $type;
- if ($t eq $DNS_TYPES->{CNAME}) { $type = 'CNAME' }
-
- # MX
- elsif ($t eq $DNS_TYPES->{MX}) {
- $type = 'MX';
- $offset += 2;
- }
-
- # NS
- elsif ($t eq $DNS_TYPES->{NS}) { $type = 'NS' }
-
- # PTR
- elsif ($t eq $DNS_TYPES->{PTR}) { $type = 'PTR' }
-
- # Domain name
- return $type => _parse_name($packet, $offset) if $type;
-
- # Not supported
- return;
-}
-
-# Domain name helper for "resolve"
-sub _parse_name {
- my ($packet, $offset) = @_;
-
- # Elements
- my @elements;
- for (1 .. 128) {
-
- # Element length
- my $len = ord substr $packet, $offset++, 1;
-
- # Offset
- if ($len >= 0xc0) {
- $offset = (unpack 'n', substr $packet, ++$offset - 2, 2) & 0x3fff;
- }
-
- # Element
- elsif ($len) {
- push @elements, substr $packet, $offset, $len;
- $offset += $len;
- }
-
- # Zero length element (the end)
- else { return join '.', @elements }
- }
-
- return;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Mojo::Resolver - Async IO DNS Resolver
-
-=head1 SYNOPSIS
-
- use Mojo::Resolver;
-
-=head1 DESCRIPTION
-
-L<Mojo::Resolver> is a minimalistic async io stub resolver.
-Note that this module is EXPERIMENTAL and might change without warning!
-
-=head1 ATTRIBUTES
-
-L<Mojo::Resolver> implements the following attributes.
-
-=head2 C<ioloop>
-
- my $ioloop = $resolver->ioloop;
- $resolver = $resolver->ioloop(Mojo::IOLoop->new);
-
-Loop object to use for io operations, by default a L<Mojo::IOLoop> object
-will be used.
-
-=head2 C<timeout>
-
- my $timeout = $resolver->timeout;
- $resolver = $resolver->timeout(5);
-
-Maximum time in seconds a C<DNS> lookup can take, defaults to C<3>.
-
-=head1 METHODS
-
-L<Mojo::Resolver> inherits all methods from L<Mojo::Base> and implements the
-following new ones.
-
-=head2 C<servers>
-
- my @all = $resolver->servers;
- my $current = $resolver->servers;
- $resolver = $resolver->servers('8.8.8.8', '8.8.4.4');
-
-IP addresses of C<DNS> servers used for lookups, defaults to the value of
-C<MOJO_DNS_SERVER>, auto detection, C<8.8.8.8> or C<8.8.4.4>.
-
-=head2 C<lookup>
-
- $resolver = $resolver->lookup('mojolicio.us' => sub {...});
-
-Lookup C<IPv4> or C<IPv6> address for domain.
-
- $resolver->lookup('mojolicio.us' => sub {
- my ($loop, $address) = @_;
- print "Address: $address\n";
- Mojo::IOLoop->stop;
- });
- Mojo::IOLoop->start;
-
-=head2 C<resolve>
-
- $resolver = $resolver->resolve('mojolicio.us', 'A', sub {...});
-
-Resolve domain into C<A>, C<AAAA>, C<CNAME>, C<MX>, C<NS>, C<PTR> or C<TXT>
-records, C<*> will query for all at once.
-Since this is a "stub resolver" it depends on a recursive name server for DNS
-resolution.
-
-=head1 DEBUGGING
-
-You can set the C<MOJO_RESOLVER_DEBUG> environment variable to get some
-advanced diagnostics information printed to C<STDERR>.
-
- MOJO_RESOLVER_DEBUG=1
-
-=head1 SEE ALSO
-
-L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>.
-
-=cut
@@ -234,23 +234,16 @@ sub _listen {
my ($self, $listen) = @_;
return unless $listen;
- # UNIX domain socket
+ # Check listen value
+ croak qq/Invalid listen value "$listen"/ unless $listen =~ $SOCKET_RE;
my $options = {};
my $tls;
- if ($listen =~ /^file\:\/\/(.+)$/) { unlink $options->{file} = $1 }
-
- # Internet socket
- elsif ($listen =~ $SOCKET_RE) {
- $tls = $options->{tls} = 1 if $1 eq 'https';
- $options->{address} = $2 if $2 ne '*';
- $options->{port} = $3;
- $options->{tls_cert} = $4 if $4;
- $options->{tls_key} = $5 if $5;
- $options->{tls_ca} = $6 if $6;
- }
-
- # Invalid
- else { croak qq/Invalid listen value "$listen"/ }
+ $tls = $options->{tls} = 1 if $1 eq 'https';
+ $options->{address} = $2 if $2 ne '*';
+ $options->{port} = $3;
+ $options->{tls_cert} = $4 if $4;
+ $options->{tls_key} = $5 if $5;
+ $options->{tls_ca} = $6 if $6;
# Listen backlog size
my $backlog = $self->backlog;
@@ -368,7 +361,7 @@ __END__
=head1 NAME
-Mojo::Server::Daemon - Async IO HTTP 1.1 And WebSocket Server
+Mojo::Server::Daemon - Async I/O HTTP 1.1 And WebSocket Server
=head1 SYNOPSIS
@@ -394,12 +387,12 @@ Mojo::Server::Daemon - Async IO HTTP 1.1 And WebSocket Server
=head1 DESCRIPTION
-L<Mojo::Server::Daemon> is a full featured async io HTTP 1.1 and WebSocket
-server with C<IPv6>, C<TLS>, C<Bonjour>, C<epoll> and C<kqueue> support.
+L<Mojo::Server::Daemon> is a full featured async I/O HTTP 1.1 and WebSocket
+server with C<IPv6>, C<TLS>, C<Bonjour> and C<libev> support.
-Optional modules L<IO::KQueue>, L<IO::Epoll>, L<IO::Socket::IP>,
-L<IO::Socket::SSL> and L<Net::Rendezvous::Publish> are supported
-transparently and used if installed.
+Optional modules L<EV>, L<IO::Socket::IP>, L<IO::Socket::SSL> and
+L<Net::Rendezvous::Publish> are supported transparently and used if
+installed.
See L<Mojolicious::Guides::Cookbook> for deployment recipes.
@@ -427,7 +420,7 @@ Group for server process.
my $loop = $daemon->ioloop;
$daemon = $daemon->ioloop(Mojo::IOLoop->new);
-Event loop for server IO, defaults to the global L<Mojo::IOLoop> singleton.
+Event loop for server I/O, defaults to the global L<Mojo::IOLoop> singleton.
=head2 C<keep_alive_timeout>
@@ -442,7 +435,7 @@ dropped, defaults to C<5>.
my $listen = $daemon->listen;
$daemon = $daemon->listen(['https://localhost:3000']);
-List of ports and files to listen on, defaults to C<http://*:3000>.
+List of one or more locations to listen on, defaults to C<http://*:3000>.
# Listen on two ports with HTTP and HTTPS at the same time
$daemon->listen(['http://*:3000', 'https://*:4000']);
@@ -417,8 +417,8 @@ Mojo::Server::Hypnotoad - ALL GLORY TO THE HYPNOTOAD!
L<Mojo::Server::Hypnotoad> is a full featured UNIX optimized preforking async
io HTTP 1.1 and WebSocket server built around the very well tested and
-reliable L<Mojo::Server::Daemon> with C<IPv6>, C<TLS>, C<Bonjour>, C<epoll>,
-C<kqueue> and hot deployment support that just works.
+reliable L<Mojo::Server::Daemon> with C<IPv6>, C<TLS>, C<Bonjour>, C<libev>
+and hot deployment support that just works.
To start applications with it you can use the L<hypnotoad> script.
@@ -433,9 +433,9 @@ You can run the exact same command again for automatic hot deployment.
For L<Mojolicious> and L<Mojolicious::Lite> applications it will default to
C<production> mode.
-Optional modules L<IO::KQueue>, L<IO::Epoll>, L<IO::Socket::IP>,
-L<IO::Socket::SSL> and L<Net::Rendezvous::Publish> are supported
-transparently and used if installed.
+Optional modules L<EV>, L<IO::Socket::IP>, L<IO::Socket::SSL> and
+L<Net::Rendezvous::Publish> are supported transparently and used if
+installed.
See L<Mojolicious::Guides::Cookbook> for deployment recipes.
@@ -572,7 +572,7 @@ dropped, defaults to C<5>.
listen => ['http://*:80']
-List of ports and files to listen on, defaults to C<http://*:8080>.
+List of one or more locations to listen on, defaults to C<http://*:8080>.
=head2 C<lock_file>
@@ -138,19 +138,19 @@ Mojo::Server::Morbo - DOOOOOOOOOOOOOOOOOOM!
=head1 DESCRIPTION
-L<Mojo::Server::Morbo> is a full featured self-restart capable async io HTTP
+L<Mojo::Server::Morbo> is a full featured self-restart capable async I/O HTTP
1.1 and WebSocket server built around the very well tested and reliable
-L<Mojo::Server::Daemon> with C<IPv6>, C<TLS>, C<Bonjour>, C<epoll> and
-C<kqueue> support.
+L<Mojo::Server::Daemon> with C<IPv6>, C<TLS>, C<Bonjour> and C<libev>
+support.
To start applications with it you can use the L<morbo> script.
% morbo myapp.pl
Server available at http://127.0.0.1:3000.
-Optional modules L<IO::KQueue>, L<IO::Epoll>, L<IO::Socket::IP>,
-L<IO::Socket::SSL> and L<Net::Rendezvous::Publish> are supported
-transparently and used if installed.
+Optional modules L<EV>, L<IO::Socket::IP>, L<IO::Socket::SSL> and
+L<Net::Rendezvous::Publish> are supported transparently and used if
+installed.
Note that this module is EXPERIMENTAL and might change without warning!
@@ -163,7 +163,7 @@ L<Mojo::Server::Morbo> implements the following attributes.
my $listen = $morbo->listen;
$morbo = $morbo->listen(['http://*:3000']);
-List of ports and files to listen on, defaults to C<http://*:3000>.
+List of one or more locations to listen on, defaults to C<http://*:3000>.
=head2 C<watch>
@@ -177,7 +177,7 @@ sub interpret {
return unless $compiled;
# Stacktrace
- local $SIG{__DIE__} = local $SIG{__DIE__} = sub {
+ local $SIG{__DIE__} = sub {
CORE::die($_[0]) if ref $_[0];
Mojo::Exception->throw(shift, [$self->template, $self->code],
$self->name);
@@ -399,15 +399,9 @@ sub _proxy_connect {
# TLS upgrade
if ($tx->req->url->scheme eq 'https') {
-
- # Connection from keep alive cache
- return unless my $old_id = $tx->connection;
-
- # Start TLS
- my $new_id = $self->{loop}->start_tls($old_id);
+ return unless my $id = $tx->connection;
+ $self->{loop}->start_tls($id);
$old->req->proxy(undef);
- delete $self->{cs}->{$old_id};
- $tx->connection($new_id);
}
# Share connection and start real transaction
@@ -427,13 +421,9 @@ sub _read {
return unless my $c = $self->{cs}->{$id};
return $self->_drop($id) unless my $tx = $c->{tx};
- # Read
+ # Process incoming data
$tx->client_read($chunk);
-
- # Finish
- if ($tx->is_done) { $self->_handle($id) }
-
- # Write
+ if ($tx->is_done) { $self->_handle($id) }
elsif ($c->{tx}->is_writing) { $self->_write($id) }
}
@@ -546,6 +536,7 @@ sub _test_server {
$self->{scheme} = $scheme ||= 'http';
$server->listen(["$scheme://*:$port"]);
$server->prepare_ioloop;
+ warn "TEST SERVER STARTED ($scheme://*:$port)\n" if DEBUG;
}
return $self->{server};
@@ -580,24 +571,22 @@ sub _upgrade {
sub _write {
my ($self, $id) = @_;
- # Get chunk
+ # Prepare outgoing data
return unless my $c = $self->{cs}->{$id};
return unless my $tx = $c->{tx};
return unless $tx->is_writing;
my $chunk = $tx->client_write;
- # More to write
+ # More data to follow
my $cb;
if ($tx->is_writing) {
weaken $self;
$cb = sub { $self->_write($id) };
}
- # Write
+ # Write data
$self->{loop}->write($id, $chunk, $cb);
- warn "> $chunk\n" if DEBUG;
-
- # Finish
+ warn "> $chunk\n" if DEBUG;
$self->_handle($id) if $tx->is_done;
}
@@ -606,7 +595,7 @@ __END__
=head1 NAME
-Mojo::UserAgent - Async IO HTTP 1.1 And WebSocket User Agent
+Mojo::UserAgent - Async I/O HTTP 1.1 And WebSocket User Agent
=head1 SYNOPSIS
@@ -661,11 +650,11 @@ Mojo::UserAgent - Async IO HTTP 1.1 And WebSocket User Agent
=head1 DESCRIPTION
-L<Mojo::UserAgent> is a full featured async io HTTP 1.1 and WebSocket user
-agent with C<IPv6>, C<TLS>, C<epoll> and C<kqueue> support.
+L<Mojo::UserAgent> is a full featured async I/O HTTP 1.1 and WebSocket user
+agent with C<IPv6>, C<TLS> and C<libev> support.
-Optional modules L<IO::KQueue>, L<IO::Epoll>, L<IO::Socket::IP> and
-L<IO::Socket::SSL> are supported transparently and used if installed.
+Optional modules L<EV>, L<IO::Socket::IP> and L<IO::Socket::SSL> are
+supported transparently and used if installed.
=head1 ATTRIBUTES
@@ -705,7 +694,7 @@ Proxy server to use for HTTPS and WebSocket requests.
my $loop = $ua->ioloop;
$ua = $ua->ioloop(Mojo::IOLoop->new);
-Loop object to use for blocking io operations, by default a L<Mojo::IOLoop>
+Loop object to use for blocking I/O operations, by default a L<Mojo::IOLoop>
object will be used.
=head2 C<keep_alive_timeout>
@@ -42,6 +42,8 @@ sub run {
'keepalive=i' => sub { $daemon->keep_alive_timeout($_[1]) },
'listen=s' => \@listen,
'proxy' => sub { $ENV{MOJO_REVERSE_PROXY} = 1 },
+ 'reload' =>
+ sub { warn "Ignoring --reload (use 'morbo myapp.pl' instead)!\n" },
'requests=i' => sub { $daemon->max_requests($_[1]) },
'user=s' => sub { $daemon->user($_[1]) },
'websocket=i' => sub { $daemon->websocket_timeout($_[1]) }
@@ -30,7 +30,7 @@ sub run {
local @ARGV = @_ if @_;
my $verbose;
- GetOptions('verbose' => sub { $verbose = 1 });
+ GetOptions(verbose => sub { $verbose = 1 });
my $code = shift @ARGV || '';
# Run code against application
@@ -28,7 +28,7 @@ __DATA__
blib
Makefile*
!Makefile.PL
-*META.yml
+*META.*
MANIFEST*
!MANIFEST.SKIP
pm_to_blib
@@ -51,8 +51,8 @@ sub run {
'content=s' => sub { $content = $_[1] },
'header=s' => \@headers,
'method=s' => sub { $method = $_[1] },
- 'redirect' => sub { $redirect = 1 },
- 'verbose' => sub { $verbose = 1 }
+ redirect => sub { $redirect = 1 },
+ verbose => sub { $verbose = 1 }
);
# Headers
@@ -163,7 +163,7 @@ sub _select {
# Commands
my $done = 0;
- while (my $command = shift @ARGV) {
+ while (defined(my $command = shift @ARGV)) {
# Number
if ($command =~ /^\d+$/) {
@@ -1,7 +1,7 @@
package Mojolicious::Command::Version;
use Mojo::Base 'Mojo::Command';
-use Mojo::IOLoop;
+use Mojo::IOLoop::Server;
use Mojo::Server::Daemon;
use Mojo::UserAgent;
use Mojolicious;
@@ -34,19 +34,16 @@ sub run {
$message = "You might want to update your Mojolicious to $latest."
if $latest > $current;
- # Epoll
- my $epoll = Mojo::IOLoop::EPOLL() ? $IO::Epoll::VERSION : 'not installed';
-
- # KQueue
- my $kqueue =
- Mojo::IOLoop::KQUEUE() ? $IO::KQueue::VERSION : 'not installed';
+ # EV
+ my $ev = eval 'use Mojo::IOWatcher::EV; 1' ? $EV::VERSION : 'not installed';
# IPv6
my $ipv6 =
- Mojo::IOLoop::IPV6() ? $IO::Socket::IP::VERSION : 'not installed';
+ Mojo::IOLoop::Server::IPV6() ? $IO::Socket::IP::VERSION : 'not installed';
# TLS
- my $tls = Mojo::IOLoop::TLS() ? $IO::Socket::SSL::VERSION : 'not installed';
+ my $tls =
+ Mojo::IOLoop::Server::TLS() ? $IO::Socket::SSL::VERSION : 'not installed';
# Bonjour
my $bonjour =
@@ -60,8 +57,7 @@ CORE
Mojolicious ($Mojolicious::VERSION, $Mojolicious::CODENAME)
OPTIONAL
- IO::Epoll ($epoll)
- IO::KQueue ($kqueue)
+ EV ($ev)
IO::Socket::IP ($ipv6)
IO::Socket::SSL ($tls)
Net::Rendezvous::Publish ($bonjour)
@@ -164,8 +164,8 @@ Note that L<IO::Socket::SSL> must be installed for TLS support.
=head2 C<MOJO_CHUNK_SIZE>
-Chunk size used for IO operations in bytes, a bigger chunk size speeds up IO
-operations but will also use more memory, defaults to C<131072>.
+Chunk size used for I/O operations in bytes, a bigger chunk size speeds up
+I/O operations but will also use more memory, defaults to C<131072>.
MOJO_CHUNK_SIZE=1024
@@ -189,6 +189,12 @@ path like C</home/sri/myapp>.
MOJO_HOME=/home/sri/myapp
+=head2 C<MOJO_IOWATCHER>
+
+Alternative L<Mojo::IOWatcher> implementation to try.
+
+ MOJO_IOWATCHER=Mojo::IOWatcher::EV
+
=head2 C<MOJO_KEY_FILE>
The path to the TLS key, should always contain a path like
@@ -273,13 +279,6 @@ Note that L<IO::Socket::SSL> must be installed for TLS support.
MOJO_NO_TLS=1
-=head2 C<MOJO_POLL>
-
-Force poll mainloop for IO operations, this should only be used for testing
-since other mainloops are generally faster and scale better.
-
- MOJO_POLL=1
-
=head2 C<MOJO_PROXY>
Enable automatic HTTP and HTTPS proxy detection in L<Mojo::UserAgent>, for
@@ -230,9 +230,9 @@ make sense for a standalone parser.
# Extract title
print 'Title: ', $tx->res->dom->at('head > title')->text, "\n";
- # Extract headers
+ # Extract headings
$tx->res->dom('h1, h2, h3')->each(sub {
- print 'Header: ', shift->all_text, "\n";
+ print 'Heading: ', shift->all_text, "\n";
});
Especially for unit testing your L<Mojolicious> applications this can be a
@@ -429,11 +429,11 @@ How about a list of all id attributes?
% mojo get http://mojolicio.us '*' attr id
-Or the text content of all header tags?
+Or the text content of all heading tags?
% mojo get http://mojolicio.us 'h1, h2, h3' text
-Maybe just the text of the third header?
+Maybe just the text of the third heading?
% mojo get http://mojolicio.us 'h1, h2, h3' 3 text
@@ -17,10 +17,9 @@ without compromises.
While there are no rules in L<Mojolicious::Guides::CodingGuidelines> that
forbid dependencies, we do currently discourage adding non-optional ones in
favor of a faster and more painless installation process.
-And we do in fact already use several optional CPAN modules such as
-L<IO::KQueue>, L<IO::Epoll>, L<IO::Socket::IP>, L<IO::Socket::SSL>,
-L<Net::Rendezvous::Publish> and L<Plack> to provide advanced functionality if
-they are installed.
+And we do in fact already use several optional CPAN modules such as L<EV>,
+L<IO::Socket::IP>, L<IO::Socket::SSL>, L<Net::Rendezvous::Publish> and
+L<Plack> to provide advanced functionality if they are installed.
=head2 Why reinvent wheels?
@@ -102,8 +102,8 @@ all characters except C</> and C<.>.
/sebastian23/hello -> /:name/hello -> {name => 'sebastian23'}
/sebastian 23/hello -> /:name/hello -> {name => 'sebastian 23'}
-A generic placeholder can be surrounded by brackets to separate it from the
-surrounding text.
+A generic placeholder can be surrounded by parentheses to separate it from
+the surrounding text.
/hello -> /(:name)hello -> undef
/sebastian/23hello -> /(:name)hello -> undef
@@ -127,7 +127,7 @@ absolutely everything.
=head2 Relaxed Placeholders
Relaxed placeholders are similar to the two placeholders above, but always
-require brackets and match all characters except C</>.
+require parentheses and match all characters except C</>.
/hello -> /(.name)/hello -> undef
/sebastian/23/hello -> /(.name)/hello -> undef
@@ -70,7 +70,7 @@ ones.
=item L<Mojo::UserAgent>
-Full featured async io HTTP 1.1 and WebSocket user agent.
+Full featured async I/O HTTP 1.1 and WebSocket user agent.
=item L<Mojo::DOM>
@@ -82,12 +82,12 @@ Minimalistic JSON implementation that just works.
=item L<Mojo::Server::Daemon>
-Highly portable async io HTTP 1.1 and WebSocket server with self-restart
+Highly portable async I/O HTTP 1.1 and WebSocket server with self-restart
support through L<Mojo::Server::Morbo>, perfect for development and testing.
=item L<Mojo::Server::Hypnotoad>
-Full featured UNIX optimized preforking async io HTTP 1.1 and WebSocket
+Full featured UNIX optimized preforking async I/O HTTP 1.1 and WebSocket
server with support for zero downtime software upgrades (hot deployment).
=item L<Mojo::Server::CGI>, L<Mojo::Server::FastCGI>, L<Mojo::Server::PSGI>
@@ -548,12 +548,6 @@ constructs.
shift->render(text => 'Hello Mojolicious!');
};
-However you might want to disable automatic route caching in case there are
-routes responding to the same path without conditions attached, since those
-would otherwise get precedence once cached.
-
- app->routes->cache(0);
-
=head2 Sessions
Signed cookie based sessions just work out of the box as soon as you start
@@ -42,7 +42,7 @@ sub register {
$app->helper(
dumper => sub {
shift;
- Data::Dumper->new([@_])->Maxdepth(2)->Indent(1)->Terse(1)->Dump;
+ Data::Dumper->new([@_])->Indent(1)->Terse(1)->Dump;
}
);
@@ -15,7 +15,6 @@ sub register {
$path = $3;
$path = '/' unless defined $path;
$host = qr/^$host$/i;
- $app->routes->cache(0);
}
else { $path = $prefix }
@@ -47,7 +46,7 @@ Mojolicious::Plugin::Mount - Application Mount Plugin
my $example = plugin mount => {'/example' => '/home/sri/example.pl'};
$example->to(message => 'It works great!');
- # Mount application with host (automatically disables route caching)
+ # Mount application with host
plugin mount => {'mojolicio.us' => '/home/sri/myapp.pl'};
# Host and path
@@ -69,8 +69,7 @@ sub register {
my $path = Pod::Simple::Search->new->find($module, @PATHS);
# Redirect to CPAN
- my $cpan = 'http://search.cpan.org/perldoc';
- return $self->redirect_to("$cpan?$module")
+ return $self->redirect_to("http://metacpan.org/module/$module")
unless $path && -r $path;
# Turn POD into HTML
@@ -83,10 +82,9 @@ sub register {
$dom->find('a[href]')->each(
sub {
my $attrs = shift->attrs;
- if ($attrs->{href} =~ /^$cpan/) {
- $attrs->{href} =~ s/^$cpan\?/$perldoc/;
- $attrs->{href} =~ s/%3A%3A/\//gi;
- }
+ $attrs->{href} =~ s/%3A%3A/\//gi
+ if $attrs->{href}
+ =~ s/^http\:\/\/search\.cpan\.org\/perldoc\?/$perldoc/;
}
);
@@ -204,7 +204,7 @@ sub _compile {
sub _compile_req {
my $req = shift;
return "($req)" if !ref $req || ref $req ne 'ARRAY';
- return '(' . join('|', @$req) . ')';
+ return '(' . join('|', reverse sort @$req) . ')';
}
sub _tokenize {
@@ -212,6 +212,9 @@ sub over {
return $self unless @_;
my $conditions = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
push @{$self->conditions}, @$conditions;
+ my $root = my $parent = $self;
+ while ($parent = $parent->parent) { $root = $parent }
+ $root->cache(0);
return $self;
}
@@ -677,10 +680,6 @@ The children of this routes object, used for nesting routes.
Routing cache, by default a L<Mojo::Cache> object.
Note that this attribute is EXPERIMENTAL and might change without warning!
- $r->cache(0);
-
-Route caching can also be disabled with a false value.
-
=head2 C<conditions>
my $conditions = $r->conditions;
@@ -894,7 +893,7 @@ Note that the name C<current> is reserved for refering to the current route.
$r = $r->over(foo => qr/\w+/);
-Apply condition parameters to this route.
+Apply condition parameters to this route and disable routing cache.
=head2 C<parse>
@@ -63,7 +63,7 @@
%= link_to Documentation => 'http://mojolicio.us/perldoc'
%= link_to Wiki => 'https://github.com/kraih/mojo/wiki'
%= link_to GitHub => 'https://github.com/kraih/mojo'
- %= link_to CPAN => 'http://search.cpan.org/dist/Mojolicious'
+ %= link_to CPAN => 'http://metacpan.org/release/Mojolicious/'
%= link_to MailingList => 'http://groups.google.com/group/mojolicious'
%= link_to Blog => 'http://blog.kraih.com'
%= link_to Twitter => 'http://twitter.com/kraih'
@@ -11,6 +11,7 @@
background-color: #f5f6f8;
color: #333;
font: 0.9em Verdana, sans-serif;
+ line-height: 1.5;
margin: 0;
text-shadow: #ddd 0 1px 0;
}
@@ -51,6 +52,10 @@
padding-top: 7em;
}
#perldoc > ul:first-of-type a { text-decoration: none; }
+ #wrapperlicious {
+ max-width: 1000px;
+ margin: 0 auto;
+ }
% end
</head>
<body onload="prettyPrint()">
@@ -58,25 +63,27 @@
% my $link = begin
%= link_to shift, shift, class => "mojoscroll"
% end
- <div id="perldoc">
- <h1><a id="toc">TABLE OF CONTENTS</a></h1>
- <ul>
- % for my $section (@$sections) {
- <li>
- %= $link->(splice @$section, 0, 2)
- % if (@$section) {
- <ul>
- % while (@$section) {
- <li>
- %= $link->(splice @$section, 0, 2)
- </li>
- % }
- </ul>
- % }
- </li>
- % }
- </ul>
- %= content_for 'perldoc'
+ <div id="wrapperlicious">
+ <div id="perldoc">
+ <h1><a id="toc">TABLE OF CONTENTS</a></h1>
+ <ul>
+ % for my $section (@$sections) {
+ <li>
+ %= $link->(splice @$section, 0, 2)
+ % if (@$section) {
+ <ul>
+ % while (@$section) {
+ <li>
+ %= $link->(splice @$section, 0, 2)
+ </li>
+ % }
+ </ul>
+ % }
+ </li>
+ % }
+ </ul>
+ %= content_for 'perldoc'
+ </div>
</div>
<div id="footer">
%= link_to 'http://mojolicio.us' => begin
@@ -33,7 +33,7 @@ has static => sub { Mojolicious::Static->new };
has types => sub { Mojolicious::Types->new };
our $CODENAME = 'Smiling Face With Sunglasses';
-our $VERSION = '1.64';
+our $VERSION = '1.67';
# "These old doomsday devices are dangerously unstable.
# I'll rest easier not knowing where they are."
@@ -304,8 +304,8 @@ TLS, Bonjour, IDNA, Comet (long polling), chunking and multipart support.
=item *
-Built-in async IO web server supporting epoll, kqueue, UNIX domain sockets
-and hot deployment, perfect for embedding.
+Built-in async I/O web server supporting libev and hot deployment, perfect
+for embedding.
=item *
@@ -388,9 +388,10 @@ Web development for humans, making hard things possible and everything fun.
__DATA__
@@ clock.html.ep
- % my ($second, $minute, $hour) = (localtime(time))[0, 1, 2];
+ % use Time::Piece;
+ % my $now = localtime;
<%= link_to clock => begin %>
- The time is <%= $hour %>:<%= $minute %>:<%= $second %>.
+ The time is <%= $now->hms %>.
<% end %>
=head2 Growing
@@ -466,7 +467,7 @@ especially when working in a team.
# All common HTTP verbs are supported
$example->post('/title')->to('#title');
- # ... and much, much more
+ # ...and much, much more
# (including multiple, auto-discovered controllers)
$r->websocket('/echo')->to('realtime#echo');
}
@@ -476,9 +477,10 @@ especially when working in a team.
Through all of these changes, your action code and templates can stay almost
exactly the same.
- % my ($second, $minute, $hour) = (localtime(time))[0, 1, 2];
+ % use Time::Piece;
+ % my $now = localtime;
<%= link_to clock => begin %>
- The time is <%= $hour %>:<%= $minute %>:<%= $second %>.
+ The time is <%= $now->hms %>.
<% end %>
Mojolicious has been designed from the ground up for a fun and unique
@@ -532,15 +534,18 @@ C<development>.
Mojo will name the log file after the current mode and modes other than
C<development> will result in limited log output.
-If you want to add per mode logic to your application, you can add a sub
-to your application named C<$mode_mode>.
+If you want to add per mode logic to your application, you can define methods
+named C<$mode_mode> in the application class, which will be called right
+before C<startup>.
sub development_mode {
my $self = shift;
+ ...
}
sub production_mode {
my $self = shift;
+ ...
}
=head2 C<on_process>
@@ -1049,6 +1054,8 @@ Lars Balker Rasmussen
Leon Brocard
+Magnus Holm
+
Maik Fischer
Marcus Ramberg
@@ -3,8 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More;
@@ -3,8 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
# mod_fastcgi doesn't like small chunks
BEGIN { $ENV{MOJO_CHUNK_SIZE} = 131072 }
@@ -3,8 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More tests => 43;
@@ -5,7 +5,7 @@ use warnings;
use utf8;
-use Test::More tests => 597;
+use Test::More tests => 603;
# "Homer gave me a kidney: it wasn't his, I didn't need it,
# and it came postage due- but I appreciated the gesture!"
@@ -1808,3 +1808,14 @@ is $dom->a->b->c, qq/<c id="three">bar<\/c>\n<c id="four">baz<\/c>/,
'right result';
is_deeply [keys %$dom], [], 'root has no attributes';
is $dom->find('#nothing'), '', 'no result';
+
+# Append and prepend content
+$dom = Mojo::DOM->new('<a><b>Test<c /></b></a>');
+$dom->at('b')->append_content('<d />');
+is $dom->children->[0]->type, 'a', 'right element';
+is $dom->all_text, 'Test', 'right text';
+is $dom->at('c')->parent->type, 'b', 'right element';
+is $dom->at('d')->parent->type, 'b', 'right element';
+$dom->at('b')->prepend_content('<e>Mojo</e>');
+is $dom->at('e')->parent->type, 'b', 'right element';
+is $dom->all_text, 'Mojo Test', 'right text';
@@ -0,0 +1,113 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 36;
+
+# "Hi, Super Nintendo Chalmers!"
+use_ok 'Mojo::IOLoop::EventEmitter';
+
+# Normal event
+my $e = Mojo::IOLoop::EventEmitter->new;
+my $called = 0;
+$e->on(test1 => sub { $called++ });
+$e->emit('test1');
+is $called, 1, 'event was emitted once';
+
+# Error fallback
+my ($echo, $error);
+$e->on(error => sub { $error = pop });
+$e->on(test2 => sub { $echo .= 'echo: ' . pop });
+$e->on(
+ test2 => sub {
+ my ($self, $message) = @_;
+ die "test2: $message\n";
+ }
+);
+my $cb = sub { $echo .= 'echo2: ' . pop };
+$e->on(test2 => $cb);
+$e->emit('test2', 'works!');
+is $echo, 'echo: works!echo2: works!', 'right echo';
+is $error, qq/Event "test2" failed: test2: works!\n/, 'right error';
+$echo = $error = undef;
+is scalar @{$e->subscribers('test2')}, 3, 'three subscribers';
+$e->unsubscribe(test2 => $cb);
+is scalar @{$e->subscribers('test2')}, 2, 'two subscribers';
+$e->emit('test2', 'works!');
+is $echo, 'echo: works!', 'right echo';
+is $error, qq/Event "test2" failed: test2: works!\n/, 'right error';
+
+# Normal event again
+$e->emit('test1');
+is $called, 2, 'event was emitted twice';
+is scalar @{$e->subscribers('test1')}, 1, 'one subscriber';
+$e->emit('test1');
+$e->unsubscribe(test1 => $e->subscribers('test1')->[0]);
+is $called, 3, 'event was emitted three times';
+is scalar @{$e->subscribers('test1')}, 0, 'no subscribers';
+$e->emit('test1');
+is $called, 3, 'event was not emitted again';
+$e->emit('test1');
+is $called, 3, 'event was not emitted again';
+
+# One time event
+my $once = 0;
+$e->once(one_time => sub { $once++ });
+is scalar @{$e->subscribers('one_time')}, 1, 'one subscriber';
+$e->emit('one_time');
+is $once, 1, 'event was emitted once';
+is scalar @{$e->subscribers('one_time')}, 0, 'no subscribers';
+$e->emit('one_time');
+is $once, 1, 'event was not emitted again';
+$e->emit('one_time');
+is $once, 1, 'event was not emitted again';
+$e->emit('one_time');
+is $once, 1, 'event was not emitted again';
+
+# Nested one time events
+$once = 0;
+$e->once(
+ one_time => sub {
+ $e->once(
+ one_time => sub {
+ $e->once(one_time => sub { $once++ });
+ }
+ );
+ }
+);
+is scalar @{$e->subscribers('one_time')}, 1, 'one subscriber';
+$e->emit('one_time');
+is $once, 0, 'only first event was emitted';
+is scalar @{$e->subscribers('one_time')}, 1, 'one subscriber';
+$e->emit('one_time');
+is $once, 0, 'only second event was emitted';
+is scalar @{$e->subscribers('one_time')}, 1, 'one subscriber';
+$e->emit('one_time');
+is $once, 1, 'third event was emitted';
+is scalar @{$e->subscribers('one_time')}, 0, 'no subscribers';
+$e->emit('one_time');
+is $once, 1, 'event was not emitted again';
+$e->emit('one_time');
+is $once, 1, 'event was not emitted again';
+$e->emit('one_time');
+is $once, 1, 'event was not emitted again';
+
+# Unsubscribe
+$e = Mojo::IOLoop::EventEmitter->new;
+my $counter = 0;
+$cb = $e->on(foo => sub { $counter++ });
+$e->on(foo => sub { $counter++ });
+$e->on(foo => sub { $counter++ });
+$e->unsubscribe(foo => $e->once(foo => sub { $counter++ }));
+is scalar @{$e->subscribers('foo')}, 3, 'three subscribers';
+$e->emit('foo');
+is $counter, 3, 'event was emitted three times';
+$e->unsubscribe(foo => $cb);
+is scalar @{$e->subscribers('foo')}, 2, 'two subscribers';
+$e->emit('foo');
+is $counter, 5, 'event was emitted two times';
+$e->unsubscribe(foo => $_) for @{$e->subscribers('foo')};
+is scalar @{$e->subscribers('foo')}, 0, 'no subscribers';
+$e->emit('foo');
+is $counter, 5, 'event was not emitted again';
@@ -4,7 +4,7 @@ use strict;
use warnings;
# "Remember, you can always find East by staring directly at the sun."
-use Test::More tests => 37;
+use Test::More tests => 41;
# "So, have a merry Christmas, a happy Hanukkah, a kwaazy Kwanza,
# a tip-top Tet, and a solemn, dignified, Ramadan.
@@ -34,6 +34,10 @@ is_deeply $hash->{Expect}, [['continue-100']], 'right structure';
is_deeply $hash->{'Content-Type'}, [['text/html']], 'right structure';
is_deeply [sort @{$headers->names}], [qw/Connection Content-Type Expect/],
'right structure';
+$headers->expires('Thu, 01 Dec 1994 16:00:00 GMT');
+$headers->cache_control('public');
+is $headers->expires, 'Thu, 01 Dec 1994 16:00:00 GMT', 'right value';
+is $headers->cache_control, 'public', 'right value';
# Multiline values
$headers = Mojo::Headers->new;
@@ -56,11 +60,15 @@ $headers = Mojo::Headers->new;
isa_ok $headers->parse(<<'EOF'), 'Mojo::Headers', 'right return value';
Content-Type: text/plain
Expect: 100-continue
+Cache-control: public
+Expires: Thu, 01 Dec 1994 16:00:00 GMT
EOF
-ok $headers->is_done, 'parser is done';
-is $headers->content_type, 'text/plain', 'right value';
-is $headers->expect, '100-continue', 'right value';
+ok $headers->is_done, 'parser is done';
+is $headers->content_type, 'text/plain', 'right value';
+is $headers->expect, '100-continue', 'right value';
+is $headers->cache_control, 'public', 'right value';
+is $headers->expires, 'Thu, 01 Dec 1994 16:00:00 GMT', 'right value';
# Set headers from hash
$headers = Mojo::Headers->new;
@@ -3,8 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More;
@@ -3,10 +3,13 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
-use Test::More tests => 12;
+use Test::More tests => 11;
# "Marge, you being a cop makes you the man!
# Which makes me the woman, and I have no interest in that,
@@ -14,8 +17,6 @@ use Test::More tests => 12;
# which as we discussed, is strictly a comfort thing."
use_ok 'Mojo::IOLoop';
-use IO::Handle;
-
# Custom watcher
package MyWatcher;
use Mojo::Base 'Mojo::IOWatcher';
@@ -28,16 +29,6 @@ my $loop = Mojo::IOLoop->new;
Mojo::IOLoop->iowatcher(MyWatcher->new);
is ref $loop->iowatcher, 'MyWatcher', 'right class';
-# Readonly handle
-my $ro = IO::Handle->new;
-$ro->fdopen(fileno(DATA), 'r');
-my $error;
-$loop->connect(
- handle => $ro,
- on_read => sub { },
- on_error => sub { $error = pop }
-);
-
# Ticks
my $ticks = 0;
my $id = $loop->recurring(0 => sub { $ticks++ });
@@ -87,7 +78,6 @@ $loop->start;
ok $after > 2, 'more than two ticks';
is $ticks, $before, 'no additional ticks';
-
# Recurring timer
my $count = 0;
$loop->recurring(0.5 => sub { $count++ });
@@ -117,9 +107,6 @@ $loop->connect(
$loop->start;
isa_ok $handle, 'IO::Socket', 'right reference';
-# Readonly handle
-is $error, undef, 'no error';
-
# Dropped listen socket
$port = Mojo::IOLoop->generate_port;
$id = $loop->listen(port => $port);
@@ -133,7 +120,7 @@ $loop->connect(
}
);
$loop->start;
-$error = undef;
+my $error;
my $connected;
$loop->connect(
address => 'localhost',
@@ -147,5 +134,3 @@ $loop->connect(
$loop->start;
ok $error, 'has error';
ok !$connected, 'not connected';
-
-__DATA__
@@ -3,8 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
# To regenerate all required certificates run these commands
# openssl genrsa -out ca.key 1024
@@ -27,15 +30,18 @@ BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
# openssl req -x509 -days 7300 -key badclient.key -in badclient.csr \
# -out badclient.crt
use Test::More;
-use Mojo::IOLoop;
+use Mojo::IOLoop::Server;
+use Mojo::IOLoop::Stream;
plan skip_all => 'set TEST_TLS to enable this test (developer only!)'
unless $ENV{TEST_TLS};
plan skip_all => 'IO::Socket::SSL 1.43 required for this test!'
- unless Mojo::IOLoop::TLS;
+ unless Mojo::IOLoop::Server::TLS;
plan skip_all => 'Windows is too fragile for this test!'
- if Mojo::IOLoop::WINDOWS;
+ if Mojo::IOLoop::Stream::WINDOWS;
plan tests => 16;
+use Mojo::IOLoop;
+
# "To the panic room!
# We don't have a panic room.
# To the panic room store!"
@@ -147,7 +153,7 @@ $id = $loop->connect(
$loop->connection_timeout($id => '0.5');
$loop->timer(1 => sub { shift->stop });
$loop->start;
-ok $error, 'has error';
+ok !$error, 'no error';
ok $cerror, 'has error';
# Valid client certificate accepted by callback
@@ -196,7 +202,7 @@ $id = $loop->connect(
);
$loop->connection_timeout($id => '0.5');
$loop->start;
-ok $error, 'has error';
+ok !$error, 'no error';
ok $cerror, 'has error';
# Invalid certificate authority
@@ -225,5 +231,5 @@ $id = $loop->connect(
$loop->connection_timeout($id => '0.5');
$loop->timer(1 => sub { shift->stop });
$loop->start;
-ok $error, 'has error';
+ok !$error, 'no error';
ok $cerror, 'has error';
@@ -3,12 +3,15 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
# "I don't mind being called a liar when I'm lying, or about to lie,
# or just finished lying, but NOT WHEN I'M TELLING THE TRUTH."
-use Test::More tests => 35;
+use Test::More tests => 50;
use_ok 'Mojo::IOWatcher';
@@ -24,6 +27,7 @@ my $listen = IO::Socket::INET->new(
Proto => 'tcp'
);
my $watcher = Mojo::IOWatcher->new;
+isa_ok $watcher, 'Mojo::IOWatcher', 'right object';
my ($readable, $writable);
$watcher->add(
$listen,
@@ -43,7 +47,9 @@ is $writable, undef, 'handle is not writable';
# Accept
my $server = $listen->accept;
-$watcher = $watcher->new;
+$watcher = undef;
+$watcher = Mojo::IOWatcher->new;
+isa_ok $watcher, 'Mojo::IOWatcher', 'right object';
$readable = $writable = undef;
$watcher->add(
$client,
@@ -55,7 +61,9 @@ is $readable, undef, 'handle is not readable';
is $writable, 1, 'handle is writable';
print $client "hello!\n";
sleep 1;
-$watcher = $watcher->new;
+$watcher = undef;
+$watcher = Mojo::IOWatcher->new;
+isa_ok $watcher, 'Mojo::IOWatcher', 'right object';
$readable = $writable = undef;
$watcher->add(
$server,
@@ -80,7 +88,7 @@ $watcher->add(
on_readable => sub { $readable++ },
on_writable => sub { $writable++ }
);
-$watcher->watch(0);
+$watcher->one_tick(0);
is $readable, 1, 'handle is readable';
is $writable, 1, 'handle is writable';
@@ -99,19 +107,47 @@ is $readable, 3, 'handle is readable again';
is $writable, 3, 'handle is writable again';
is $timer, 1, 'timer was not triggered';
is $recurring, 2, 'recurring was triggered again';
-$watcher->watch(0);
+$watcher->one_tick(0);
is $readable, 4, 'handle is readable again';
is $writable, 4, 'handle is writable again';
is $timer, 1, 'timer was not triggered';
-is $recurring, 2, 'recurring was not triggered';
+is $recurring, 3, 'recurring was not triggered';
$watcher->one_tick(0);
is $readable, 5, 'handle is readable again';
is $writable, 5, 'handle is writable again';
is $timer, 1, 'timer was not triggered';
-is $recurring, 3, 'recurring was triggered again';
+is $recurring, 4, 'recurring was triggered again';
$watcher->cancel($id);
$watcher->one_tick(0);
is $readable, 6, 'handle is readable again';
is $writable, 6, 'handle is writable again';
is $timer, 1, 'timer was not triggered';
-is $recurring, 3, 'recurring was not triggered again';
+is $recurring, 4, 'recurring was not triggered again';
+
+# Reset
+$watcher = undef;
+$watcher = Mojo::IOWatcher->new;
+isa_ok $watcher, 'Mojo::IOWatcher', 'right object';
+$watcher->one_tick(0);
+is $readable, 6, 'io event was not triggered again';
+is $writable, 6, 'io event was not triggered again';
+my $watcher2 = Mojo::IOWatcher->new;
+isa_ok $watcher2, 'Mojo::IOWatcher', 'right object';
+
+# Parallel loops
+$timer = 0;
+$watcher->recurring(0 => sub { $timer++ });
+my $timer2 = 0;
+$watcher2->recurring(0 => sub { $timer2++ });
+$watcher->one_tick(0);
+is $timer, 1, 'timer was triggered';
+is $timer2, 0, 'timer was not triggered';
+$watcher2->one_tick(0);
+is $timer, 1, 'timer was not triggered';
+is $timer2, 1, 'timer was triggered';
+$watcher->one_tick(0);
+is $timer, 2, 'timer was triggered';
+is $timer2, 1, 'timer was not triggered';
+$watcher2->one_tick(0);
+is $timer, 2, 'timer was not triggered';
+is $timer2, 2, 'timer was triggered';
@@ -1,123 +0,0 @@
-#!/usr/bin/env perl
-
-use strict;
-use warnings;
-
-# Disable Bonjour and IPv6
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1 }
-
-use Test::More;
-
-# "Have you ever seen that Blue Man Group? Total ripoff of the Smurfs.
-# And the Smurfs, well, they SUCK."
-plan skip_all => 'set TEST_EPOLL to enable this test (developer only!)'
- unless $ENV{TEST_EPOLL};
-plan skip_all => 'IO::Epoll 0.02 required for this test!'
- unless eval 'use IO::Epoll 0.02; 1';
-plan tests => 35;
-
-use_ok 'Mojo::IOWatcher::Epoll';
-
-use IO::Socket::INET;
-use Mojo::IOLoop;
-
-# Listen
-my $port = Mojo::IOLoop->generate_port;
-my $listen = IO::Socket::INET->new(
- Listen => 5,
- LocalAddr => '127.0.0.1',
- LocalPort => $port,
- Proto => 'tcp'
-);
-my $watcher = Mojo::IOWatcher::Epoll->new;
-my ($readable, $writable);
-$watcher->add(
- $listen,
- on_readable => sub { $readable++ },
- on_writable => sub { $writable++ }
-);
-$watcher->one_tick(0);
-is $readable, undef, 'handle is not readable';
-is $writable, undef, 'handle is not writable';
-
-# Connect
-my $client =
- IO::Socket::INET->new(PeerAddr => '127.0.0.1', PeerPort => $port);
-$watcher->one_tick(0);
-is $readable, 1, 'handle is readable';
-is $writable, undef, 'handle is not writable';
-
-# Accept
-my $server = $listen->accept;
-$watcher = $watcher->new;
-$readable = $writable = undef;
-$watcher->add(
- $client,
- on_readable => sub { $readable++ },
- on_writable => sub { $writable++ }
-);
-$watcher->one_tick(0);
-is $readable, undef, 'handle is not readable';
-is $writable, 1, 'handle is writable';
-print $client "hello!\n";
-sleep 1;
-$watcher = $watcher->new;
-$readable = $writable = undef;
-$watcher->add(
- $server,
- on_readable => sub { $readable++ },
- on_writable => sub { $writable++ }
-);
-$watcher->not_writing($server);
-$watcher->one_tick(0);
-is $readable, 1, 'handle is readable';
-is $writable, undef, 'handle is not writable';
-$watcher->writing($server);
-$watcher->one_tick(0);
-is $readable, 2, 'handle is readable';
-is $writable, 1, 'handle is writable';
-$watcher->not_writing($server);
-$watcher->one_tick(0);
-is $readable, 3, 'handle is readable';
-is $writable, 1, 'handle is not writable';
-$readable = $writable = undef;
-$watcher->add(
- $server,
- on_readable => sub { $readable++ },
- on_writable => sub { $writable++ }
-);
-$watcher->watch(0);
-is $readable, 1, 'handle is readable';
-is $writable, 1, 'handle is writable';
-
-# Timers
-my ($timer, $recurring);
-$watcher->timer(0 => sub { $timer++ });
-$watcher->cancel($watcher->timer(0 => sub { $timer++ }));
-my $id = $watcher->recurring(0 => sub { $recurring++ });
-$watcher->one_tick(0);
-is $readable, 2, 'handle is readable again';
-is $writable, 2, 'handle is writable again';
-is $timer, 1, 'timer was triggered';
-is $recurring, 1, 'recurring was triggered';
-$watcher->one_tick(0);
-is $readable, 3, 'handle is readable again';
-is $writable, 3, 'handle is writable again';
-is $timer, 1, 'timer was not triggered';
-is $recurring, 2, 'recurring was triggered again';
-$watcher->watch(0);
-is $readable, 4, 'handle is readable again';
-is $writable, 4, 'handle is writable again';
-is $timer, 1, 'timer was not triggered';
-is $recurring, 2, 'recurring was not triggered';
-$watcher->one_tick(0);
-is $readable, 5, 'handle is readable again';
-is $writable, 5, 'handle is writable again';
-is $timer, 1, 'timer was not triggered';
-is $recurring, 3, 'recurring was triggered again';
-$watcher->cancel($id);
-$watcher->one_tick(0);
-is $readable, 6, 'handle is readable again';
-is $writable, 6, 'handle is writable again';
-is $timer, 1, 'timer was not triggered';
-is $recurring, 3, 'recurring was not triggered again';
@@ -0,0 +1,154 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+# Disable Bonjour and IPv6
+BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1 }
+
+use Test::More;
+
+# "Oh well. At least we'll die doing what we love: inhaling molten rock."
+plan skip_all => 'set TEST_EV to enable this test (developer only!)'
+ unless $ENV{TEST_EV};
+plan skip_all => 'EV required for this test!' unless eval 'use EV; 1';
+plan tests => 50;
+
+use_ok 'Mojo::IOWatcher::EV';
+
+use IO::Socket::INET;
+use Mojo::IOLoop;
+
+# Listen
+my $port = Mojo::IOLoop->generate_port;
+my $listen = IO::Socket::INET->new(
+ Listen => 5,
+ LocalAddr => '127.0.0.1',
+ LocalPort => $port,
+ Proto => 'tcp'
+);
+my $watcher = Mojo::IOWatcher::EV->new;
+isa_ok $watcher, 'Mojo::IOWatcher::EV', 'right object';
+my ($readable, $writable);
+$watcher->add(
+ $listen,
+ on_readable => sub { $readable++ },
+ on_writable => sub { $writable++ }
+);
+$watcher->one_tick(0);
+is $readable, undef, 'handle is not readable';
+is $writable, undef, 'handle is not writable';
+
+# Connect
+my $client =
+ IO::Socket::INET->new(PeerAddr => '127.0.0.1', PeerPort => $port);
+$watcher->one_tick(0);
+is $readable, 1, 'handle is readable';
+is $writable, undef, 'handle is not writable';
+
+# Accept
+my $server = $listen->accept;
+$watcher = undef;
+$watcher = Mojo::IOWatcher::EV->new;
+isa_ok $watcher, 'Mojo::IOWatcher::EV', 'right object';
+$readable = $writable = undef;
+$watcher->add(
+ $client,
+ on_readable => sub { $readable++ },
+ on_writable => sub { $writable++ }
+);
+$watcher->one_tick(0);
+is $readable, undef, 'handle is not readable';
+is $writable, 1, 'handle is writable';
+print $client "hello!\n";
+sleep 1;
+$watcher = undef;
+$watcher = Mojo::IOWatcher::EV->new;
+isa_ok $watcher, 'Mojo::IOWatcher::EV', 'right object';
+$readable = $writable = undef;
+$watcher->add(
+ $server,
+ on_readable => sub { $readable++ },
+ on_writable => sub { $writable++ }
+);
+$watcher->not_writing($server);
+$watcher->one_tick(0);
+is $readable, 1, 'handle is readable';
+is $writable, undef, 'handle is not writable';
+$watcher->writing($server);
+$watcher->one_tick(0);
+is $readable, 2, 'handle is readable';
+is $writable, 1, 'handle is writable';
+$watcher->not_writing($server);
+$watcher->one_tick(0);
+is $readable, 3, 'handle is readable';
+is $writable, 1, 'handle is not writable';
+$readable = $writable = undef;
+$watcher->add(
+ $server,
+ on_readable => sub { $readable++ },
+ on_writable => sub { $writable++ }
+);
+$watcher->one_tick(0);
+is $readable, 1, 'handle is readable';
+is $writable, 1, 'handle is writable';
+
+# Timers
+my ($timer, $recurring);
+$watcher->timer(0 => sub { $timer++ });
+$watcher->cancel($watcher->timer(0 => sub { $timer++ }));
+my $id = $watcher->recurring(0 => sub { $recurring++ });
+$watcher->one_tick(0);
+is $readable, 2, 'handle is readable again';
+is $writable, 2, 'handle is writable again';
+is $timer, 1, 'timer was triggered';
+is $recurring, 1, 'recurring was triggered';
+$watcher->one_tick(0);
+is $readable, 3, 'handle is readable again';
+is $writable, 3, 'handle is writable again';
+is $timer, 1, 'timer was not triggered';
+is $recurring, 2, 'recurring was triggered again';
+$watcher->one_tick(0);
+is $readable, 4, 'handle is readable again';
+is $writable, 4, 'handle is writable again';
+is $timer, 1, 'timer was not triggered';
+is $recurring, 3, 'recurring was not triggered';
+$watcher->one_tick(0);
+is $readable, 5, 'handle is readable again';
+is $writable, 5, 'handle is writable again';
+is $timer, 1, 'timer was not triggered';
+is $recurring, 4, 'recurring was triggered again';
+$watcher->cancel($id);
+$watcher->one_tick(0);
+is $readable, 6, 'handle is readable again';
+is $writable, 6, 'handle is writable again';
+is $timer, 1, 'timer was not triggered';
+is $recurring, 4, 'recurring was not triggered again';
+
+# Reset
+$watcher = undef;
+$watcher = Mojo::IOWatcher::EV->new;
+isa_ok $watcher, 'Mojo::IOWatcher::EV', 'right object';
+$watcher->one_tick(0);
+is $readable, 6, 'io event was not triggered again';
+is $writable, 6, 'io event was not triggered again';
+my $watcher2 = Mojo::IOWatcher::EV->new;
+isa_ok $watcher2, 'Mojo::IOWatcher', 'right object';
+
+# Parallel loops
+$timer = 0;
+$watcher->recurring(0 => sub { $timer++ });
+my $timer2 = 0;
+$watcher2->recurring(0 => sub { $timer2++ });
+$watcher->one_tick(0);
+is $timer, 1, 'timer was triggered';
+is $timer2, 0, 'timer was not triggered';
+$watcher2->one_tick(0);
+is $timer, 1, 'timer was not triggered';
+is $timer2, 1, 'timer was triggered';
+$watcher->one_tick(0);
+is $timer, 2, 'timer was triggered';
+is $timer2, 1, 'timer was not triggered';
+$watcher2->one_tick(0);
+is $timer, 2, 'timer was not triggered';
+is $timer2, 2, 'timer was triggered';
@@ -1,122 +0,0 @@
-#!/usr/bin/env perl
-
-use strict;
-use warnings;
-
-# Disable Bonjour and IPv6
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1 }
-
-use Test::More;
-
-# "Oh well. At least we'll die doing what we love: inhaling molten rock."
-plan skip_all => 'set TEST_KQUEUE to enable this test (developer only!)'
- unless $ENV{TEST_KQUEUE};
-plan skip_all => 'IO::KQueue 0.34 required for this test!'
- unless eval 'use IO::KQueue 0.34; 1';
-plan tests => 35;
-
-use_ok 'Mojo::IOWatcher::KQueue';
-
-use IO::Socket::INET;
-use Mojo::IOLoop;
-
-# Listen
-my $port = Mojo::IOLoop->generate_port;
-my $listen = IO::Socket::INET->new(
- Listen => 5,
- LocalAddr => '127.0.0.1',
- LocalPort => $port,
- Proto => 'tcp'
-);
-my $watcher = Mojo::IOWatcher::KQueue->new;
-my ($readable, $writable);
-$watcher->add(
- $listen,
- on_readable => sub { $readable++ },
- on_writable => sub { $writable++ }
-);
-$watcher->one_tick(0);
-is $readable, undef, 'handle is not readable';
-is $writable, undef, 'handle is not writable';
-
-# Connect
-my $client =
- IO::Socket::INET->new(PeerAddr => '127.0.0.1', PeerPort => $port);
-$watcher->one_tick(0);
-is $readable, 1, 'handle is readable';
-is $writable, undef, 'handle is not writable';
-
-# Accept
-my $server = $listen->accept;
-$watcher = $watcher->new;
-$readable = $writable = undef;
-$watcher->add(
- $client,
- on_readable => sub { $readable++ },
- on_writable => sub { $writable++ }
-);
-$watcher->one_tick(0);
-is $readable, undef, 'handle is not readable';
-is $writable, 1, 'handle is writable';
-print $client "hello!\n";
-sleep 1;
-$watcher = $watcher->new;
-$readable = $writable = undef;
-$watcher->add(
- $server,
- on_readable => sub { $readable++ },
- on_writable => sub { $writable++ }
-);
-$watcher->not_writing($server);
-$watcher->one_tick(0);
-is $readable, 1, 'handle is readable';
-is $writable, undef, 'handle is not writable';
-$watcher->writing($server);
-$watcher->one_tick(0);
-is $readable, 2, 'handle is readable';
-is $writable, 1, 'handle is writable';
-$watcher->not_writing($server);
-$watcher->one_tick(0);
-is $readable, 3, 'handle is readable';
-is $writable, 1, 'handle is not writable';
-$readable = $writable = undef;
-$watcher->add(
- $server,
- on_readable => sub { $readable++ },
- on_writable => sub { $writable++ }
-);
-$watcher->watch(0);
-is $readable, 1, 'handle is readable';
-is $writable, 1, 'handle is writable';
-
-# Timers
-my ($timer, $recurring);
-$watcher->timer(0 => sub { $timer++ });
-$watcher->cancel($watcher->timer(0 => sub { $timer++ }));
-my $id = $watcher->recurring(0 => sub { $recurring++ });
-$watcher->one_tick(0);
-is $readable, 2, 'handle is readable again';
-is $writable, 2, 'handle is writable again';
-is $timer, 1, 'timer was triggered';
-is $recurring, 1, 'recurring was triggered';
-$watcher->one_tick(0);
-is $readable, 3, 'handle is readable again';
-is $writable, 3, 'handle is writable again';
-is $timer, 1, 'timer was not triggered';
-is $recurring, 2, 'recurring was triggered again';
-$watcher->watch(0);
-is $readable, 4, 'handle is readable again';
-is $writable, 4, 'handle is writable again';
-is $timer, 1, 'timer was not triggered';
-is $recurring, 2, 'recurring was not triggered';
-$watcher->one_tick(0);
-is $readable, 5, 'handle is readable again';
-is $writable, 5, 'handle is writable again';
-is $timer, 1, 'timer was not triggered';
-is $recurring, 3, 'recurring was triggered again';
-$watcher->cancel($id);
-$watcher->one_tick(0);
-is $readable, 6, 'handle is readable again';
-is $writable, 6, 'handle is writable again';
-is $timer, 1, 'timer was not triggered';
-is $recurring, 3, 'recurring was not triggered again';
@@ -3,8 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More;
@@ -3,8 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More;
plan skip_all => 'set TEST_ONLINE to enable this test (developer only!)'
@@ -167,13 +170,14 @@ Mojo::IOLoop->start;
ok $found, 'found IPv6 PTR record';
# Invalid DNS server
-ok scalar $r->servers, 'got a dns server';
+$r = Mojo::IOLoop::Resolver->new;
+ok scalar $r->servers, 'got a DNS server';
$r->servers('192.0.2.1', $r->servers);
-is $r->servers, '192.0.2.1', 'new invalid dns server';
+is $r->servers, '192.0.2.1', 'new invalid DNS server';
$r->lookup('google.com', sub { Mojo::IOLoop->stop });
Mojo::IOLoop->start;
my $fallback = $r->servers;
-isnt $fallback, '192.0.2.1', 'valid dns server';
+isnt $fallback, '192.0.2.1', 'valid DNS server';
$result = undef;
$r->lookup(
'google.com',
@@ -185,5 +189,5 @@ $r->lookup(
);
Mojo::IOLoop->start;
ok $result, 'got an address';
-is scalar $r->servers, $fallback, 'still the same dns server';
-isnt $fallback, '192.0.2.1', 'still valid dns server';
+is scalar $r->servers, $fallback, 'still the same DNS server';
+isnt $fallback, '192.0.2.1', 'still valid DNS server';
@@ -25,7 +25,7 @@ use warnings;
use utf8;
-use Test::More tests => 165;
+use Test::More tests => 188;
use File::Spec;
use File::Temp;
@@ -635,6 +635,43 @@ is $output->lines_after->[1]->[1], 'test', 'right line';
like "$output", qr/oops\! at template line 3, near "%= 1 \+ 1"./,
'right result';
+# Exception in template (empty perl lines)
+$mt = Mojo::Template->new;
+$output = $mt->render(<<'EOF');
+test
+123
+%
+% die 'oops!';
+%
+ %
+%
+%= 1 + 1
+test
+EOF
+isa_ok $output, 'Mojo::Exception', 'right exception';
+like $output->message, qr/oops\!/, 'right message';
+is $output->lines_before->[0]->[0], 1, 'right number';
+is $output->lines_before->[0]->[1], 'test', 'right line';
+ok $output->lines_before->[0]->[2], 'contains code';
+is $output->lines_before->[1]->[0], 2, 'right number';
+is $output->lines_before->[1]->[1], '123', 'right line';
+ok $output->lines_before->[1]->[2], 'contains code';
+is $output->lines_before->[2]->[0], 3, 'right number';
+is $output->lines_before->[2]->[1], '%', 'right line';
+is $output->lines_before->[2]->[2], '', 'right code';
+is $output->line->[0], 4, 'right number';
+is $output->line->[1], "% die 'oops!';", 'right line';
+is $output->lines_after->[0]->[0], 5, 'right number';
+is $output->lines_after->[0]->[1], '%', 'right line';
+is $output->lines_after->[0]->[2], '', 'right code';
+is $output->lines_after->[1]->[0], 6, 'right number';
+is $output->lines_after->[1]->[1], ' %', 'right line';
+is $output->lines_after->[1]->[2], '', 'right code';
+is $output->lines_after->[2]->[0], 7, 'right number';
+is $output->lines_after->[2]->[1], '%', 'right line';
+is $output->lines_after->[2]->[2], '', 'right code';
+like "$output", qr/oops\! at template line 4, near "%"./, 'right result';
+
# Exception in nested template
$mt = Mojo::Template->new;
$mt->tag_start('[$-');
@@ -3,13 +3,16 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More;
plan skip_all => 'Windows is too fragile for this test!'
if $^O eq 'MSWin32' || $^O =~ /cygwin/;
-plan tests => 70;
+plan tests => 73;
use_ok 'Mojo::UserAgent';
@@ -246,6 +249,12 @@ is $tx->kept_alive, undef, 'kept connection not alive';
is $tx->res->code, 200, 'right status';
is $tx->res->body, 'works!', 'right content';
+# GET / (built-in server)
+$tx = $ua->get('/');
+ok $tx->success, 'successful';
+is $tx->res->code, 200, 'right status';
+is $tx->res->body, 'works', 'right content';
+
# Nested keep alive
my @kept_alive;
$ua->get(
@@ -3,14 +3,17 @@
use strict;
use warnings;
-# Disable epoll, kqueue and TLS
-BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_TLS} = 1 }
+# Disable libev and TLS
+BEGIN {
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+ $ENV{MOJO_NO_TLS} = 1;
+}
use Test::More;
plan skip_all => 'set TEST_ONLINE to enable this test (developer only!)'
unless $ENV{TEST_ONLINE};
-plan tests => 96;
+plan tests => 104;
# "So then I said to the cop, "No, you're driving under the influence...
# of being a jerk"."
@@ -154,6 +157,18 @@ is $tx->req->headers->content_length, 17, 'right content length';
is $tx->req->body, 'query=mojolicious', 'right content';
like $tx->res->body, qr/Mojolicious/, 'right content';
is $tx->res->code, 200, 'right status';
+is $tx->keep_alive, 1, 'connection will be kept alive';
+
+# Simple keep alive form post
+$tx =
+ $ua->post_form('http://search.cpan.org/search' => {query => 'mojolicious'});
+is $tx->req->method, 'POST', 'right method';
+is $tx->req->url, 'http://search.cpan.org/search', 'right url';
+is $tx->req->headers->content_length, 17, 'right content length';
+is $tx->req->body, 'query=mojolicious', 'right content';
+like $tx->res->body, qr/Mojolicious/, 'right content';
+is $tx->res->code, 200, 'right status';
+is $tx->kept_alive, 1, 'connection was kept alive';
# Simple request
$tx = $ua->get('http://www.apache.org');
@@ -3,15 +3,18 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More;
-use Mojo::IOLoop;
+use Mojo::IOLoop::Server;
plan skip_all => 'set TEST_TLS to enable this test (developer only!)'
unless $ENV{TEST_TLS};
plan skip_all => 'IO::Socket::SSL 1.43 required for this test!'
- unless Mojo::IOLoop::TLS;
+ unless Mojo::IOLoop::Server::TLS;
plan tests => 14;
# "That does not compute.
@@ -50,12 +53,12 @@ my $id = $ua->ioloop->listen(
my $tx = $ua->get("https://localhost:$port");
ok !$tx->success, 'not successful';
ok $tx->error, 'has error';
-ok $error, 'has error';
+ok !$error, 'no error';
$error = '';
$tx = $ua->cert('')->key('')->get("https://localhost:$port");
ok !$tx->success, 'not successful';
ok $tx->error, 'has error';
-ok $error, 'has error';
+ok !$error, 'no error';
# Valid certificate
$tx =
@@ -85,8 +88,8 @@ $ENV{MOJO_KEY_FILE} = $backup2;
$tx =
$ua->cert('t/mojo/certs/badclient.crt')->key('t/mojo/certs/badclient.key')
->get("https://localhost:$port");
-ok $error, 'has error';
+ok !$error, 'no error';
# Empty certificate
$tx = $ua->cert('no file')->key('no file')->get("https://localhost:$port");
-ok $error, 'has error';
+ok !$error, 'no error';
@@ -3,10 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
+# Disable Bonjour, IPv6 and libev
BEGIN {
- $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1;
- $ENV{MOJO_MODE} = 'development';
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+ $ENV{MOJO_MODE} = 'development';
}
use Test::More tests => 250;
@@ -5,8 +5,11 @@ use warnings;
use utf8;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More tests => 39;
@@ -3,8 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More tests => 9;
@@ -5,10 +5,11 @@ use warnings;
use utf8;
-# Disable Bonjour, IPv6, epoll and kqueue
+# Disable Bonjour, IPv6 and libev
BEGIN {
- $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1;
- $ENV{MOJO_MODE} = 'testing';
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+ $ENV{MOJO_MODE} = 'testing';
}
use Test::More tests => 113;
@@ -3,10 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
+# Disable Bonjour, IPv6 and libev
BEGIN {
- $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1;
- $ENV{MOJO_MODE} = 'development';
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+ $ENV{MOJO_MODE} = 'development';
}
use Test::More tests => 32;
@@ -5,10 +5,11 @@ use warnings;
use utf8;
-# Disable Bonjour, IPv6, epoll and kqueue
+# Disable Bonjour, IPv6 and libev
BEGIN {
- $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1;
- $ENV{MOJO_MODE} = 'testing';
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+ $ENV{MOJO_MODE} = 'testing';
}
# "Who are you, and why should I care?"
@@ -3,8 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More tests => 24;
@@ -3,8 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More tests => 24;
@@ -5,8 +5,11 @@ use warnings;
use utf8;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More tests => 16;
@@ -5,10 +5,11 @@ use warnings;
use utf8;
-# Disable Bonjour, IPv6, epoll and kqueue
+# Disable Bonjour, IPv6 and libev
BEGIN {
- $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1;
- $ENV{MOJO_MODE} = 'testing';
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+ $ENV{MOJO_MODE} = 'testing';
}
# "Who are you, and why should I care?"
@@ -3,8 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More tests => 27;
@@ -5,10 +5,11 @@ use warnings;
use utf8;
-# Disable Bonjour, IPv6, epoll and kqueue
+# Disable Bonjour, IPv6 and libev
BEGIN {
- $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1;
- $ENV{MOJO_MODE} = 'development';
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+ $ENV{MOJO_MODE} = 'development';
}
use Test::More tests => 890;
@@ -3,8 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More tests => 113;
@@ -5,10 +5,11 @@ use warnings;
use utf8;
-# Disable Bonjour, IPv6, epoll and kqueue
+# Disable Bonjour, IPv6 and libev
BEGIN {
- $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1;
- $ENV{MOJO_MODE} = 'development';
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+ $ENV{MOJO_MODE} = 'development';
}
use Test::More tests => 9;
@@ -3,8 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More;
plan skip_all => 'Perl 5.10 or Pod::Simple required for this test!'
@@ -3,10 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
+# Disable Bonjour, IPv6 and libev
BEGIN {
- $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1;
- $ENV{MOJO_MODE} = 'production';
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+ $ENV{MOJO_MODE} = 'production';
}
use Test::More tests => 51;
@@ -3,8 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More tests => 6;
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use Test::More tests => 313;
+use Test::More tests => 330;
# "They're not very heavy, but you don't hear me not complaining."
use_ok 'Mojolicious::Routes';
@@ -32,6 +32,10 @@ $r->route('/alternatives/:foo', foo => [qw/0 test 23/])->to(foo => 11);
# /alternatives2/23
$r->route('/alternatives2/:foo', foo => [qw/0 test 23/]);
+# /alternatives3/foo
+# /alternatives3/foobar
+$r->route('/alternatives3/:foo', foo => [qw/foo foobar/]);
+
# /*/test
my $test = $r->route('/:controller/test')->to(action => 'test');
@@ -122,6 +126,10 @@ $r->route('/format7', format => 0)->to(controller => 'us', action => 'wow');
$r->route('/format8', format => 0)
->to(controller => 'us', action => 'doh', format => 'xml');
+# /format9.foo
+# /fomrat9.foobar
+$r->route('/format9', format => [qw/foo foobar/])->to('perl#rocks');
+
# /articles
# /articles.html
# /articles/1
@@ -244,6 +252,17 @@ is $m->path_for('alternatives2foo'), '/alternatives2', 'right path';
is $m->path_for('alternatives2foo', foo => 0), '/alternatives2/0',
'right path';
+# Alternatives with similar start
+$m = Mojolicious::Routes::Match->new(get => '/alternatives3/foo')->match($r);
+is $m->stack->[0]->{foo}, 'foo', 'right value';
+is @{$m->stack}, 1, 'right number of elements';
+is $m->path_for, '/alternatives3/foo', 'right path';
+$m =
+ Mojolicious::Routes::Match->new(get => '/alternatives3/foobar')->match($r);
+is $m->stack->[0]->{foo}, 'foobar', 'right value';
+is @{$m->stack}, 1, 'right number of elements';
+is $m->path_for, '/alternatives3/foobar', 'right path';
+
# Real world example using most features at once
$m = Mojolicious::Routes::Match->new(get => '/articles.html')->match($r);
is $m->stack->[0]->{controller}, 'articles', 'right value';
@@ -445,6 +464,8 @@ is $m->path_for(format => undef), '/format', 'right path';
is $m->path_for(format => 'html'), '/format.html', 'right path';
is $m->path_for(format => 'txt'), '/format.txt', 'right path';
is @{$m->stack}, 1, 'right number of elements';
+
+# Hardcoded format
$m = Mojolicious::Routes::Match->new(get => '/format2.html')->match($r);
is $m->stack->[0]->{controller}, 'you', 'right value';
is $m->stack->[0]->{action}, 'hello', 'right value';
@@ -457,6 +478,8 @@ is $m->stack->[0]->{action}, 'hello_json', 'right value';
is $m->stack->[0]->{format}, 'json', 'right value';
is $m->path_for, '/format2.json', 'right path';
is @{$m->stack}, 1, 'right number of elements';
+
+# Hardcoded format after placeholder
$m = Mojolicious::Routes::Match->new(GET => '/format3/baz.html')->match($r);
is $m->stack->[0]->{controller}, 'me', 'right value';
is $m->stack->[0]->{action}, 'bye', 'right value';
@@ -471,6 +494,8 @@ is $m->stack->[0]->{format}, 'json', 'right value';
is $m->stack->[0]->{foo}, 'baz', 'right value';
is $m->path_for, '/format3/baz.json', 'right path';
is @{$m->stack}, 1, 'right number of elements';
+
+# Format with regex constraint
$m = Mojolicious::Routes::Match->new(GET => '/format4')->match($r);
is @{$m->stack}, 0, 'right number of elements';
$m = Mojolicious::Routes::Match->new(GET => '/format4.txt')->match($r);
@@ -483,6 +508,8 @@ $m = Mojolicious::Routes::Match->new(GET => '/format4.html')->match($r);
is @{$m->stack}, 0, 'right number of elements';
$m = Mojolicious::Routes::Match->new(GET => '/format4.txt.txt')->match($r);
is @{$m->stack}, 0, 'right number of elements';
+
+# Format with constraint alternatives
$m = Mojolicious::Routes::Match->new(GET => '/format5')->match($r);
is @{$m->stack}, 0, 'right number of elements';
$m = Mojolicious::Routes::Match->new(GET => '/format5.txt')->match($r);
@@ -501,6 +528,8 @@ $m = Mojolicious::Routes::Match->new(GET => '/format5.html')->match($r);
is @{$m->stack}, 0, 'right number of elements';
$m = Mojolicious::Routes::Match->new(GET => '/format5.txt.txt')->match($r);
is @{$m->stack}, 0, 'right number of elements';
+
+# Format with constraint and default
$m = Mojolicious::Routes::Match->new(GET => '/format6')->match($r);
is $m->stack->[0]->{controller}, 'us', 'right value';
is $m->stack->[0]->{action}, 'yay', 'right value';
@@ -517,6 +546,8 @@ $m = Mojolicious::Routes::Match->new(GET => '/format6.txt')->match($r);
is @{$m->stack}, 0, 'right number of elements';
$m = Mojolicious::Routes::Match->new(GET => '/format6.txt.html')->match($r);
is @{$m->stack}, 0, 'right number of elements';
+
+# Forbidden format
$m = Mojolicious::Routes::Match->new(GET => '/format7')->match($r);
is $m->stack->[0]->{controller}, 'us', 'right value';
is $m->stack->[0]->{action}, 'wow', 'right value';
@@ -525,6 +556,8 @@ is $m->path_for, '/format7', 'right path';
is @{$m->stack}, 1, 'right number of elements';
$m = Mojolicious::Routes::Match->new(GET => '/format7.html')->match($r);
is @{$m->stack}, 0, 'right number of elements';
+
+# Forbidden format and default
$m = Mojolicious::Routes::Match->new(GET => '/format8')->match($r);
is $m->stack->[0]->{controller}, 'us', 'right value';
is $m->stack->[0]->{action}, 'doh', 'right value';
@@ -534,6 +567,22 @@ is @{$m->stack}, 1, 'right number of elements';
$m = Mojolicious::Routes::Match->new(GET => '/format8.xml')->match($r);
is @{$m->stack}, 0, 'right number of elements';
+# Formats with similar start
+$m = Mojolicious::Routes::Match->new(GET => '/format9.foo')->match($r);
+is $m->stack->[0]->{controller}, 'perl', 'right value';
+is $m->stack->[0]->{action}, 'rocks', 'right value';
+is $m->stack->[0]->{format}, 'foo', 'right value';
+is $m->path_for, '/format9.foo', 'right path';
+is @{$m->stack}, 1, 'right number of elements';
+$m = Mojolicious::Routes::Match->new(GET => '/format9.foobar')->match($r);
+is $m->stack->[0]->{controller}, 'perl', 'right value';
+is $m->stack->[0]->{action}, 'rocks', 'right value';
+is $m->stack->[0]->{format}, 'foobar', 'right value';
+is $m->path_for, '/format9.foobar', 'right path';
+is @{$m->stack}, 1, 'right number of elements';
+$m = Mojolicious::Routes::Match->new(GET => '/format9.foobarbaz')->match($r);
+is @{$m->stack}, 0, 'right number of elements';
+
# Request methods
$m = Mojolicious::Routes::Match->new(get => '/method/get.html')->match($r);
is $m->stack->[0]->{controller}, 'method', 'right value';
@@ -3,8 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More tests => 45;
@@ -3,10 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
+# Disable Bonjour, IPv6 and libev
BEGIN {
- $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1;
- $ENV{MOJO_MODE} = 'testing';
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+ $ENV{MOJO_MODE} = 'testing';
}
use Test::More tests => 26;
@@ -3,23 +3,28 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More;
-use Mojo::IOLoop;
+use Mojo::IOLoop::Server;
+use Mojo::IOLoop::Stream;
plan skip_all => 'set TEST_TLS to enable this test (developer only!)'
unless $ENV{TEST_TLS};
plan skip_all => 'IO::Socket::SSL 1.43 required for this test!'
- unless Mojo::IOLoop::TLS;
+ unless Mojo::IOLoop::Server::TLS;
plan skip_all => 'Windows is too fragile for this test!'
- if Mojo::IOLoop::WINDOWS;
+ if Mojo::IOLoop::Stream::WINDOWS;
plan tests => 18;
# "Look at these low, low prices on famous brand-name electronics!
# Don't be a sap, Dad. These are just crappy knockoffs.
# Pfft. I know a genuine Panaphonics when I see it.
# And look, there's a Magnetbox and Sorny."
+use Mojo::IOLoop;
use Mojo::UserAgent;
use Mojolicious::Lite;
use Test::Mojo;
@@ -3,8 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More;
plan skip_all => 'Perl 5.10 required for this test!'
@@ -5,8 +5,11 @@ use warnings;
use utf8;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More;
plan skip_all => 'Windows is too fragile for this test!'
@@ -3,8 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
# FreeBSD 8.0 and 8.1 are known to cause problems
use Test::More;
@@ -3,8 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More tests => 9;
@@ -3,23 +3,28 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More;
-use Mojo::IOLoop;
+use Mojo::IOLoop::Server;
+use Mojo::IOLoop::Stream;
plan skip_all => 'set TEST_TLS to enable this test (developer only!)'
unless $ENV{TEST_TLS};
plan skip_all => 'IO::Socket::SSL 1.43 required for this test!'
- unless Mojo::IOLoop::TLS;
+ unless Mojo::IOLoop::Server::TLS;
plan skip_all => 'Windows is too fragile for this test!'
- if Mojo::IOLoop::WINDOWS;
+ if Mojo::IOLoop::Stream::WINDOWS;
plan tests => 15;
# "I was a hero to broken robots 'cause I was one of them, but how can I sing
# about being damaged if I'm not?
# That's like Christina Aguilera singing Spanish.
# Ooh, wait! That's it! I'll fake it!"
+use Mojo::IOLoop;
use Mojo::Server::Daemon;
use Mojo::UserAgent;
use Mojolicious::Lite;