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.2';
4              
5             use 5.20.0;
6 8     8   878607  
  8         104  
7             use MoobX::Observer;
8 8     8   2925  
  8         26  
  8         464  
9             our @DEPENDENCIES;
10             our $WATCHING = 0;
11              
12             use Scalar::Util qw/ reftype refaddr /;
13 8     8   63 use Moose::Util qw/ with_traits /;
  8         16  
  8         419  
14 8     8   39 use Module::Runtime 'use_module';
  8         15  
  8         65  
15 8     8   2087 use Graph::Directed;
  8         17  
  8         52  
16 8     8   4278  
  8         234845  
  8         291  
17             use experimental 'signatures';
18 8     8   83  
  8         16  
  8         82  
19             use parent 'Exporter::Tiny';
20 8     8   1237  
  8         18  
  8         71  
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   9013 if ( $name eq '__ATTRIBUTES__' ) {
32             my $target = $globals->{into};
33 80 100       281 return if ref $target;
    100          
34 16         37 local $@;
35 16 50       117 eval qq{
36 16         33 package $target;
37 8 50   8   60 use parent 'MoobX::Attributes';
  8     8   13  
  8         60  
  8         55  
  8         14  
  8         57  
  16         1530  
38             1;
39             } or die $@;
40             return;
41             }
42 16         121 elsif ( $name eq '__TRAITS__' ) {
43             use_module( "MoobX::Trait::$_" ) for qw/ Observer Observable /;
44             return;
45 16         133 }
46 16         520  
47             return $class->SUPER::_exporter_expand_sub( $name, $args, $globals );
48             }
49 48         146  
50             our $graph = Graph::Directed->new;
51              
52              
53             my @preds = $graph->all_predecessors( refaddr $obs );
54 108     108 0 153  
  108         184  
  108         124  
55             for my $pred ( @preds ) {
56 108         485 my $info = $graph->get_vertex_attribute(
57             $pred, 'info'
58 108         79417 );
59 32         141  
60             local @MoobX::DEPENDENCIES = ( @MoobX::DEPENDENCIES, $obs );
61             $info->clear_value;
62             }
63 32         1826 }
64 32         116  
65             $graph->delete_edges(
66             map {
67             refaddr $self => $_
68 36     36 0 54 } $graph->successors(refaddr $self)
  36         55  
  36         89  
  36         47  
69             );
70              
71 36         218 $graph->add_edges(
  51         1894  
72             map { refaddr $self => refaddr $_ } @deps
73             );
74              
75             $graph->set_vertex_attribute(
76 36         4567 refaddr $_, info => $_
  167         397  
77             ) for $self, @deps;
78             }
79              
80             observable_ref( @_ );
81 36         7802 }
82              
83             my $ref = shift;
84              
85 11     11 1 823 my $type = reftype $ref;
86              
87             my $class = 'MoobX::'. ucfirst lc $type || 'SCALAR';
88              
89 31     31 0 95 $class = with_traits(
90             map { use_module($_) }
91 31         135 map { $_, $_ . '::Observable' } $class
92             );
93 31   50     206  
94             if( $type eq 'SCALAR' ) {
95             my $value = $$ref;
96 62         820 tie $$ref, $class;
97 31         78 $$ref = $value;
  31         122  
98             }
99             elsif( $type eq 'ARRAY' ) {
100 31 100       79244 my @values = @$ref;
    100          
    50          
    0          
101 9         24 tie @$ref, $class;
102 9         67 @$ref = @values;
103 9         4508 }
104             elsif( $type eq 'HASH' ) {
105             my %values = %$ref;
106 17         55 tie %$ref, $class;
107 17         90 %$ref = %values;
108 17         9870 }
109             elsif( not $type ) {
110             my $value = $ref;
111 5         23 tie $ref, $class;
112 5         51 $ref = $value;
113 5         3405 }
114              
115              
116 0         0 return $ref;
117 0         0  
118 0         0 }
119              
120              
121             1;
122 31         283  
123              
124             =pod
125              
126 6     6 1 682 =encoding UTF-8
127 4     4 1 121  
128             =head1 NAME
129              
130             MoobX - Reactive programming framework heavily inspired by JavaScript's MobX
131              
132             =head1 VERSION
133              
134             version 0.1.2
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<https://techblog.babyl.ca/entry/moobx> and L<https://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