Coro and Mojolicious

readme.txt

Coro patch for perl 5.22
http://code.activestate.com/lists/perl5-porters/228699/

Mojolicious::Plugin::Coro.pm

package Mojolicious::Plugin::Coro;
use Mojo::Base 'Mojolicious::Plugin';
use Coro;
use Mojo::IOLoop;

# Wrap application in coroutine and reschedule main coroutine in event loop
sub register {
  my ($self, $app) = @_;

  my $subscribers = $app->plugins->subscribers('around_dispatch');
  unshift @$subscribers, sub {
    my $next = shift;
    async { $next->() };
  };
  $app->plugins->unsubscribe('around_dispatch');
  $app->hook(around_dispatch => $_) for @$subscribers;

  Mojo::IOLoop->recurring(0 => sub {cede});
}

# Magical class for calling a method non-blocking without a callback and
# rescheduling the current coroutine until it is done
package with::coro;
use Coro;

sub AUTOLOAD {
  my ($method) = our $AUTOLOAD =~ /^with::coro::(.+)$/;
  my ($done, $err, @args);
  #shift->$method(@_ => sub { $done++; shift; $err = shift; @args = @_ }); # for Mojo::Pg
  shift->$method(@_ => sub { $done++; shift; @args = @_ }); # for Mojo::UserAgent
  cede until $done;
  die $err if $err;
  return wantarray ? @args : $args[0];
}

1;

pg.pl

use lib './lib';

use Mojolicious::Lite;
use Mojo::Pg;
use DDP;

plugin 'Coro';

helper pg => sub { state $pg = Mojo::Pg->new('postgresql://logioniz@/test') };

# Store and retrieve information non-blocking without using callbacks
get '/' => sub {
  my $c = shift;

  # Store information about current visitor
  my $res = $c->pg->db->with::coro::query('select * from bills');
  my $users = $res->hashes // [];

  $res = $c->pg->db->with::coro::query('select * from warehouses');
  my $carts = $res->hashes // [];

  $c->render(json => {users => $users, carts => $carts});
};

app->start;

ua.pl

use lib './lib';

use Mojolicious::Lite;
use Mojo::Pg;
use DDP;
use Mojo::UserAgent;
use Mojo::IOLoop;

plugin 'Coro';

helper pg => sub { state $pg = Mojo::Pg->new('postgresql://logioniz@/test') };

# Store and retrieve information non-blocking without using callbacks
get '/' => sub {
  my $c = shift;

  my $tx = $c->ua->with::coro::get('https://www.google.ru');
  if (my $err = $tx->error) {
    die $err->{code} ? "$err->{code} response: $err->{message}" : "Connection error: $err->{message}";
  }

  $c->render(data => $tx->res->body);
};

app->start;