Commit f737956c4096b40c7d84e6ca509e04dfe2a387ee

Initial stab at Reflex::Callbacks with generic coderef callbacks.
eg/ThingWithCallbacks.pm
(40 / 0)
  
1package ThingWithCallbacks;
2use Moose;
3
4# A demo class that sends callbacks to its users. I wanted to go even
5# more abstract than Reflex::Timer, partly to reduce confusion over
6# the callbacks subproject's scope. Not all callback types are
7# appropriate for timers, too.
8
9use Reflex::Callbacks qw(gather_cb);
10
11has cb => ( is => 'rw', isa => 'Reflex::Callbacks' );
12
13# This is interesting code from Reflex::Timer.
14#has on_tick => (
15# isa => 'Reflex::Callback',
16# is => 'ro',
17# coerce => 1,
18# default => "tick",
19# default => sub {
20# my $self = shift;
21# Reflex::Callback::Emit->new(
22# object => $self,
23# event_name => "tick",
24# );
25# },
26#);
27
28sub BUILD {
29 my ($self, $arg) = @_;
30
31 # Gather the callbacks from the constructor parameters.
32 $self->cb(gather_cb($arg));
33}
34
35sub run {
36 my $self = shift;
37 $self->cb()->send( on_event => {} );
38}
39
401;
eg/eg-19-nonexistent.pl
(6 / 0)
  
1#!/usr/bin/env perl
2
3use warnings;
4use strict;
5
6die "$0 is intentionally nonexistent.\n";
eg/eg-20-rcb-coderef.pl
(60 / 0)
  
1#!/usr/bin/env perl
2
3# This example illustrates implicit and explicit callbacks via plain
4# coderefs. Coderef callbacks are clear and concise. They allow
5# developers to take advantage of closure tricks, including
6# implementing a form of continuation-passing style.
7#
8# They are less suitable for object-oriented programs. See most other
9# forms of Reflex::Callback for more object oriented callbacks.
10
11# Reflex::Callbacks and the Reflex::Callback helper classes will
12# abstract callbacks to fulfill the following goals:
13#
14# 1. A module's consumer decides how it will be called back.
15# 2. Module implementations will use a single interface that
16# represents the abstract notion of callbacks. Consumers' chosen
17# callback implementations will handle the rest.
18# 3. Every known form of callback will be supported, so that module
19# consumers aren't limited to a single, possibly undesirable
20# callback mechanism.
21# 4. Common callback mechanisms may be specified by concise,
22# contextual syntax.
23# 5. All callback mechanisms may be specified by slightly verbose but
24# unambiguous syntax.
25
26use warnings;
27use strict;
28use lib qw(../lib);
29
30use ExampleHelpers qw(eg_say);
31use Reflex::Callbacks qw(cb_coderef);
32use ThingWithCallbacks;
33
34# Create a thing that will invoke callbacks. This syntax uses
35# contextually specified coderef callbacks.
36
37my $thing_one = ThingWithCallbacks->new(
38 on_event => sub { eg_say("contextual callback invoked") },
39);
40
41$thing_one->run();
42
43# cb_coderef() reduces context sensitivity at the expense of
44# verbosity.
45
46my $thing_two = ThingWithCallbacks->new(
47 on_event => cb_coderef(sub { eg_say("explicit callback invoked") }),
48);
49
50$thing_two->run();
51
52# cb_coderef is prototyped so it can replace "sub".
53
54my $thing_three = ThingWithCallbacks->new(
55 on_event => cb_coderef { eg_say("explicit callback (no sub) invoked") },
56);
57
58$thing_three->run();
59
60exit;
lib/Reflex/Callback.pm
(5 / 0)
  
1package Reflex::Callback;
2
3use Moose;
4
51;
lib/Reflex/Callback/CodeRef.pm
(18 / 0)
  
1package Reflex::Callback::CodeRef;
2
3use Moose;
4extends 'Reflex::Callback';
5
6has code_ref => (
7 is => 'ro',
8 isa => 'CodeRef',
9 required => 1,
10);
11
12sub deliver {
13 my $self = shift;
14 $self->code_ref()->(@_);
15}
16
17
181;
lib/Reflex/Callbacks.pm
(135 / 0)
  
1package Reflex::Callbacks;
2
3# Reflex::Callbacks is a callback manager. It encapsulates the
4# callbacks for an object. Via send(), it maps event names to the
5# corresponding callbacks, then invokes them through the underlying
6# callback system.
7#
8# On another level, it makes sure all the callback classes are loaded
9# and relevant coercions are defined.
10#
11# TODO - Explore whether it's sensible for the underlying callback
12# system to be pluggable.
13
14use Moose;
15use Moose::Util::TypeConstraints;
16
17use Reflex::Callback;
18#use Reflex::Callback::Class;
19use Reflex::Callback::CodeRef;
20#use Reflex::Callback::Emit; # For current Reflex compatibility
21#use Reflex::Callback::Method;
22#use Reflex::Callback::Object;
23#use Reflex::Callback::Promise;
24#use Reflex::Callback::Role;
25
26use Exporter;
27use base qw(Exporter);
28our @EXPORT_OK = qw(
29 cb_class
30 cb_coderef
31 cb_method
32 cb_object
33 cb_promise
34 cb_role
35 gather_cb
36);
37
38use Carp qw(croak);
39
40has callback_map => (
41 is => 'rw',
42 isa => 'HashRef[Reflex::Callback]',
43 default => sub { {} },
44);
45
46coerce 'Reflex::Callback'
47 => from 'CodeRef'
48 => via { Reflex::Callback::CodeRef->new( code_ref => $_ ) };
49
50coerce 'Reflex::Callback'
51 => from 'Str'
52 => via {
53 Reflex::Callback::Method->new(
54 method_name => $_,
55 )
56 };
57
58coerce 'Reflex::Callback'
59 => from 'ArrayRef'
60 => via {
61 Reflex::Callback::Method->new(
62 object => $_->[0],
63 method_name => $_->[1],
64 )
65 };
66
67sub cb_method {
68 die;
69 my ($object, $method_name) = @_;
70 return Reflex::Callback::Method->new(
71 object => $object,
72 method_name => $method_name,
73 );
74}
75
76sub cb_object {
77 die;
78}
79
80sub cb_class {
81 die;
82}
83
84sub cb_role {
85 die;
86}
87
88sub cb_promise {
89 die;
90}
91
92sub cb_coderef (&) {
93 return Reflex::Callback::CodeRef->new(code_ref => shift);
94}
95
96sub gather_cb {
97 my ($arg, $match) = @_;
98 $match = qr/^on_/ unless defined $match;
99
100 my %return;
101
102 # TODO - Also analyze whether the value is a Reflex::Callack object.
103 foreach (grep /$match/, keys %$arg) {
104 die unless defined $arg->{$_};
105 my $callback = $arg->{$_};
106
107 if (blessed $callback) {
108 if ($callback->isa('Reflex::Callback')) {
109 $return{$_} = $callback;
110 next;
111 }
112
113 die "blessed callback $_";
114 }
115
116 # Unblessed callback types must be coerced.
117
118 if (ref($callback) eq "CODE") {
119 $return{$_} = Reflex::Callback::CodeRef->new(code_ref => $callback);
120 next;
121 }
122
123 die "unblessed callback $_";
124 }
125
126 return Reflex::Callbacks->new( callback_map => \%return );
127}
128
129sub send {
130 my ($self, $event, $arg) = @_;
131 $arg //= {};
132 $self->callback_map()->{$event}->deliver($arg);
133}
134
1351;