File Coverage

blib/lib/Reflex/Trait/Watched.pm
Criterion Covered Total %
statement 19 19 100.0
branch 1 2 50.0
condition n/a
subroutine 6 6 100.0
pod 0 1 0.0
total 26 28 92.8


line stmt bran cond sub pod time code
1             package Reflex::Trait::Watched;
2             $Reflex::Trait::Watched::VERSION = '0.100';
3             # vim: ts=2 sw=2 noexpandtab
4              
5 8     8   6594 use Moose::Role;
  8         12  
  8         60  
6 8     8   30740 use Scalar::Util qw(weaken);
  8         13  
  8         478  
7 8     8   43 use Reflex::Callbacks qw(cb_role);
  8         10  
  8         72  
8              
9 8     8   2319 use Moose::Exporter;
  8         104  
  8         37  
10             Moose::Exporter->setup_import_methods( with_caller => [ qw( watches ) ]);
11              
12             has setup => (
13             isa => 'CodeRef|HashRef',
14             is => 'ro',
15             );
16              
17             has trigger => (
18             is => 'ro',
19             default => sub {
20             my $meta_self = shift;
21              
22             # $meta_self->name() is not set yet.
23             # Weaken $meta_self so that the closure isn't fatal.
24             # TODO - If we can get the name out here, then we save a name()
25             # method call every trigger.
26             weaken $meta_self;
27             my $role;
28              
29             sub {
30             my ($self, $value) = @_;
31              
32             # TODO - Ignore the object when we're set to undef. Probably
33             # part of a clearer method. Currently we rely on the object
34             # destructing on clear, which also triggers ignore().
35              
36             my $name = $meta_self->name();
37              
38             # Previous value? Stop watching that.
39             $self->ignore($self->$name()) if $self->$name();
40              
41             # No new value? We're done.
42             return unless $value;
43              
44             $self->watch(
45             $value,
46             cb_role(
47             $self,
48             $role ||= $self->meta->find_attribute_by_name($name)->role()
49             )
50             );
51             return;
52             }
53             }
54             );
55              
56             # Initializer seems to catch the interest from default. Nifty!
57              
58             has initializer => (
59             is => 'ro',
60             default => sub {
61             my $role;
62             return sub {
63             my ($self, $value, $callback, $attr) = @_;
64             if (defined $value) {
65             $self->watch(
66             $value,
67             cb_role(
68             $self,
69             $role ||=
70             $self->meta->find_attribute_by_name($attr->name())->role()
71             ),
72             );
73             }
74             else {
75             # TODO - Ignore the object in the old value, if defined.
76             }
77              
78             $callback->($value);
79             }
80             },
81             );
82              
83             has role => (
84             isa => 'Str',
85             is => 'ro',
86             lazy => 1,
87             default => sub {
88             my $self = shift;
89             return $self->name();
90             },
91             );
92              
93             has setup => (
94             isa => 'CodeRef|HashRef',
95             is => 'ro',
96             );
97              
98             # TODO - Clearers don't invoke triggers, because clearing is different
99             # from setting. I would love to support $self->clear_thingy() with
100             # the side-effect of ignoring the object, but I don't yet know how
101             # to set an "after" method for a clearer that (a) has a dynamic name,
102             # and (b) hasn't yet been defined. I think I can do some meta magic
103             # for (a), but (b) remains tough.
104              
105             #has clearer => (
106             # isa => 'Str',
107             # is => 'ro',
108             # default => sub {
109             # my $self = shift;
110             # return "clear_" . $self->name();
111             # },
112             #);
113              
114             ### Watched declarative syntax.
115              
116             sub watches {
117 6     6 0 7673 my ($caller, $name, %etc) = @_;
118 6         22 my $meta = Class::MOP::class_of($caller);
119 6         31 push @{$etc{traits}}, __PACKAGE__;
  6         17  
120 6 50       25 $etc{is} = 'rw' unless exists $etc{is};
121 6         27 $meta->add_attribute($name, %etc);
122             }
123              
124             package Moose::Meta::Attribute::Custom::Trait::Reflex::Trait::Watched;
125             $Moose::Meta::Attribute::Custom::Trait::Reflex::Trait::Watched::VERSION = '0.100';
126 4     4   1353 sub register_implementation { 'Reflex::Trait::Watched' }
127              
128             1;
129              
130             __END__
131              
132             =pod
133              
134             =encoding UTF-8
135              
136             =for :stopwords Rocco Caputo
137              
138             =head1 NAME
139              
140             Reflex::Trait::Watched - Automatically watch Reflex objects.
141              
142             =head1 VERSION
143              
144             This document describes version 0.100, released on April 02, 2017.
145              
146             =head1 SYNOPSIS
147              
148             # Not a complete program. This example comes from Reflex's main
149             # L<synopsis|Reflex/SYNOPSIS>.
150              
151             has clock => (
152             isa => 'Reflex::Interval',
153             is => 'rw',
154             traits => [ 'Reflex::Trait::Watched' ],
155             setup => { interval => 1, auto_repeat => 1 },
156             );
157              
158             =head1 DESCRIPTION
159              
160             Reflex::Trait::Watched modifies a member to automatically watch() any
161             Reflex::Base object stored within it. In the SYNOPSIS, storing a
162             Reflex::Interval in the clock() attribute allows the owner to watch the
163             timer's events.
164              
165             This trait is a bit of Moose-based syntactic sugar for Reflex::Base's
166             more explict watch() and watch_role() methods.
167              
168             =head2 setup
169              
170             The "setup" option provides default constructor parameters for the
171             attribute. In the above example, clock() will by default contain
172              
173             Reflex::Interval->new(interval => 1, auto_repeat => 1);
174              
175             In other words, it will emit the Reflex::Interval event ("tick") once
176             per second until destroyed.
177              
178             =head2 role
179              
180             Attribute events are mapped to the owner's methods using Reflex's
181             role-based callback convention. For example, Reflex will look for an
182             on_clock_tick() method to handle "tick" events from an object with the
183             'clock" role.
184              
185             The "role" option allows roles to be set or overridden. A watcher
186             attribute's name is its default role.
187              
188             =for Pod::Coverage watches
189              
190             =head1 Declarative Syntax
191              
192             Reflex::Trait::Watched exports a declarative watches() function,
193             which acts almost identically to Moose's has() but with a couple
194             convenient defaults: The Watched trait is added, and the attribute is
195             given "rw" access by default.
196              
197             =head1 CAVEATS
198              
199             The "setup" option is a work-around for unfortunate default timing.
200             It will be deprecated if default can be made to work instead.
201              
202             =head1 SEE ALSO
203              
204             Please see those modules/websites for more information related to this module.
205              
206             =over 4
207              
208             =item *
209              
210             L<Reflex|Reflex>
211              
212             =item *
213              
214             L<Reflex>
215              
216             =item *
217              
218             L<Reflex::Trait::EmitsOnChange>
219              
220             =item *
221              
222             L<Reflex/ACKNOWLEDGEMENTS>
223              
224             =item *
225              
226             L<Reflex/ASSISTANCE>
227              
228             =item *
229              
230             L<Reflex/AUTHORS>
231              
232             =item *
233              
234             L<Reflex/BUGS>
235              
236             =item *
237              
238             L<Reflex/BUGS>
239              
240             =item *
241              
242             L<Reflex/CONTRIBUTORS>
243              
244             =item *
245              
246             L<Reflex/COPYRIGHT>
247              
248             =item *
249              
250             L<Reflex/LICENSE>
251              
252             =item *
253              
254             L<Reflex/TODO>
255              
256             =back
257              
258             =head1 BUGS AND LIMITATIONS
259              
260             You can make new bug reports, and view existing ones, through the
261             web interface at L<http://rt.cpan.org/Public/Dist/Display.html?Name=Reflex>.
262              
263             =head1 AUTHOR
264              
265             Rocco Caputo <rcaputo@cpan.org>
266              
267             =head1 COPYRIGHT AND LICENSE
268              
269             This software is copyright (c) 2017 by Rocco Caputo.
270              
271             This is free software; you can redistribute it and/or modify it under
272             the same terms as the Perl 5 programming language system itself.
273              
274             =head1 AVAILABILITY
275              
276             The latest version of this module is available from the Comprehensive Perl
277             Archive Network (CPAN). Visit L<http://www.perl.com/CPAN/> to find a CPAN
278             site near you, or see L<https://metacpan.org/module/Reflex/>.
279              
280             =head1 DISCLAIMER OF WARRANTY
281              
282             BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
283             FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT
284             WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER
285             PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND,
286             EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
287             IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
288             PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
289             SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME
290             THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION.
291              
292             IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
293             WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
294             REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE
295             TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR
296             CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
297             SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
298             RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
299             FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
300             SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
301             DAMAGES.
302              
303             =cut