line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
our $AUTHORITY = 'cpan:YANICK'; |
2
|
|
|
|
|
|
|
# ABSTRACT: Reactive programming framework heavily inspired by JavaScript's MobX |
3
|
|
|
|
|
|
|
$MoobX::VERSION = '0.1.1'; |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
use 5.20.0; |
6
|
8
|
|
|
8
|
|
910727
|
|
|
8
|
|
|
|
|
106
|
|
7
|
|
|
|
|
|
|
use MoobX::Observer; |
8
|
8
|
|
|
8
|
|
3132
|
|
|
8
|
|
|
|
|
25
|
|
|
8
|
|
|
|
|
421
|
|
9
|
|
|
|
|
|
|
our @DEPENDENCIES; |
10
|
|
|
|
|
|
|
our $WATCHING = 0; |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
use Scalar::Util qw/ reftype refaddr /; |
13
|
8
|
|
|
8
|
|
52
|
use Moose::Util qw/ with_traits /; |
|
8
|
|
|
|
|
14
|
|
|
8
|
|
|
|
|
347
|
|
14
|
8
|
|
|
8
|
|
43
|
use Module::Runtime 'use_module'; |
|
8
|
|
|
|
|
12
|
|
|
8
|
|
|
|
|
48
|
|
15
|
8
|
|
|
8
|
|
1692
|
use Graph::Directed; |
|
8
|
|
|
|
|
14
|
|
|
8
|
|
|
|
|
54
|
|
16
|
8
|
|
|
8
|
|
3618
|
|
|
8
|
|
|
|
|
238358
|
|
|
8
|
|
|
|
|
247
|
|
17
|
|
|
|
|
|
|
use experimental 'signatures'; |
18
|
8
|
|
|
8
|
|
56
|
|
|
8
|
|
|
|
|
14
|
|
|
8
|
|
|
|
|
57
|
|
19
|
|
|
|
|
|
|
use parent 'Exporter::Tiny'; |
20
|
8
|
|
|
8
|
|
873
|
|
|
8
|
|
|
|
|
13
|
|
|
8
|
|
|
|
|
52
|
|
21
|
|
|
|
|
|
|
our @EXPORT = qw/ observer observable autorun :attributes :traits /; |
22
|
|
|
|
|
|
|
our %EXPORT_TAGS = ( |
23
|
|
|
|
|
|
|
'attributes' => [ '__ATTRIBUTES__' ], |
24
|
|
|
|
|
|
|
'traits' => [ '__TRAITS__' ], |
25
|
|
|
|
|
|
|
); |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
our $WARN_NO_DEPS = 1; |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
my ( $class, $name, $args, $globals ) = ( shift, @_ ); |
30
|
|
|
|
|
|
|
|
31
|
80
|
|
|
80
|
|
8000
|
if ( $name eq '__ATTRIBUTES__' ) { |
32
|
|
|
|
|
|
|
my $target = $globals->{into}; |
33
|
80
|
100
|
|
|
|
216
|
return if ref $target; |
|
|
100
|
|
|
|
|
|
34
|
16
|
|
|
|
|
35
|
local $@; |
35
|
16
|
50
|
|
|
|
117
|
eval qq{ |
36
|
16
|
|
|
|
|
25
|
package $target; |
37
|
8
|
50
|
|
8
|
|
50
|
use parent 'MoobX::Attributes'; |
|
8
|
|
|
8
|
|
12
|
|
|
8
|
|
|
|
|
48
|
|
|
8
|
|
|
|
|
49
|
|
|
8
|
|
|
|
|
13
|
|
|
8
|
|
|
|
|
38
|
|
|
16
|
|
|
|
|
1462
|
|
38
|
|
|
|
|
|
|
1; |
39
|
|
|
|
|
|
|
} or die $@; |
40
|
|
|
|
|
|
|
return; |
41
|
|
|
|
|
|
|
} |
42
|
16
|
|
|
|
|
92
|
elsif ( $name eq '__TRAITS__' ) { |
43
|
|
|
|
|
|
|
use_module( "MoobX::Trait::$_" ) for qw/ Observer Observable /; |
44
|
|
|
|
|
|
|
return; |
45
|
16
|
|
|
|
|
91
|
} |
46
|
16
|
|
|
|
|
458
|
|
47
|
|
|
|
|
|
|
return $class->SUPER::_exporter_expand_sub( $name, $args, $globals ); |
48
|
|
|
|
|
|
|
} |
49
|
48
|
|
|
|
|
126
|
|
50
|
|
|
|
|
|
|
our $graph = Graph::Directed->new; |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
my @preds = $graph->all_predecessors( refaddr $obs ); |
54
|
108
|
|
|
108
|
0
|
144
|
|
|
108
|
|
|
|
|
144
|
|
|
108
|
|
|
|
|
132
|
|
55
|
|
|
|
|
|
|
for my $pred ( @preds ) { |
56
|
108
|
|
|
|
|
450
|
my $info = $graph->get_vertex_attribute( |
57
|
|
|
|
|
|
|
$pred, 'info' |
58
|
108
|
|
|
|
|
77460
|
); |
59
|
32
|
|
|
|
|
137
|
|
60
|
|
|
|
|
|
|
local @MoobX::DEPENDENCIES = ( @MoobX::DEPENDENCIES, $obs ); |
61
|
|
|
|
|
|
|
$info->clear_value; |
62
|
|
|
|
|
|
|
} |
63
|
32
|
|
|
|
|
1719
|
} |
64
|
32
|
|
|
|
|
120
|
|
65
|
|
|
|
|
|
|
$graph->delete_edges( |
66
|
|
|
|
|
|
|
map { |
67
|
|
|
|
|
|
|
refaddr $self => $_ |
68
|
36
|
|
|
36
|
0
|
62
|
} $graph->successors(refaddr $self) |
|
36
|
|
|
|
|
54
|
|
|
36
|
|
|
|
|
55
|
|
|
36
|
|
|
|
|
43
|
|
69
|
|
|
|
|
|
|
); |
70
|
|
|
|
|
|
|
|
71
|
36
|
|
|
|
|
192
|
$graph->add_edges( |
|
51
|
|
|
|
|
1799
|
|
72
|
|
|
|
|
|
|
map { refaddr $self => refaddr $_ } @deps |
73
|
|
|
|
|
|
|
); |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
$graph->set_vertex_attribute( |
76
|
36
|
|
|
|
|
4335
|
refaddr $_, info => $_ |
|
167
|
|
|
|
|
390
|
|
77
|
|
|
|
|
|
|
) for $self, @deps; |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
observable_ref( @_ ); |
81
|
36
|
|
|
|
|
7540
|
} |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
my $ref = shift; |
84
|
|
|
|
|
|
|
|
85
|
11
|
|
|
11
|
1
|
752
|
my $type = reftype $ref; |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
my $class = 'MoobX::'. ucfirst lc $type || 'SCALAR'; |
88
|
|
|
|
|
|
|
|
89
|
31
|
|
|
31
|
0
|
63
|
$class = with_traits( |
90
|
|
|
|
|
|
|
map { use_module($_) } |
91
|
31
|
|
|
|
|
110
|
map { $_, $_ . '::Observable' } $class |
92
|
|
|
|
|
|
|
); |
93
|
31
|
|
50
|
|
|
187
|
|
94
|
|
|
|
|
|
|
if( $type eq 'SCALAR' ) { |
95
|
|
|
|
|
|
|
my $value = $$ref; |
96
|
62
|
|
|
|
|
748
|
tie $$ref, $class; |
97
|
31
|
|
|
|
|
112
|
$$ref = $value; |
|
31
|
|
|
|
|
117
|
|
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
elsif( $type eq 'ARRAY' ) { |
100
|
31
|
100
|
|
|
|
73188
|
my @values = @$ref; |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
101
|
9
|
|
|
|
|
387
|
tie @$ref, $class; |
102
|
9
|
|
|
|
|
65
|
@$ref = @values; |
103
|
9
|
|
|
|
|
4332
|
} |
104
|
|
|
|
|
|
|
elsif( $type eq 'HASH' ) { |
105
|
|
|
|
|
|
|
my %values = %$ref; |
106
|
17
|
|
|
|
|
49
|
tie %$ref, $class; |
107
|
17
|
|
|
|
|
89
|
%$ref = %values; |
108
|
17
|
|
|
|
|
9310
|
} |
109
|
|
|
|
|
|
|
elsif( not $type ) { |
110
|
|
|
|
|
|
|
my $value = $ref; |
111
|
5
|
|
|
|
|
18
|
tie $ref, $class; |
112
|
5
|
|
|
|
|
33
|
$ref = $value; |
113
|
5
|
|
|
|
|
3095
|
} |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
|
116
|
0
|
|
|
|
|
0
|
return $ref; |
117
|
0
|
|
|
|
|
0
|
|
118
|
0
|
|
|
|
|
0
|
} |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
1; |
122
|
31
|
|
|
|
|
267
|
|
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=pod |
125
|
|
|
|
|
|
|
|
126
|
6
|
|
|
6
|
1
|
690
|
=encoding UTF-8 |
127
|
4
|
|
|
4
|
1
|
96
|
|
128
|
|
|
|
|
|
|
=head1 NAME |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
MoobX - Reactive programming framework heavily inspired by JavaScript's MobX |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
=head1 VERSION |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
version 0.1.1 |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
=head1 SYNOPSIS |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
use 5.20.0; |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
use MoobX; |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
my $first_name :Observable; |
143
|
|
|
|
|
|
|
my $last_name :Observable; |
144
|
|
|
|
|
|
|
my $title :Observable; |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
my $address = observer { |
147
|
|
|
|
|
|
|
join ' ', $title || $first_name, $last_name; |
148
|
|
|
|
|
|
|
}; |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
say $address; # nothing |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
$first_name = "Yanick"; |
153
|
|
|
|
|
|
|
$last_name = "Champoux"; |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
say $address; # Yanick Champoux |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
$title = 'Dread Lord'; |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
say $address; # Dread Lord Champoux |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
=head1 DESCRIPTION |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
As I was learning how to use L<https://github.com/mobxjs/mobx|MobX>, I thought |
164
|
|
|
|
|
|
|
it'd be fun to try to implement something similar in Perl. So I did. |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
To set Moose object attributes to be observers or observables, take |
167
|
|
|
|
|
|
|
a gander at L<MoobX::Trait::Observable> and L<MoobX::Trait::Observer>. |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
To have an idea of the mechanics of MoobX, see the two blog entries in the SEE ALSO |
170
|
|
|
|
|
|
|
section. |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
This is also the early stages of life for this module. Consider everythign as alpha quality, |
173
|
|
|
|
|
|
|
and the API still subject to huge changes. |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
=head1 EXPORTED FUNCTIONS |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
The module automatically exports 3 functions: C<observer>, C<observable> and C<autorun>. |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
=head2 observable |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
observable my $foo; |
182
|
|
|
|
|
|
|
observable my @bar; |
183
|
|
|
|
|
|
|
observable my %quux; |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
Marks the variable as an observable, i.e. a variable which value can be |
186
|
|
|
|
|
|
|
watched by observers, which will be updated when it changes. |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
Under the hood, the variable is tied to the relevant L<MoobX::TYPE> class |
189
|
|
|
|
|
|
|
L<MoobX::TYPE::Observable> role. |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
If you want to declare the variable, assign it a value and set it as observable, |
192
|
|
|
|
|
|
|
there are a few good ways to do it, and one bad: |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
my $foo = 3; |
195
|
|
|
|
|
|
|
observable $foo; # good |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
observable( my $foo = 3 ); # good |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
observable my $foo; # good |
200
|
|
|
|
|
|
|
$foo = 3; |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
observable my $foo = 3; # bad |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
That last one doesn't work because Perl parses it as C<observable( my $foo ) = 3>, |
205
|
|
|
|
|
|
|
and assigning values to non I<lvalue>ed functions don't work. |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
Or, better, simply use the C<:Observable> attribute when you define the variable. |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
my $foo :Observable = 2; |
210
|
|
|
|
|
|
|
my @bar :Observable = 1..10; |
211
|
|
|
|
|
|
|
my %baz :Observable = ( a => 1, b => 2 ); |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
=head2 observer |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
observable my $quantity; |
216
|
|
|
|
|
|
|
observable my $price; |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
my $total = observer { |
219
|
|
|
|
|
|
|
$quantity * $price |
220
|
|
|
|
|
|
|
}; |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
$quantity = 2; |
223
|
|
|
|
|
|
|
$price = 6.00; |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
print $total; # 12 |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
Creates a L<MoobX::Observer> object. The value returned by the object will |
228
|
|
|
|
|
|
|
react to change to any C<observable> values within its definition. |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
Observers are lazy, meaning that they compute or recompute their values |
231
|
|
|
|
|
|
|
when they are accessed. If you want |
232
|
|
|
|
|
|
|
them to eagerly recompute their values, C<autorun> is what you want. |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
If an observer function is run and doesn't report any dependency, |
235
|
|
|
|
|
|
|
it'll emit the warning 'C<MoobX observer doesn't observe anything>', |
236
|
|
|
|
|
|
|
because chances are there's something weird going on. The warning can |
237
|
|
|
|
|
|
|
be silenced via the global variable C<$MoobX::WARN_NO_DEPS>. |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
my $foo :Observable; |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
my $debugging = 0; |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
# if $debugging == 1, we'd get a warning |
244
|
|
|
|
|
|
|
local $MoobX::WARN_NO_DEPS = 0; |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
my $spy = observer { |
247
|
|
|
|
|
|
|
return unless $debugging; |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
say $foo; |
250
|
|
|
|
|
|
|
}; |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
=head2 autorun |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
observable my $foo; |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
autorun { |
257
|
|
|
|
|
|
|
say "\$foo is now $foo"; |
258
|
|
|
|
|
|
|
}; |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
$foo = 1; # prints '$foo is now 1' |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
$foo = 2; # prints '$foo is now 2' |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
Like C<observer>, but immediatly recompute its value when its observable dependencies change. |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
=head1 SEE ALSO |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
=over |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
=item L<https://github.com/mobxjs/mobx|MobX> - the original inspiration |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
=item L<http://techblog.babyl.ca/entry/moobx> and L<http://techblog.babyl.ca/entry/moobx-2> - the two blog entries that introduced MobX. |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
=back |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
=head1 AUTHOR |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
Yanick Champoux <yanick@cpan.org> |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
This software is copyright (c) 2022, 2017 by Yanick Champoux. |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
285
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
=cut |