File Coverage

blib/lib/Ryu/Observable.pm
Criterion Covered Total %
statement 65 91 71.4
branch 8 14 57.1
condition 3 9 33.3
subroutine 22 34 64.7
pod 13 13 100.0
total 111 161 68.9


line stmt bran cond sub pod time code
1             package Ryu::Observable;
2              
3 1     1   72796 use strict;
  1         6  
  1         24  
4 1     1   4 use warnings;
  1         2  
  1         20  
5              
6 1     1   485 use utf8;
  1         12  
  1         4  
7              
8             our $VERSION = '3.001'; # VERSION
9             our $AUTHORITY = 'cpan:TEAM'; # AUTHORITY
10              
11             =encoding utf8
12              
13             =head1 NAME
14              
15             Ryu::Observable - plus ça change
16              
17             =head1 SYNOPSIS
18              
19             # Set initial value
20             my $observed = Ryu::Observable->new(123)
21             # and a callback for any changes
22             ->subscribe(sub { print "New value, is now: $_\n" });
23             # Basic numeric increment/decrement should trigger a notification
24             ++$observed;
25             # To assign a new value, use ->set_numeric or ->set_string
26             $observed->set_numeric(88);
27              
28             =head1 DESCRIPTION
29              
30             Simple monitorable variables.
31              
32             =cut
33              
34             use overload
35 1     1   4 '""' => sub { shift->as_string },
36 1     1   28 '0+' => sub { shift->as_number },
37 1     1   6 '++' => sub { my $v = ++$_[0]->{value}; $_[0]->notify_all; $v },
  1         4  
  1         2  
38 0     0   0 '--' => sub { my $v = --$_[0]->{value}; $_[0]->notify_all; $v },
  0         0  
  0         0  
39 7     7   29 'bool' => sub { !!shift->{value} },
40 1     1   1145 fallback => 1;
  1         777  
  1         9  
41              
42 1     1   93 use Scalar::Util;
  1         1  
  1         25  
43 1     1   463 use List::UtilsBy;
  1         1569  
  1         35  
44              
45 1     1   472 use Ryu::Source;
  1         2  
  1         75  
46              
47             # Slightly odd way of applying this - we don't want to require Sentinel,
48             # but the usual tricks of ->import or using *Sentinel::sentinel directly
49             # only work for the pure-perl version. So, we try to load it, making the
50             # syntax available, and we then use sentinel() as if it were a function...
51             # providing a fallback *sentinel only when the load failed.
52             BEGIN {
53             eval {
54 1         163 require Sentinel;
55 0         0 Sentinel->import;
56 0         0 1
57 1 50   1   3 } or do {
58 1     0   754 *sentinel = sub { die 'This requires the Sentinel module to be installed' };
  0         0  
59             }
60             }
61              
62             =head1 METHODS
63              
64             Public API, such as it is.
65              
66             =head2 as_string
67              
68             Returns the string representation of this value.
69              
70             =cut
71              
72 1     1 1 5 sub as_string { '' . shift->{value} }
73              
74             =head2 as_number
75              
76             =head2 as_numeric
77              
78             Returns the numeric representation of this value.
79              
80             (this method is available as C or C, both operate the same way)
81              
82             =cut
83              
84 1     1 1 5 sub as_number { 0 + shift->{value} }
85              
86             *as_numeric = *as_number;
87              
88             =head2 new
89              
90             Instantiates with the given value.
91              
92             my $observed = Ryu::Observable->new('whatever');
93              
94             =cut
95              
96 8     8 1 7583 sub new { bless { value => $_[1] }, $_[0] }
97              
98             =head2 subscribe
99              
100             Requests notifications when the value changes.
101              
102             my $observed = Ryu::Observable->new('whatever')
103             ->subscribe(sub { print "New value - $_\n" });
104              
105             =cut
106              
107 1     1 1 38 sub subscribe { my $self = shift; push @{$self->{subscriptions}}, @_; $self }
  1         3  
  1         5  
  1         2  
108              
109             =head2 unsubscribe
110              
111             Removes an existing callback.
112              
113             my $code;
114             my $observed = Ryu::Observable->new('whatever')
115             ->subscribe($code = sub { print "New value - $_\n" })
116             ->set_string('test')
117             ->unsubscribe($code);
118              
119             =cut
120              
121             sub unsubscribe {
122 0     0 1 0 my ($self, @code) = @_;
123 0         0 for my $addr (map Scalar::Util::refaddr($_), @code) {
124 0     0   0 List::UtilsBy::extract_by { Scalar::Util::refaddr($_) == $addr } @{$self->{subscriptions}};
  0         0  
  0         0  
125             }
126             $self
127 0         0 }
128              
129             =head2 set
130              
131             Sets the value to the given scalar, then notifies all subscribers (regardless
132             of whether the value has changed or not).
133              
134             =cut
135              
136 1     1 1 283 sub set { my ($self, $v) = @_; $self->{value} = $v; $self->notify_all }
  1         2  
  1         3  
