Commit | Line | Data |
e185c027 |
1 | |
2 | package Moose::Role; |
3 | |
4 | use strict; |
5 | use warnings; |
6 | |
7 | use Scalar::Util (); |
8 | use Carp 'confess'; |
9 | use Sub::Name 'subname'; |
10 | |
bdabd620 |
11 | our $VERSION = '0.02'; |
e185c027 |
12 | |
13 | use Moose::Meta::Role; |
14 | |
15 | sub import { |
16 | shift; |
17 | my $pkg = caller(); |
18 | |
19 | # we should never export to main |
20 | return if $pkg eq 'main'; |
e185c027 |
21 | |
22 | my $meta; |
23 | if ($pkg->can('meta')) { |
24 | $meta = $pkg->meta(); |
25 | (blessed($meta) && $meta->isa('Moose::Meta::Role')) |
26 | || confess "Whoops, not møøsey enough"; |
27 | } |
28 | else { |
78cd1d3b |
29 | $meta = Moose::Meta::Role->new(role_name => $pkg); |
bdabd620 |
30 | $meta->_role_meta->add_method('meta' => sub { $meta }) |
e185c027 |
31 | } |
32 | |
33 | # NOTE: |
34 | # &alias_method will install the method, but it |
35 | # will not name it with |
36 | |
37 | # handle superclasses |
bdabd620 |
38 | $meta->alias_method('extends' => subname 'Moose::Role::extends' => sub { |
e185c027 |
39 | confess "Moose::Role does not currently support 'extends'" |
40 | }); |
41 | |
bdabd620 |
42 | # handle roles |
43 | $meta->alias_method('with' => subname 'Moose::with' => sub { |
44 | my ($role) = @_; |
45 | Moose::_load_all_classes($role); |
46 | $role->meta->apply($meta); |
47 | }); |
48 | |
1331430a |
49 | # required methods |
50 | $meta->alias_method('requires' => subname 'Moose::requires' => sub { |
51 | $meta->add_required_methods(@_); |
52 | }); |
53 | |
e185c027 |
54 | # handle attributes |
bdabd620 |
55 | $meta->alias_method('has' => subname 'Moose::Role::has' => sub { |
e185c027 |
56 | my ($name, %options) = @_; |
57 | $meta->add_attribute($name, %options) |
58 | }); |
59 | |
60 | # handle method modifers |
bdabd620 |
61 | $meta->alias_method('before' => subname 'Moose::Role::before' => sub { |
e185c027 |
62 | my $code = pop @_; |
80572233 |
63 | $meta->add_before_method_modifier($_, $code) for @_; |
e185c027 |
64 | }); |
bdabd620 |
65 | $meta->alias_method('after' => subname 'Moose::Role::after' => sub { |
e185c027 |
66 | my $code = pop @_; |
80572233 |
67 | $meta->add_after_method_modifier($_, $code) for @_; |
e185c027 |
68 | }); |
bdabd620 |
69 | $meta->alias_method('around' => subname 'Moose::Role::around' => sub { |
e185c027 |
70 | my $code = pop @_; |
80572233 |
71 | $meta->add_around_method_modifier($_, $code) for @_; |
e185c027 |
72 | }); |
73 | |
bdabd620 |
74 | $meta->alias_method('super' => subname 'Moose::Role::super' => sub {}); |
75 | $meta->alias_method('override' => subname 'Moose::Role::override' => sub { |
e185c027 |
76 | my ($name, $code) = @_; |
80572233 |
77 | $meta->add_override_method_modifier($name, $code); |
e185c027 |
78 | }); |
79 | |
bdabd620 |
80 | $meta->alias_method('inner' => subname 'Moose::Role::inner' => sub { |
78cd1d3b |
81 | confess "Moose::Role does not currently support 'inner'"; |
82 | }); |
bdabd620 |
83 | $meta->alias_method('augment' => subname 'Moose::Role::augment' => sub { |
78cd1d3b |
84 | confess "Moose::Role does not currently support 'augment'"; |
e185c027 |
85 | }); |
86 | |
87 | # we recommend using these things |
88 | # so export them for them |
bdabd620 |
89 | $meta->alias_method('confess' => \&Carp::confess); |
90 | $meta->alias_method('blessed' => \&Scalar::Util::blessed); |
e185c027 |
91 | } |
92 | |
93 | 1; |
94 | |
95 | __END__ |
96 | |
97 | =pod |
98 | |
99 | =head1 NAME |
100 | |
101 | Moose::Role - The Moose Role |
102 | |
76d37e5a |
103 | =head1 SYNOPSIS |
104 | |
105 | package Eq; |
106 | use strict; |
107 | use warnings; |
108 | use Moose::Role; |
109 | |
e46edf94 |
110 | requires 'equal'; |
76d37e5a |
111 | |
112 | sub no_equal { |
113 | my ($self, $other) = @_; |
114 | !$self->equal($other); |
115 | } |
116 | |
117 | # ... then in your classes |
118 | |
119 | package Currency; |
120 | use strict; |
121 | use warnings; |
122 | use Moose; |
123 | |
124 | with 'Eq'; |
125 | |
126 | sub equal { |
127 | my ($self, $other) = @_; |
bdabd620 |
128 | $self->as_float == $other->as_float; |
76d37e5a |
129 | } |
130 | |
e185c027 |
131 | =head1 DESCRIPTION |
132 | |
76d37e5a |
133 | This is currently a very early release of Perl 6 style Roles for |
02a0fb52 |
134 | Moose, it is still incomplete, but getting much closer. If you are |
135 | interested in helping move this feature along, please come to |
136 | #moose on irc.perl.org and we can talk. |
76d37e5a |
137 | |
138 | =head1 CAVEATS |
139 | |
02a0fb52 |
140 | Currently, the role support has a few of caveats. They are as follows: |
e185c027 |
141 | |
142 | =over 4 |
143 | |
76d37e5a |
144 | =item * |
145 | |
02a0fb52 |
146 | At this time classes I<cannot> correctly consume more than one role. The |
147 | role composition process, and it's conflict detection has not been added |
148 | yet. While this should be considered a major feature, it can easily be |
149 | worked around, and in many cases, is not needed at all. |
150 | |
151 | A class can actually consume multiple roles, they are just applied one |
152 | after another in the order you ask for them. This is incorrect behavior, |
153 | the roles should be merged first, and conflicts determined, etc. However, |
154 | if your roles do not have any conflicts, then things will work just |
155 | fine. This actually tends to be quite sufficient for basic roles. |
76d37e5a |
156 | |
76d37e5a |
157 | =item * |
158 | |
159 | Roles cannot use the C<extends> keyword, it will throw an exception for now. |
160 | The same is true of the C<augment> and C<inner> keywords (not sure those |
161 | really make sense for roles). All other Moose keywords will be I<deferred> |
162 | so that they can be applied to the consuming class. |
163 | |
e185c027 |
164 | =back |
165 | |
166 | =head1 BUGS |
167 | |
168 | All complex software has bugs lurking in it, and this module is no |
169 | exception. If you find a bug please either email me, or add the bug |
170 | to cpan-RT. |
171 | |
172 | =head1 AUTHOR |
173 | |
174 | Stevan Little E<lt>stevan@iinteractive.comE<gt> |
175 | |
176 | =head1 COPYRIGHT AND LICENSE |
177 | |
178 | Copyright 2006 by Infinity Interactive, Inc. |
179 | |
180 | L<http://www.iinteractive.com> |
181 | |
182 | This library is free software; you can redistribute it and/or modify |
183 | it under the same terms as Perl itself. |
184 | |
185 | =cut |