Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Commit experimental things for others to consider.

  • Loading branch information...
commit a94504ff16cdb05c11469e20c4dcd38b5eab9832 1 parent 4dba602
Rocco Caputo authored
83 eg/proto/Sidecar.pm
... ... @@ -0,0 +1,83 @@
  1 +package Sidecar;
  2 +# vim: ts=2 sw=2 noexpandtab
  3 +
  4 +# "Sidecar" is what I call a subprocess that handles a particular
  5 +# object. The analogy is to motorcycle sidecars.
  6 +
  7 +use warnings;
  8 +use strict;
  9 +
  10 +use Storable qw(nfreeze thaw);
  11 +
  12 +sub BUILD {
  13 + use IPC::Run qw(start);
  14 + use Symbol qw(gensym);
  15 +
  16 + my ($fh_in, $fh_out, $fh_err) = (gensym(), gensym(), gensym());
  17 +
  18 + my $ipc_run = start(
  19 + $cmd,
  20 + '<pipe', $fh_in,
  21 + '>pipe', $fh_out,
  22 + '2>pipe', $fh_err,
  23 + ) or die "IPC::Run start() failed: $? ($!)";
  24 +
  25 + return($ipc_run, $fh_in, $fh_out, $fh_err);
  26 +}
  27 +
  28 +sub _sidecar_drive {
  29 + my $self = shift;
  30 +
  31 + my $buffer = "";
  32 + my $read_length;
  33 +
  34 + binmode(STDIN);
  35 + binmode(STDOUT);
  36 + select STDOUT; $| = 1;
  37 +
  38 + use bytes;
  39 +
  40 + while (1) {
  41 + if (defined $read_length) {
  42 + if (length($buffer) >= $read_length) {
  43 + my $request = thaw(substr($buffer, 0, $read_length, ""));
  44 + $read_length = undef;
  45 +
  46 + my ($request_id, $context, $method, @args) = @$request;
  47 +
  48 + my $streamable;
  49 +
  50 + if ($context eq "array") {
  51 + my (@return) = eval { $self->$method(@args); };
  52 + $streamable = nfreeze( [ $request_id, $context, $@, @return ] );
  53 + }
  54 + elsif ($context eq "scalar") {
  55 + my $return = eval { $self->$method(@args); };
  56 + $streamable = nfreeze( [ $request_id, $context, $@, $return ] );
  57 + }
  58 + else {
  59 + eval { $self->$method(@args); undef; };
  60 + $streamable = nfreeze( [ $request_id, $context, $@ ] );
  61 + }
  62 +
  63 + my $stream = length($streamable) . chr(0) . $streamable;
  64 +
  65 + my $octets_wrote = syswrite(STDOUT, $stream);
  66 + die $! unless $octets_wrote == length($stream);
  67 +
  68 + next;
  69 + }
  70 + }
  71 + elsif ($buffer =~ s/^(\d+)\0//) {
  72 + $read_length = $1;
  73 + next;
  74 + }
  75 +
  76 + my $octets_read = sysread(STDIN, $buffer, 4096, length($buffer));
  77 + last unless $octets_read;
  78 + }
  79 +
  80 + exit 0;
  81 +}
  82 +
  83 +1;
22 eg/proto/eg-52-subclassed-timeout.pl
... ... @@ -0,0 +1,22 @@
  1 +#!/usr/bin/env perl
  2 +# vim: ts=2 sw=2 noexpandtab
  3 +
  4 +use warnings;
  5 +use strict;
  6 +use lib qw(./lib ../lib ./eg);
  7 +
  8 +{
  9 + package Foo;
  10 + use Moose;
  11 + extends 'Reflex::Timeout';
  12 + use ExampleHelpers qw(eg_say);
  13 +
  14 + sub on_done {
  15 + eg_say "custom got timeout";
  16 + $_[0]->reset();
  17 + }
  18 +}
  19 +
  20 +my $to = Foo->new(delay => 1);
  21 +Reflex->run_all();
  22 +exit;
