Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Add "emits" and "observes" attribute declarations.

"emits" is a shortcut for Reflex::Trait::EmitsOnChange.  "observes" is
a shortcut for Reflex::Trait::Observed.  Names and locations may change.
  • Loading branch information...
commit 6eae87cc7b55520bb6803d6ce52176927611b8b4 1 parent 134c7e0
Rocco Caputo rcaputo authored
18 TODO
View
@@ -1,17 +1 @@
-Current hot, outstanding TODOs:
-
----
-
-Coderef callbacks require $self of the object calling them.
-Otherwise, how do they invoke methods on that object?
-I've done a half-baked implementation, but it needs:
-
- Testing.
- Examples and such modified.
- Document modifications.
- Release Reflex 0.080 since it's a big leap.
- Alert people that the world has changed slightly.
-
----
-
-For a larger, longer-term list of todos, please see docs/TODO.otl.
+A complete list of TODOs is in docs/TODO.otl.
2  dist.ini
View
@@ -1,5 +1,5 @@
name = Reflex
-version = 0.072
+version = 0.080
author = Rocco Caputo <rcaputo@cpan.org>
license = Perl_5
copyright_holder = Rocco Caputo
5 eg/eg-05-composition.pl
View
@@ -13,16 +13,15 @@
use Moose;
extends 'Reflex::Base';
use Reflex::UdpPeer;
+ use Reflex::Trait::Observed qw(observes);
has port => (
isa => 'Int',
is => 'ro',
);
- has peer => (
+ observes peer => (
isa => 'Maybe[Reflex::UdpPeer]',
- is => 'rw',
- traits => ['Reflex::Trait::Observed'],
setup => sub {
my $self = shift;
Reflex::UdpPeer->new(
4 eg/eg-08-observer-trait.pl
View
@@ -14,10 +14,8 @@
use Reflex::POE::Wheel::Run;
use Reflex::Trait::Observed;
- has child => (
- traits => ['Reflex::Trait::Observed'],
+ observes child => (
isa => 'Maybe[Reflex::POE::Wheel::Run]',
- is => 'rw',
);
sub BUILD {
23 eg/eg-09-emitter-trait.pl
View
@@ -11,21 +11,11 @@
use Moose;
extends 'Reflex::Base';
use Reflex::Interval;
- use Reflex::Trait::Observed;
use Reflex::Trait::EmitsOnChange;
+ use Reflex::Trait::Observed;
- has count => (
- traits => ['Reflex::Trait::EmitsOnChange'],
- isa => 'Int',
- is => 'rw',
- default => 0,
- );
-
- has ticker => (
- traits => ['Reflex::Trait::Observed'],
- isa => 'Maybe[Reflex::Interval]',
- is => 'rw',
- );
+ emits count => ( isa => 'Int', default => 0 );
+ observes ticker => ( isa => 'Maybe[Reflex::Interval]' );
sub BUILD {
my $self = shift;
@@ -48,12 +38,9 @@
package Watcher;
use Moose;
extends 'Reflex::Base';
+ use Reflex::Trait::Observed;
- has counter => (
- traits => ['Reflex::Trait::Observed'],
- isa => 'Counter',
- is => 'rw',
- );
+ observes counter => ( isa => 'Counter' );
sub BUILD {
my $self = shift;
30 eg/eg-10-setup.pl
View
@@ -4,29 +4,24 @@
use strict;
use lib qw(../lib);
-# Exercise the new "setup" option for EmitsOnChange and Observed
-# traits.
+# Exercise the new "setup" option for emitters and observers.
{
package Counter;
use Moose;
extends 'Reflex::Base';
use Reflex::Interval;
- use Reflex::Trait::Observed;
use Reflex::Trait::EmitsOnChange;
+ use Reflex::Trait::Observed;
- has count => (
- traits => ['Reflex::Trait::EmitsOnChange'],
- isa => 'Int',
- is => 'rw',
- default => 0,
+ emits count => (
+ isa => 'Int',
+ default => 0,
);
- has ticker => (
- traits => ['Reflex::Trait::Observed'],
- isa => 'Reflex::Interval',
- is => 'rw',
- setup => sub {
+ observes ticker => (
+ isa => 'Reflex::Interval',
+ setup => sub {
Reflex::Interval->new( interval => 0.1, auto_repeat => 1 )
},
);
@@ -41,12 +36,11 @@
package Watcher;
use Moose;
extends 'Reflex::Base';
+ use Reflex::Trait::Observed;
- has counter => (
- traits => ['Reflex::Trait::Observed'],
- isa => 'Counter|Undef',
- is => 'rw',
- setup => sub { Counter->new() },
+ observes counter => (
+ isa => 'Counter|Undef',
+ setup => sub { Counter->new() },
);
sub on_counter_count {
10 eg/eg-13-irc-bot.pl
View
@@ -12,8 +12,8 @@
package Bot;
use Moose;
extends 'Reflex::Base';
- use Reflex::Trait::Observed;
use Reflex::POE::Session;
+ use Reflex::Trait::Observed;
use POE qw(Component::IRC);
@@ -22,11 +22,9 @@
is => 'rw',
);
- has poco_watcher => (
- isa => 'Reflex::POE::Session',
- is => 'rw',
- traits => ['Reflex::Trait::Observed'],
- role => 'poco',
+ observes poco_watcher => (
+ isa => 'Reflex::POE::Session',
+ role => 'poco',
);
sub BUILD {
9 eg/eg-14-synopsis.pl
View
@@ -9,12 +9,11 @@
use Moose;
extends 'Reflex::Base';
use Reflex::Interval;
+ use Reflex::Trait::Observed;
- has ticker => (
- isa => 'Reflex::Interval',
- is => 'rw',
- setup => { interval => 1, auto_repeat => 1 },
- traits => [ 'Reflex::Trait::Observed' ],
+ observes ticker => (
+ isa => 'Reflex::Interval',
+ setup => { interval => 1, auto_repeat => 1 },
);
sub on_ticker_tick {
5 eg/eg-37-ping-pong.pl
View
@@ -18,12 +18,11 @@
package Pinger;
use Moose;
extends 'Reflex::Base';
+ use Reflex::Trait::Observed;
- has echoer => (
- is => 'ro',
+ observes echoer => (
isa => 'Echoer',
default => sub { Echoer->new() },
- traits => ['Reflex::Trait::Observed'],
);
sub BUILD {
1  eg/eg-42-reflex-in-poe.pl
View
@@ -2,6 +2,7 @@
use warnings;
use strict;
+use lib qw(../lib);
my $rot13_server_port = 12345;
20 lib/Reflex.pm
View
@@ -53,12 +53,11 @@ Reflex - Class library for flexible, reactive programs.
use Moose;
extends 'Reflex::Base';
use Reflex::Interval;
+ use Reflex::Trait::Observed;
- has ticker => (
+ observes ticker => (
isa => 'Reflex::Interval',
- is => 'rw',
setup => { interval => 1, auto_repeat => 1 },
- traits => [ 'Reflex::Trait::Observed' ],
);
sub on_ticker_tick {
@@ -103,19 +102,18 @@ warnings, strict, and base instead. Reflex::Base provides emit().
}
The next object uses Echoer. It creates an Echoer and pings it to get
-started. It also reacts to "pong" events by pinging the Echoer again.
-Reflex::Trait::Observed implicitly watches the object in echoer(),
-mapping its "pong" event to the on_echoer_pong() method.
+started. It also reacts to "pong" events by pinging the Echoer again.
+Reflex::Trait::Observed (via its exported observes() declarative
+syntax) implicitly watches the object in echoer(), mapping its "pong"
+event to the on_echoer_pong() method.
package Pinger;
use Moose;
extends 'Reflex::Base';
- has echoer => (
- is => 'ro',
+ observes echoer => (
isa => 'Echoer',
default => sub { Echoer->new() },
- traits => ['Reflex::Trait::Observed'],
);
sub BUILD {
@@ -339,6 +337,10 @@ observable object attributes.
=back
+Reflex::Trait::EmitsOnchange exports a declarative emits() function
+that simplifies use of this trait. Likewise, Reflex::Trait::Observed
+exports observes() to simplify its use.
+
=head1 ASSISTANCE
Thank you for volunteering to assist with this project. You can find
5 lib/Reflex/Callback.pm
View
@@ -1,12 +1,11 @@
package Reflex::Callback;
use Moose;
-use Reflex::Base;
# It's a class if it's a Str.
has object => (
- is => 'ro',
- isa => 'Object|Str', # TODO - Reflex::Base|Str
+ is => 'rw',
+ isa => 'Object|Str',
weak_ref => 1,
);
21 lib/Reflex/Callbacks.pm
View
@@ -44,11 +44,12 @@ has callback_map => (
coerce 'Reflex::Callback'
=> from 'CodeRef'
- => via { Reflex::Callback::CodeRef->new( code_ref => $_ ) };
+ => via { die; Reflex::Callback::CodeRef->new( code_ref => $_ ) };
coerce 'Reflex::Callback'
=> from 'Str'
=> via {
+ die;
Reflex::Callback::Method->new(
method_name => $_,
)
@@ -57,6 +58,7 @@ coerce 'Reflex::Callback'
coerce 'Reflex::Callback'
=> from 'ArrayRef'
=> via {
+ die;
Reflex::Callback::Method->new(
object => $_->[0],
method_name => $_->[1],
@@ -133,7 +135,7 @@ sub cb_coderef (&) {
}
sub gather_cb {
- my ($arg, $match) = @_;
+ my ($owner, $arg, $match) = @_;
$match = qr/^on_/ unless defined $match;
my %return;
@@ -149,6 +151,7 @@ sub gather_cb {
}
if ($callback->isa('Reflex::Callback')) {
+ $callback->object($owner) unless $callback->object();
$return{$_} = $callback;
next;
}
@@ -159,7 +162,10 @@ sub gather_cb {
# Unblessed callback types must be coerced.
if (ref($callback) eq "CODE") {
- $return{$_} = Reflex::Callback::CodeRef->new(code_ref => $callback);
+ $return{$_} = Reflex::Callback::CodeRef->new(
+ object => $owner,
+ code_ref => $callback,
+ );
next;
}
@@ -392,9 +398,10 @@ The gather_cb() function extracts callbacks from an object's
constructor parameters and encapsulates them in a Reflex::Callbacks
object.
-gather_cb() takes two parameters: A hash reference containing a
-constructor's named parameters, and an optional regular expression to
-match callback parameter names. By default, gather_cb() will collect
+gather_cb() takes three parameters: The object that will own the
+callbacks, a hash reference containing a constructor's named
+parameters, and an optional regular expression to match callback
+parameter names. By default, gather_cb() will collect
parameters matching C</^on_/>.
package ThingWithCallbacks;
@@ -406,7 +413,7 @@ parameters matching C</^on_/>.
sub BUILD {
my ($self, $arg) = @_;
- $self->cb(gather_cb($arg));
+ $self->cb(gather_cb($self, $arg));
}
sub run {
5 lib/Reflex/Client.pm
View
@@ -10,6 +10,7 @@ use Reflex::Stream;
extends 'Reflex::Connector';
with 'Reflex::Role::Collectible';
+use Reflex::Trait::Observed;
has protocol => (
is => 'rw',
@@ -17,10 +18,8 @@ has protocol => (
default => 'Reflex::Stream',
);
-has connection => (
- is => 'rw',
+observes connection => (
isa => 'Maybe[Reflex::Stream]',
- traits => ['Reflex::Trait::Observed'],
# Maps $self->put() to $self->connection()->put().
# TODO - Would be nice to have something like this for outbout
# events. See on_connection_data() later in this module for more.
8 lib/Reflex/PID.pm
View
@@ -40,11 +40,9 @@ Reflex::PID - Observe the exit of a subprocess by its SIGCHLD signal.
use Reflex::PID;
- has pid_watcher => (
- isa => 'Reflex::PID|Undef',
- is => 'rw',
- traits => ['Reflex::Trait::Observed'],
- role => 'process',
+ observes pid_watcher => (
+ isa => 'Reflex::PID|Undef',
+ role => 'process',
);
sub some_method {
17 lib/Reflex/POE/Wheel/Run.pm
View
@@ -2,6 +2,8 @@ package Reflex::POE::Wheel::Run;
use Moose;
extends 'Reflex::POE::Wheel';
use POE::Wheel::Run;
+use Reflex::PID;
+use Reflex::Trait::Observed;
# These are class methods, returning static class data.
# TODO - What's the proper way to do this with Moose?
@@ -82,12 +84,9 @@ sub valid_params {
# Also handle signals.
-use Reflex::PID;
-has sigchild_watcher => (
- isa => 'Reflex::PID|Undef',
- is => 'rw',
- traits => ['Reflex::Trait::Observed'],
- role => 'sigchld',
+observes sigchild_watcher => (
+ isa => 'Reflex::PID|Undef',
+ role => 'sigchld',
);
sub BUILD {
@@ -127,10 +126,8 @@ the synopsis at this time. Please see eg-07-wheel-run.pl and
eg-08-observer-trait.pl in the distribution's eg directory for longer
but fully executable ones.
- has child => (
- traits => ['Reflex::Trait::Observed'],
- isa => 'Reflex::POE::Wheel::Run|Undef',
- is => 'rw',
+ observes child => (
+ isa => 'Reflex::POE::Wheel::Run|Undef',
);
sub BUILD {
3  lib/Reflex/Role/Reactive.pm
View
@@ -250,7 +250,7 @@ after BUILD => sub {
if (ref($value) eq "CODE") {
$value = Reflex::Callback::CodeRef->new(
object => $self,
- code_ref => $value
+ code_ref => $value,
);
}
@@ -329,6 +329,7 @@ sub _stop_watchers {
}
delete $self->watchers()->{$watcher} unless (
+ exists $self->watchers()->{$watcher} and
@{$self->watchers()->{$watcher}}
);
}
29 lib/Reflex/Trait/EmitsOnChange.pm
View
@@ -2,6 +2,9 @@ package Reflex::Trait::EmitsOnChange;
use Moose::Role;
use Scalar::Util qw(weaken);
+use Moose::Exporter;
+Moose::Exporter->setup_import_methods( with_caller => [ qw( emits ) ]);
+
has setup => (
isa => 'CodeRef|HashRef',
is => 'ro',
@@ -33,7 +36,7 @@ has trigger => (
#
#$last_value = $value;
#weaken $last_value if defined($last_value) and ref($last_value);
-
+warn $self;
$self->emit(
args => {
value => $value,
@@ -78,6 +81,16 @@ has event => (
},
);
+### EmitsOnChanged declarative syntax.
+
+sub emits {
+ my ($caller, $name, %etc) = @_;
+ my $meta = Class::MOP::class_of($caller);
+ push @{$etc{traits}}, __PACKAGE__;
+ $etc{is} = 'rw' unless exists $etc{is};
+ $meta->add_attribute($name, %etc);
+}
+
package Moose::Meta::Attribute::Custom::Trait::Reflex::Trait::EmitsOnChange;
sub register_implementation { 'Reflex::Trait::EmitsOnChange' }
@@ -99,6 +112,13 @@ Reflex::Trait::EmitsOnChange - Emit an event when an attribute's value changes.
extends 'Reflex::Base';
use Reflex::Trait::EmitsOnChange;
+ emits count => (
+ isa => 'Int',
+ default => 0,
+ );
+
+An equivalent alternative:
+
has count => (
traits => ['Reflex::Trait::EmitsOnChange'],
isa => 'Int',
@@ -133,6 +153,13 @@ attribute. In the above example, clock() will by default contain
In other words, it will emit the Reflex::Interval event ("tick") once
per second until destroyed.
+=head1 Declarative Syntax
+
+Reflex::Trait::EmitsOnChange exports a declarative emits() function,
+which acts almost identically to Moose's has() but with a couple
+convenient defaults: The EmitsOnChange trait is added, and the
+attribute is "rw" to allow changes.
+
=head1 CAVEATS
The "setup" option is a work-around for unfortunate default timing.
32 lib/Reflex/Trait/Observed.pm
View
@@ -3,6 +3,9 @@ use Moose::Role;
use Scalar::Util qw(weaken);
use Reflex::Callbacks qw(cb_role);
+use Moose::Exporter;
+Moose::Exporter->setup_import_methods( with_caller => [ qw( observes ) ]);
+
has setup => (
isa => 'CodeRef|HashRef',
is => 'ro',
@@ -27,16 +30,22 @@ has trigger => (
# part of a clearer method. Currently we rely on the object
# destructing on clear, which also triggers ignore().
- return unless defined $value;
+ my $name = $meta_self->name();
+
+ # Previous value? Stop watching that.
+ $self->ignore($self->$name()) if $self->$name();
+
+ # No new value? We're done.
+ return unless $value;
$self->watch(
$value,
cb_role(
$self,
- $role ||=
- $self->meta->find_attribute_by_name($meta_self->name())->role()
+ $role ||= $self->meta->find_attribute_by_name($name)->role()
)
);
+ return;
}
}
);
@@ -98,6 +107,16 @@ has setup => (
# },
#);
+### Observed declarative syntax.
+
+sub observes {
+ my ($caller, $name, %etc) = @_;
+ my $meta = Class::MOP::class_of($caller);
+ push @{$etc{traits}}, __PACKAGE__;
+ $etc{is} = 'rw' unless exists $etc{is};
+ $meta->add_attribute($name, %etc);
+}
+
package Moose::Meta::Attribute::Custom::Trait::Reflex::Trait::Observed;
sub register_implementation { 'Reflex::Trait::Observed' }
@@ -151,6 +170,13 @@ on_clock_tick() method to handle "tick" events from an object with the
The "role" option allows roles to be set or overridden. A watcher
attribute's name is its default role.
+=head1 Declarative Syntax
+
+Reflex::Trait::Observed exports a declarative observes() function,
+which acts almost identically to Moose's has() but with a couple
+convenient defaults: The Observed trait is added, and the attribute is
+given "rw" access by default.
+
=head1 CAVEATS
The "setup" option is a work-around for unfortunate default timing.
4 lib/Reflex/UdpPeer.pm
View
@@ -64,10 +64,8 @@ Use it as a helper.
has port => ( isa => 'Int', is => 'ro' );
- has peer => (
+ observes peer => (
isa => 'Maybe[Reflex::UdpPeer]',
- is => 'rw',
- traits => ['Reflex::Trait::Observed'],
setup => sub {
my $self = shift;
Reflex::UdpPeer->new(
39 t/920-rcb-coderef.t
View
@@ -31,33 +31,50 @@ use warnings;
use strict;
use lib qw(t/lib);
-use Test::More tests => 4;
+use Test::More tests => 7;
use Reflex::Callbacks qw(cb_coderef);
use ThingWithCallbacks;
-# Create a thing that will invoke callbacks. This syntax uses
-# contextually specified coderef callbacks.
+# Create a thing that will invoke callbacks.
+# This syntax uses contextually specified coderef callbacks.
+# Circular reference on $thing_one leaks memory.
-my $thing_one = ThingWithCallbacks->new(
- on_event => sub { pass("contextual callback invoked") },
+my $thing_one;
+$thing_one = ThingWithCallbacks->new(
+ on_event => sub {
+ pass("contextual callback invoked");
+ is($_[0], $thing_one, "contextual callback got self");
+ },
);
$thing_one->run();
# cb_coderef() reduces context sensitivity at the expense of
# verbosity.
-
-my $thing_two = ThingWithCallbacks->new(
- on_event => cb_coderef(sub { pass("explicit callback invoked") }),
+# Circular reference on $thing_two leaks memory.
+
+my $thing_two;
+$thing_two = ThingWithCallbacks->new(
+ on_event => cb_coderef(
+ sub {
+ is($_[0], $thing_two, "explicit callback got self");
+ pass("explicit callback invoked");
+ }
+ ),
);
$thing_two->run();
# cb_coderef is prototyped so it can replace "sub".
-
-my $thing_three = ThingWithCallbacks->new(
- on_event => cb_coderef { pass("explicit callback (no sub) invoked") },
+# Circular reference on $thing_three leaks memory.
+
+my $thing_three;
+$thing_three = ThingWithCallbacks->new(
+ on_event => cb_coderef {
+ is($_[0], $thing_three, "explicit callback (no sub) got self");
+ pass("explicit callback (no sub) invoked");
+ },
);
$thing_three->run();
7 t/925-rcb-promise.t
View
@@ -26,19 +26,18 @@ use Test::More tests => 3;
extends 'Reflex::Base';
use Reflex::Interval;
use Reflex::Callbacks qw(gather_cb);
+ use Reflex::Trait::Observed;
- has ticker => (
+ observes ticker => (
isa => 'Reflex::Interval',
- is => 'rw',
setup => { interval => 1, auto_repeat => 1 },
- traits => [ 'Reflex::Trait::Observed' ],
);
has cb => ( is => 'rw', isa => 'Reflex::Callbacks' );
sub BUILD {
my ($self, $arg) = @_;
- $self->cb(gather_cb($arg));
+ $self->cb(gather_cb($self, $arg));
}
sub on_ticker_tick {
2  t/lib/ThingWithCallbacks.pm
View
@@ -29,7 +29,7 @@ sub BUILD {
my ($self, $arg) = @_;
# Gather the callbacks from the constructor parameters.
- $self->cb(gather_cb($arg));
+ $self->cb(gather_cb($self, $arg));
}
sub run {
Please sign in to comment.
Something went wrong with that request. Please try again.