137              
138             =head2 value
139              
140             Returns the raw value.
141              
142             =cut
143              
144 0     0 1 0 sub value { shift->{value} }
145              
146             =head2 set_numeric
147              
148             =head2 set_number
149              
150             Applies a new numeric value, and notifies subscribers if the value is numerically
151             different to the previous one (or if we had no previous value).
152              
153             Returns C<$self>.
154              
155             (this method is available as C or C, both operate the same way)
156              
157             =cut
158              
159             sub set_numeric {
160 0     0 1 0 my ($self, $v) = @_;
161 0         0 my $prev = $self->{value};
162 0 0 0     0 return $self if defined($prev) && $prev == $v;
163 0         0 $self->{value} = $v;
164 0         0 $self->notify_all
165             }
166              
167             *set_number = *set_numeric;
168              
169             =head2 set_string
170              
171             Applies a new string value, and notifies subscribers if the value stringifies to a
172             different value than the previous one (or if we had no previous value).
173              
174             Returns C<$self>.
175              
176             =cut
177              
178             sub set_string {
179 1     1 1 3 my ($self, $v) = @_;
180 1         3 my $prev = $self->{value};
181 1 50 33     7 return $self if defined($prev) && $prev eq $v;
182 1         2 $self->{value} = $v;
183 1         3 $self->notify_all
184             }
185              
186             =head2 source
187              
188             Returns a L, which will emit each new value
189             until the observable is destroyed.
190              
191             =cut
192              
193             sub source {
194 2     2 1 8 my ($self) = @_;
195 2   66     11 $self->{source} //= do {
196 1         7 my $src = Ryu::Source->new;
197 1         4 Scalar::Util::weaken(my $copy = $self);
198             $src->completed->on_ready(sub {
199 1 50   1   129 delete $copy->{source} if $copy
200 1         6 });
201 1         67 $src;
202             };
203             }
204              
205             =head1 LVALUE METHODS
206              
207             B<< These require L to be installed >>.
208              
209             =head2 lvalue_str
210              
211             Returns a L lvalue accessor for the string value.
212              
213             This can be used with refaliasing or C loops to reduce typing:
214              
215             for($observable->lvalue_str) {
216             chomp;
217             s/_/-/g;
218             }
219              
220             Any attempt to retrieve or set the value will be redirected to L
221             or L as appropriate.
222              
223             =cut
224              
225             sub lvalue_str : lvalue {
226 0     0 1 0 my ($self) = @_;
227             sentinel(get => sub {
228 0     0   0 return $self->as_string(shift);
229             }, set => sub {
230 0     0   0 return $self->set_string(shift);
231 0         0 });
232             }
233              
234             =head2 lvalue_num
235              
236             Returns a L lvalue accessor for the numeric value.
237              
238             This can be used with refaliasing or C loops to reduce typing:
239              
240             for($observable->lvalue_num) {
241             ++$_;
242             $_ *= 3;
243             }
244              
245             Any attempt to retrieve or set the value will be redirected to L
246             or L as appropriate.
247              
248             =cut
249              
250             sub lvalue_num : lvalue {
251 0     0 1 0 my ($self) = @_;
252             sentinel(get => sub {
253 0     0   0 return $self->as_number(shift);
254             }, set => sub {
255 0     0   0 return $self->set_number(shift);
256 0         0 });
257             }
258              
259             =head1 METHODS - Internal
260              
261             Don't use these.
262              
263             =head2 notify_all
264              
265             Notifies all currently-subscribed callbacks with the current value.
266              
267             =cut
268              
269             sub notify_all {
270 3     3 1 7 my $self = shift;
271 3         18 my $v = $self->{value};
272 3 100       14 $self->{source}->emit($v) if $self->{source};
273 3         5 for my $sub (@{$self->{subscriptions}}) {
  3         6  
274 2         8 $sub->($_) for $v;
275             }
276             $self
277 3         2006 }
278              
279             sub DESTROY {
280 8     8   2395 my ($self) = @_;
281 8 50       26 return if ${^GLOBAL_PHASE} eq 'DESTRUCT';
282 8 100       17 if(my $src = $self->{source}) {
283 1         4 $src->finish;
284             }
285 8         12 delete $self->{value};
286 8         26 return;
287             }
288              
289             1;
290              
291             __END__