107 eg/proto/eg-61-run-collection.pl
... ... @@ -0,0 +1,107 @@
  1 +# vim: ts=2 sw=2 noexpandtab
  2 +# This is a quick, one-off implementation of a one-shot worker pool.
  3 +# Give it some jobs, and it'll run them all in parallel. It will
  4 +# return results in the order of completion.
  5 +#
  6 +# It doesn't use the proposed collection promise.
  7 +# It doesn't limit simultaneous workers.
  8 +# It doesn't implement a generic Enterprise Integration Pattern.
  9 +# In short, it does almost nothing generically useful.
  10 +#
  11 +# It does, however, act as an example of Reflex::POE::Wheel::Run used
  12 +# for a practical purpose.
  13 +
  14 +use lib qw(../lib);
  15 +
  16 +# Start a parallel runner with a list of jobs.
  17 +# ParallelRunner's implementation is below.
  18 +
  19 +my $pr = ParallelRunner->new(
  20 + jobs => [
  21 + [ \&adder, 1, 2, 3 ],
  22 + [ \&multiplier, 4, 5, 6 ],
  23 + ]
  24 +);
  25 +
  26 +# Consume results until we're done.
  27 +
  28 +while (my $event = $pr->next()) {
  29 + use YAML;
  30 + print YAML::Dump($event->{arg}{result});
  31 +}
  32 +
  33 +exit;
  34 +
  35 +# Jobs to run.
  36 +
  37 +sub adder {
  38 + use Time::HiRes qw(sleep); sleep rand();
  39 +
  40 + my $accumulator = 0;
  41 + $accumulator += $_ foreach @_;
  42 + return [ adder => $accumulator ];
  43 +}
  44 +
  45 +sub multiplier {
  46 + use Time::HiRes qw(sleep); sleep rand();
  47 +
  48 + my $accumulator = 1;
  49 + $accumulator *= $_ foreach @_;
  50 + return [ multiplier => $accumulator ];
  51 +}
  52 +
  53 +# Implementation of the ParallelRunner.
  54 +
  55 +BEGIN {
  56 + package ParallelRunner;
  57 +
  58 + use Moose;
  59 + extends 'Reflex::Base';
  60 + use Reflex::Collection;
  61 + use Reflex::POE::Wheel::Run;
  62 + use Reflex::Callbacks;
  63 +
  64 + use POE::Filter::Line;
  65 + use POE::Filter::Reference;
  66 +
  67 + has jobs => (
  68 + isa => 'ArrayRef[ArrayRef]',
  69 + is => 'ro',
  70 + );
  71 +
  72 + has_many workers => ( handles => { remember_worker => "remember" } );
  73 +
  74 + sub BUILD {
  75 + my ($self, $args) = @_;
  76 +
  77 + foreach my $job (@{$self->jobs()}) {
  78 + my ($coderef, @parameters) = @$job;
  79 +
  80 + $self->remember_worker(
  81 + Reflex::POE::Wheel::Run->new(
  82 + Program => sub {
  83 + my $f = POE::Filter::Reference->new();
  84 + my $output = $f->put( [ $coderef->(@parameters) ] );
  85 + syswrite(STDOUT, $_) foreach @$output;
  86 + close STDOUT;
  87 + },
  88 + StdoutFilter => POE::Filter::Reference->new(),
  89 + cb_role($self, "child"),
  90 + )
  91 + );
  92 + }
  93 + }
  94 +
  95 + sub on_child_stderr {
  96 + warn "child reported: $_[1]{output}\n";
  97 + }
  98 +
  99 + sub on_child_stdout {
  100 + my ($self, $args) = @_;
  101 +
  102 + $self->emit(
  103 + event => 'result',
  104 + args => { result => $args->{output} },
  105 + );
  106 + }
  107 +}
