File Coverage

blib/lib/Mars/Mixin.pm
Criterion Covered Total %
statement 72 98 73.4
branch 17 20 85.0
condition 13 21 61.9
subroutine 14 28 50.0
pod 6 6 100.0
total 122 173 70.5


line stmt bran cond sub pod time code
1             package Mars::Mixin;
2              
3 4     7   6970 use 5.018;
  4         12  
4              
5 4     4   15 use strict;
  4         9  
  4         70  
6 4     4   19 use warnings;
  4         5  
  4         229  
7              
8             # IMPORT
9              
10             sub import {
11 6     6   1884 my ($self, @args) = @_;
12              
13 6         14 my $from = caller;
14              
15 6         1462 require Mars::Kind::Mixin;
16              
17 4     4   18 no strict 'refs';
  4         8  
  4         135  
18 4     4   23 no warnings 'redefine';
  4         15  
  4         164  
19 4     4   19 no warnings 'once';
  4         5  
  4         3321  
20              
21 6 100       66 my %exports = map +($_,$_), @args ? @args : qw(
22             attr
23             base
24             false
25             from
26             mixin
27             role
28             test
29             true
30             with
31             );
32              
33 6         13 @{"${from}::ISA"} = 'Mars::Kind::Mixin';
  6         92  
34              
35 6 50 33     32 if ($exports{"attr"} && !*{"${from}::attr"}{"CODE"}) {
  6         46  
36 6     3   31 *{"${from}::attr"} = sub {@_ = ($from, @_); goto \&attr};
  6     3   19  
  3         10  
  3         7  
37             }
38 6 100 66     24 if ($exports{"base"} && !*{"${from}::base"}{"CODE"}) {
  5         24  
39 5     0   18 *{"${from}::base"} = sub {@_ = ($from, @_); goto \&base};
  5     0   13  
  0         0  
  0         0  
40             }
41 6 50       7 if (!*{"${from}::false"}{"CODE"}) {
  6         22  
42 6     0   24 *{"${from}::false"} = sub {require Mars; Mars::false()};
  6     0   14  
  0         0  
  0         0  
43             }
44 6 100 66     18 if ($exports{"from"} && !*{"${from}::from"}{"CODE"}) {
  5         36  
45 5     0   14 *{"${from}::from"} = sub {@_ = ($from, @_); goto \&from};
  5     0   19  
  0         0  
  0         0  
46             }
47 6 100 66     18 if ($exports{"mixin"} && !*{"${from}::mixin"}{"CODE"}) {
  5         18  
48 5     1   12 *{"${from}::mixin"} = sub {@_ = ($from, @_); goto \&mixin};
  5     1   17  
  1         5  
  1         3  
49             }
50 6 100 66     15 if ($exports{"role"} && !*{"${from}::role"}{"CODE"}) {
  5         31  
51 5     1   14 *{"${from}::role"} = sub {@_ = ($from, @_); goto \&role};
  5         12  
  0         0  
  0         0  
52             }
53 6 100 66     37 if ($exports{"test"} && !*{"${from}::test"}{"CODE"}) {
  5         18  
54 5     0   18 *{"${from}::test"} = sub {@_ = ($from, @_); goto \&test};
  5         11  
  0         0  
  0         0  
55             }
56 6 50       11 if (!*{"${from}::true"}{"CODE"}) {
  6         30  
57 6     0   14 *{"${from}::true"} = sub {require Mars; Mars::true()};
  6     0   13  
  0         0  
  0         0  
58             }
59 6 100 66     18 if ($exports{"with"} && !*{"${from}::with"}{"CODE"}) {
  5         29  
60 5     0   21 *{"${from}::with"} = sub {@_ = ($from, @_); goto \&test};
  5         11  
  0         0  
  0         0  
61             }
62              
63 6         12 ${"${from}::META"} = {};
  6         15  
64              
65 6         439 return $self;
66             }
67              
68             sub attr {
69 3     3 1 5 my ($from, @args) = @_;
70              
71 3         11 $from->ATTR(@args);
72              
73 3         30 return $from;
74             }
75              
76             sub base {
77 0     0 1 0 my ($from, @args) = @_;
78              
79 0         0 $from->BASE(@args);
80              
81 0         0 return $from;
82             }
83              
84             sub from {
85 0     0 1 0 my ($from, @args) = @_;
86              
87 0         0 $from->FROM(@args);
88              
89 0         0 return $from;
90             }
91              
92             sub mixin {
93 1     1 1 2 my ($from, @args) = @_;
94              
95 1         5 $from->MIXIN(@args);
96              
97 1         7 return $from;
98             }
99              
100             sub role {
101 0     0 1   my ($from, @args) = @_;
102              
103 0           $from->ROLE(@args);
104              
105 0           return $from;
106             }
107              
108             sub test {
109 0     0 1   my ($from, @args) = @_;
110              
111 0           $from->TEST(@args);
112              
113 0           return $from;
114             }
115              
116             1;
117              
118              
119              
120             =head1 NAME
121              
122             Mars::Mixin - Mixin Declaration
123              
124             =cut
125              
126             =head1 ABSTRACT
127              
128             Mixin Declaration for Perl 5
129              
130             =cut
131              
132             =head1 SYNOPSIS
133              
134             package Person;
135              
136             use Mars::Class 'attr';
137              
138             attr 'fname';
139             attr 'lname';
140              
141             package Identity;
142              
143             use Mars::Mixin 'attr';
144              
145             attr 'id';
146             attr 'login';
147             attr 'password';
148              
149             sub EXPORT {
150             # explicitly declare routines to be consumed
151             ['id', 'login', 'password']
152             }
153              
154             package Authenticable;
155              
156             use Mars::Role;
157              
158             sub authenticate {
159             return true;
160             }
161              
162             sub AUDIT {
163             my ($self, $from) = @_;
164             # ensure the caller has a login and password when consumed
165             die "${from} missing the login attribute" if !$from->can('login');
166             die "${from} missing the password attribute" if !$from->can('password');
167             }
168              
169             sub BUILD {
170             my ($self, $data) = @_;
171             $self->{auth} = undef;
172             return $self;
173             }
174              
175             sub EXPORT {
176             # explicitly declare routines to be consumed
177             ['authenticate']
178             }
179              
180             package User;
181              
182             use Mars::Class;
183              
184             base 'Person';
185              
186             mixin 'Identity';
187              
188             attr 'email';
189              
190             test 'Authenticable';
191              
192             sub valid {
193             my ($self) = @_;
194             return $self->login && $self->password ? true : false;
195             }
196              
197             package main;
198              
199             my $user = User->new(
200             fname => 'Elliot',
201             lname => 'Alderson',
202             );
203              
204             # bless({fname => 'Elliot', lname => 'Alderson'}, 'User')
205              
206             =cut
207              
208             =head1 DESCRIPTION
209              
210             This package provides a mixin builder which when used causes the consumer to
211             inherit from L which provides mixin building and lifecycle
212             L. A mixin can do almost everything that a role can do but
213             differs from a L<"role"|Mars::Role> in that whatever routines are declared
214             using L<"export"|Mars::Kind/EXPORT> will be exported and will overwrite
215             routines of the same name in the consumer.
216              
217             =cut
218              
219             =head1 FUNCTIONS
220              
221             This package provides the following functions:
222              
223             =cut
224              
225             =head2 attr
226              
227             attr(Str $name) (Str)
228              
229             The attr function creates attribute accessors for the calling package. This
230             function is always exported unless a routine of the same name already exists.
231              
232             I>
233              
234             =over 4
235              
236             =item attr example 1
237              
238             package Example;
239              
240             use Mars::Class;
241              
242             attr 'name';
243              
244             # "Example"
245              
246             =back
247              
248             =cut
249              
250             =head2 base
251              
252             base(Str $name) (Str)
253              
254             The base function registers one or more base classes for the calling package.
255             This function is always exported unless a routine of the same name already
256             exists.
257              
258             I>
259              
260             =over 4
261              
262             =item base example 1
263              
264             package Entity;
265              
266             use Mars::Class;
267              
268             sub output {
269             return;
270             }
271              
272             package Example;
273              
274             use Mars::Class;
275              
276             base 'Entity';
277              
278             # "Example"
279              
280             =back
281              
282             =cut
283              
284             =head2 false
285              
286             false() (Bool)
287              
288             The false function returns a falsy boolean value which is designed to be
289             practically indistinguishable from the conventional numerical C<0> value. This
290             function is always exported unless a routine of the same name already exists.
291              
292             I>
293              
294             =over 4
295              
296             =item false example 1
297              
298             package Example;
299              
300             use Mars::Class;
301              
302             my $false = false;
303              
304             # 0
305              
306             =back
307              
308             =over 4
309              
310             =item false example 2
311              
312             package Example;
313              
314             use Mars::Class;
315              
316             my $true = !false;
317              
318             # 1
319              
320             =back
321              
322             =cut
323              
324             =head2 from
325              
326             from(Str $name) (Str)
327              
328             The from function registers one or more base classes for the calling package
329             and performs an L<"audit"|Mars::Kind/AUDIT>. This function is always exported
330             unless a routine of the same name already exists.
331              
332             I>
333              
334             =over 4
335              
336             =item from example 1
337              
338             package Entity;
339              
340             use Mars::Role;
341              
342             attr 'startup';
343             attr 'shutdown';
344              
345             sub EXPORT {
346             ['startup', 'shutdown']
347             }
348              
349             package Record;
350              
351             use Mars::Class;
352              
353             sub AUDIT {
354             my ($self, $from) = @_;
355             die "Missing startup" if !$from->can('startup');
356             die "Missing shutdown" if !$from->can('shutdown');
357             }
358              
359             package Example;
360              
361             use Mars::Class;
362              
363             with 'Entity';
364              
365             from 'Record';
366              
367             # "Example"
368              
369             =back
370              
371             =cut
372              
373             =head2 mixin
374              
375             mixin(Str $name) (Str)
376              
377             The mixin function registers and consumes mixins for the calling package. This
378             function is always exported unless a routine of the same name already exists.
379              
380             I>
381              
382             =over 4
383              
384             =item mixin example 1
385              
386             package YesNo;
387              
388             use Mars::Mixin;
389              
390             sub no {
391             return 0;
392             }
393              
394             sub yes {
395             return 1;
396             }
397              
398             sub EXPORT {
399             ['no', 'yes']
400             }
401              
402             package Example;
403              
404             use Mars::Class;
405              
406             mixin 'YesNo';
407              
408             # "Example"
409              
410             =back
411              
412             =cut
413              
414             =head2 role
415              
416             role(Str $name) (Str)
417              
418             The role function registers and consumes roles for the calling package. This
419             function is always exported unless a routine of the same name already exists.
420              
421             I>
422              
423             =over 4
424              
425             =item role example 1
426              
427             package Ability;
428              
429             use Mars::Role;
430              
431             sub action {
432             return;
433             }
434              
435             package Example;
436              
437             use Mars::Class;
438              
439             role 'Ability';
440              
441             # "Example"
442              
443             =back
444              
445             =over 4
446              
447             =item role example 2
448              
449             package Ability;
450              
451             use Mars::Role;
452              
453             sub action {
454             return;
455             }
456              
457             sub EXPORT {
458             return ['action'];
459             }
460              
461             package Example;
462              
463             use Mars::Class;
464              
465             role 'Ability';
466              
467             # "Example"
468              
469             =back
470              
471             =cut
472              
473             =head2 test
474              
475             test(Str $name) (Str)
476              
477             The test function registers and consumes roles for the calling package and
478             performs an L<"audit"|Mars::Kind/AUDIT>, effectively allowing a role to act as
479             an interface. This function is always exported unless a routine of the same
480             name already exists.
481              
482             I>
483              
484             =over 4
485              
486             =item test example 1
487              
488             package Actual;
489              
490             use Mars::Role;
491              
492             package Example;
493              
494             use Mars::Class;
495              
496             test 'Actual';
497              
498             # "Example"
499              
500             =back
501              
502             =over 4
503              
504             =item test example 2
505              
506             package Actual;
507              
508             use Mars::Role;
509              
510             sub AUDIT {
511             die "Example is not an 'actual' thing" if $_[1]->isa('Example');
512             }
513              
514             package Example;
515              
516             use Mars::Class;
517              
518             test 'Actual';
519              
520             # "Example"
521              
522             =back
523              
524             =cut
525              
526             =head2 true
527              
528             true() (Bool)
529              
530             The true function returns a truthy boolean value which is designed to be
531             practically indistinguishable from the conventional numerical C<1> value. This
532             function is always exported unless a routine of the same name already exists.
533              
534             I>
535              
536             =over 4
537              
538             =item true example 1
539              
540             package Example;
541              
542             use Mars::Class;
543              
544             my $true = true;
545              
546             # 1
547              
548             =back
549              
550             =over 4
551              
552             =item true example 2
553              
554             package Example;
555              
556             use Mars::Class;
557              
558             my $false = !true;
559              
560             # 0
561              
562             =back
563              
564             =cut
565              
566             =head2 with
567              
568             with(Str $name) (Str)
569              
570             The with function registers and consumes roles for the calling package. This
571             function is an alias of the L function and will perform an
572             L<"audit"|Mars::Kind/AUDIT> if present. This function is always exported unless
573             a routine of the same name already exists.
574              
575             I>
576              
577             =over 4
578              
579             =item with example 1
580              
581             package Understanding;
582              
583             use Mars::Role;
584              
585             sub knowledge {
586             return;
587             }
588              
589             package Example;
590              
591             use Mars::Class;
592              
593             with 'Understanding';
594              
595             # "Example"
596              
597             =back
598              
599             =over 4
600              
601             =item with example 2
602              
603             package Understanding;
604              
605             use Mars::Role;
606              
607             sub knowledge {
608             return;
609             }
610              
611             sub EXPORT {
612             return ['knowledge'];
613             }
614              
615             package Example;
616              
617             use Mars::Class;
618              
619             with 'Understanding';
620              
621             # "Example"
622              
623             =back
624              
625             =cut
626              
627             =head1 AUTHORS
628              
629             Awncorp, C
630              
631             =cut