File Coverage

blib/lib/Mars/Kind/Role.pm
Criterion Covered Total %
statement 32 32 100.0
branch n/a
condition n/a
subroutine 10 10 100.0
pod 4 4 100.0
total 46 46 100.0


line stmt bran cond sub pod time code
1             package Mars::Kind::Role;
2              
3 4     4   1457 use 5.018;
  4         12  
4              
5 4     4   19 use strict;
  4         6  
  4         61  
6 4     4   15 use warnings;
  4         8  
  4         96  
7              
8 4     4   16 use base 'Mars::Kind';
  4         5  
  4         798  
9              
10             # METHODS
11              
12             sub EXPORT {
13 12     12 1 20 my ($self, $into) = @_;
14              
15 12         32 return [];
16             }
17              
18             sub IMPORT {
19 23     23 1 47 my ($self, $into) = @_;
20              
21 4     4   24 no strict 'refs';
  4         15  
  4         108  
22 4     4   17 no warnings 'redefine';
  4         6  
  4         723  
23              
24 23         36 for my $name (grep !*{"${into}::${_}"}{"CODE"}, @{$self->EXPORT($into)}) {
  18         96  
  23         168  
25 18         31 *{"${into}::${name}"} = \&{"@{[$self->NAME]}::${name}"};
  18         49  
  18         20  
  18         53  
26             }
27              
28 23         42 return $self;
29             }
30              
31             sub does {
32 1     1 1 9 my ($self, @args) = @_;
33              
34 1         4 return $self->DOES(@args);
35             }
36              
37             sub meta {
38 1     1 1 9 my ($self) = @_;
39              
40 1         3 return $self->META;
41             }
42              
43             1;
44              
45              
46              
47             =head1 NAME
48              
49             Mars::Kind::Role - Role Base Class
50              
51             =cut
52              
53             =head1 ABSTRACT
54              
55             Role Base Class for Perl 5
56              
57             =cut
58              
59             =head1 SYNOPSIS
60              
61             package Person;
62              
63             use base 'Mars::Kind::Role';
64              
65             package User;
66              
67             use base 'Mars::Kind::Class';
68              
69             package main;
70              
71             my $user = User->ROLE('Person')->new(
72             fname => 'Elliot',
73             lname => 'Alderson',
74             );
75              
76             # bless({fname => 'Elliot', lname => 'Alderson'}, 'User')
77              
78             =cut
79              
80             =head1 DESCRIPTION
81              
82             This package provides a role base class with role building and object
83             construction lifecycle hooks.
84              
85             =cut
86              
87             =head1 INHERITS
88              
89             This package inherits behaviors from:
90              
91             L
92              
93             =cut
94              
95             =head1 METHODS
96              
97             This package provides the following methods:
98              
99             =cut
100              
101             =head2 does
102              
103             does(Str $name) (Bool)
104              
105             The does method returns true if the object is composed of the role provided.
106              
107             I>
108              
109             =over 4
110              
111             =item does example 1
112              
113             package Employee;
114              
115             use base 'Mars::Kind::Role';
116              
117             Employee->ROLE('Person');
118              
119             package main;
120              
121             my $user = User->ROLE('Employee')->new(
122             fname => 'Elliot',
123             lname => 'Alderson',
124             );
125              
126             my $does = Employee->does('Person');
127              
128             # 1
129              
130             =back
131              
132             =cut
133              
134             =head2 meta
135              
136             meta() (Meta)
137              
138             The meta method returns a L objects which describes the package's
139             configuration.
140              
141             I>
142              
143             =over 4
144              
145             =item meta example 1
146              
147             package main;
148              
149             my $user = User->ROLE('Person')->new(
150             fname => 'Elliot',
151             lname => 'Alderson',
152             );
153              
154             my $meta = Person->meta;
155              
156             # bless({...}, 'Mars::Meta')
157              
158             =back
159              
160             =cut
161              
162             =head1 AUTHORS
163              
164             Awncorp, C
165              
166             =cut