45 eg/proto/leonerd-resolver-poe.pl
... ... @@ -0,0 +1,45 @@
  1 +#!/usr/bin/perl
  2 +# vim: ts=2 sw=2 noexpandtab
  3 +
  4 +use strict;
  5 +use warnings;
  6 +use feature qw( say );
  7 +
  8 +use Socket qw( AF_INET unpack_sockaddr_in inet_ntoa );
  9 +use Socket::GetAddrInfo qw( :newapi getaddrinfo );
  10 +
  11 +sub format_addr {
  12 + my ($port, $inaddr) = unpack_sockaddr_in $_[0];
  13 + sprintf "%s:%d", inet_ntoa($inaddr), $port;
  14 +}
  15 +
  16 +use POE qw( Session Kernel Wheel::ReadWrite Wheel::Run Filter::Reference );
  17 +
  18 +{
  19 + my $wheel_resolver;
  20 +
  21 + POE::Session->create(
  22 + inline_states => {
  23 + _start => sub {
  24 + $wheel_resolver = POE::Wheel::Run->new(
  25 + Program => sub {
  26 + my ($err, @addrs) =
  27 + getaddrinfo("localhost", "www", {family => AF_INET});
  28 + die "$err" if $err;
  29 + print @{POE::Filter::Reference->new->put([$addrs[0]])};
  30 + },
  31 + StdoutFilter => POE::Filter::Reference->new,
  32 + StdoutEvent => 'resolver_input',
  33 + StderrEvent => 'resolver_error',
  34 + );
  35 + },
  36 +
  37 + resolver_input =>
  38 + sub { say "POE resolved " . format_addr($_[ARG0]->{addr}) },
  39 + resolver_error => sub { say "POE resolver error $_[ARG0]" },
  40 + },
  41 + );
  42 +}
  43 +
  44 +POE::Kernel->run;
  45 +
22 eg/proto/sidecar.pl
... ... @@ -0,0 +1,22 @@
  1 +#!/usr/bin/env perl
  2 +# vim: ts=2 sw=2 noexpandtab
  3 +
  4 +use Moose;
  5 +use Sidecar;
  6 +
  7 +{
  8 + package BlockingService;
  9 +
  10 + use Moose;
  11 +
  12 + has counter => ( is => 'rw', isa => 'Int', default => 0 );
  13 +
  14 + sub next {
  15 + my $self = shift;
  16 +
  17 + return "pid($$) counter = " . $self->counter( $self->counter() + 1 );
  18 + }
  19 +}
  20 +
  21 +my $scbs = Sidecar->new(class => 'BlockingService');
  22 +
70 eg/proto/test-observer.pl
... ... @@ -0,0 +1,70 @@
  1 +#!/usr/bin/perl
  2 +# vim: ts=2 sw=2 noexpandtab
  3 +
  4 +use warnings;
  5 +use strict;
  6 +use lib qw(../lib);
  7 +
  8 +# Demonstrate how wheels may be encapsulated in thin,
  9 +# configuration-only subclasses.
  10 +
  11 +{
  12 + package Runner;
  13 + use Moose;
  14 + extends 'Reflex::Base';
  15 + use Reflex::POE::Wheel::Run;
  16 + use Reflex::Trait::Watched qw(watches);
  17 +
  18 + watches child => (
  19 + isa => 'Maybe[Reflex::POE::Wheel::Run]',
  20 + );
  21 +
  22 + sub BUILD {
  23 + my $self = shift;
  24 + $self->child(
  25 + Reflex::POE::Wheel::Run->new(
  26 + Program => "$^X -wle '\$|=1; while (<STDIN>) { chomp; print qq[pid(\$\$) moo(\$_)] } exit'",
  27 + )
  28 + );
  29 +
  30 + $self->child()->put("one", "two", "three", "last");
  31 + }
  32 +
  33 + sub on_child_stdin {
  34 + print "stdin flushed\n";
  35 + }
  36 +
  37 + sub on_child_stdout {
  38 + my ($self, $args) = @_;
  39 + print "stdout: $args->{output}\n";
  40 + $self->child()->kill() if $args->{output} =~ /moo\(last\)/;
  41 + }
  42 +
  43 + sub on_child_stderr {
  44 + my ($self, $args) = @_;
  45 + print "stderr: $args->{output}\n";
  46 + }
  47 +
  48 + sub on_child_error {
  49 + my ($self, $args) = @_;
  50 + return if $args->{operation} eq "read";
  51 + print "$args->{operation} error $args->{errnum}: $args->{errstr}\n";
  52 + }
  53 +
  54 + sub on_child_close {
  55 + my ($self, $args) = @_;
  56 + print "child closed all output\n";
  57 + }
  58 +
  59 + sub on_child_signal {
  60 + my ($self, $args) = @_;
  61 + print "child $args->{pid} exited: $args->{exit}\n";
  62 + $self->child(undef);
  63 + }
  64 +}
  65 +
  66 +# Main.
  67 +
  68 +my $runner = Runner->new();
  69 +Reflex->run_all();
  70 +exit;
