File Coverage

blib/lib/MoobX.pm
Criterion Covered Total %
statement 76 79 96.2
branch 11 16 68.7
condition 1 2 50.0
subroutine 17 17 100.0
pod 3 6 50.0
total 108 120 90.0


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