47 lib/Reflex/Encoder/Line.pm
... ... @@ -0,0 +1,47 @@
  1 +package Reflex::Encoder::Line;
  2 +# vim: ts=2 sw=2 noexpandtab
  3 +
  4 +use Moose;
  5 +with 'Reflex::Role::Encoding';
  6 +use Reflex::Codec::Message;
  7 +
  8 +use Scalar::Util qw(blessed);
  9 +
  10 +has newline => ( is => 'rw', isa => 'Str', default => "\x0D\x0A" );
  11 +
  12 +# Data translation is lazy.
  13 +# Translation happens when data is shifted off the encoding buffer.
  14 +# The original data is available as long as possible.
  15 +# Protocol swapping requires this.
  16 +
  17 +
  18 +sub push_data {
  19 + my $self = shift;
  20 +
  21 + if (
  22 + $self->_has_messages() and
  23 + $self->messages()->[-1]->is_combinable()
  24 + ) {
  25 + $self->messages()->[-1]->append_data(@_);
  26 + return;
  27 + }
  28 +
  29 + $self->push_message(Reflex::Codec::Message::Stream->new(data => $_))
  30 + foreach @_;
  31 +
  32 + return;
  33 +}
  34 +
  35 +sub shift {
  36 + my $self = shift;
  37 +
  38 + return unless defined(my $next = $self->_shift());
  39 +
  40 + if (defined(my $next_data = $next->data())) {
  41 + $next->data($next_data . $self->newline());
  42 + }
  43 +
  44 + return $next;
  45 +}
  46 +
  47 +1;
23 lib/Reflex/Role/Decoding/Datagram.pm
... ... @@ -0,0 +1,23 @@
  1 +package Reflex::Role::Decoding::Datagram;
  2 +# vim: ts=2 sw=2 noexpandtab
  3 +
  4 +use Reflex::Role;
  5 +use Reflex::Codec::Message::Datagram;
  6 +
  7 +role {
  8 + my $p = shift;
  9 +
  10 + method push_datagram => sub {
  11 + my $self = shift;
  12 +
  13 + return unless @_;
  14 +
  15 + $self->push_message(
  16 + Reflex::Codec::Message::Datagram->new( octets => $_ )
  17 + ) foreach @_;
  18 +
  19 + return;
  20 + };
  21 +};
  22 +
  23 +1;
44 lib/Reflex/Role/Encoding.pm
... ... @@ -0,0 +1,44 @@
  1 +package Reflex::Role::Encoding;
  2 +# vim: ts=2 sw=2 noexpandtab
  3 +
  4 +use Reflex::Role;
  5 +use Reflex::Codec::Message;
  6 +use Reflex::Codec::Message::Eof;
  7 +
  8 +role {
  9 + my $p = shift;
  10 +
  11 + has buffer => (
  12 + is => 'rw',
  13 + isa => 'ArrayRef[Reflex::Codec::Message]',
  14 + traits => ['Array'],
  15 + default => sub { [] },
  16 + handles => {
  17 + _push => 'push',
  18 + _shift => 'shift',
  19 + _has_message => 'count',
  20 + },
  21 + );
  22 +
  23 + method push_eof => sub {
  24 + my $self = shift;
  25 + $self->push(Reflex::Codec::Message::Eof->new());
  26 + };
  27 +
  28 + method push_message => sub {
  29 + my ($self, $message) = @_;
  30 +
  31 + if (
  32 + $self->_has_message() and
  33 + $message->is_combinable() and
  34 + $self->messages()->[-1]->is_combinable()
  35 + ) {
  36 + $self->messages()->[-1]->absorb($message);
  37 + return;
  38 + }
  39 +
  40 + $self->_push($message);
  41 + };
  42 +};
  43 +
  44 +1;

0 comments on commit a94504f

Please sign in to comment.
Something went wrong with that request. Please try again.