Commit | Line | Data |
f87debb9 |
1 | package Mouse::Util::MetaRole; |
2 | use Mouse::Util; # enables strict and warnings |
3 | |
d9659f80 |
4 | my @MetaClassTypes = qw( |
5 | metaclass |
6 | attribute_metaclass |
7 | method_metaclass |
8 | constructor_class |
9 | destructor_class |
10 | ); |
f87debb9 |
11 | |
d9659f80 |
12 | # In Mouse::Exporter::do_import(): |
13 | # apply_metaclass_roles(for_class => $class, metaclass_roles => \@traits) |
f87debb9 |
14 | sub apply_metaclass_roles { |
15 | my %options = @_; |
16 | |
17 | my $for = Scalar::Util::blessed($options{for_class}) |
18 | ? $options{for_class} |
d9659f80 |
19 | : Mouse::Util::get_metaclass_by_name($options{for_class}); |
f87debb9 |
20 | |
d9659f80 |
21 | my $new_metaclass = _make_new_class( ref $for, |
22 | $options{metaclass_roles}, |
23 | $options{metaclass} ? [$options{metaclass}] : undef, |
24 | ); |
f87debb9 |
25 | |
d9659f80 |
26 | my @metaclass_map; |
f87debb9 |
27 | |
d9659f80 |
28 | foreach my $mc_type(@MetaClassTypes){ |
29 | next if !$for->can($mc_type); |
f87debb9 |
30 | |
d9659f80 |
31 | if(my $roles = $options{ $mc_type . '_roles' }){ |
32 | push @metaclass_map, |
33 | ($mc_type => _make_new_class($for->$mc_type(), $roles)); |
f87debb9 |
34 | } |
d9659f80 |
35 | elsif(my $mc = $options{$mc_type}){ |
36 | push @metaclass_map, ($mc_type => $mc); |
f87debb9 |
37 | } |
38 | } |
39 | |
d9659f80 |
40 | return $new_metaclass->reinitialize( $for, @metaclass_map ); |
f87debb9 |
41 | } |
42 | |
43 | sub apply_base_class_roles { |
44 | my %options = @_; |
45 | |
46 | my $for = $options{for_class}; |
47 | |
48 | my $meta = Mouse::Util::class_of($for); |
49 | |
50 | my $new_base = _make_new_class( |
51 | $for, |
52 | $options{roles}, |
53 | [ $meta->superclasses() ], |
54 | ); |
55 | |
56 | $meta->superclasses($new_base) |
57 | if $new_base ne $meta->name(); |
58 | return; |
59 | } |
60 | |
f87debb9 |
61 | sub _make_new_class { |
62 | my($existing_class, $roles, $superclasses) = @_; |
63 | |
d9659f80 |
64 | if(!$superclasses){ |
65 | return $existing_class if !$roles; |
f87debb9 |
66 | |
d9659f80 |
67 | my $meta = Mouse::Meta::Class->initialize($existing_class); |
f87debb9 |
68 | |
d9659f80 |
69 | return $existing_class |
70 | if !grep { !ref($_) && !$meta->does_role($_) } @{$roles}; |
71 | } |
f87debb9 |
72 | |
73 | return Mouse::Meta::Class->create_anon_class( |
74 | superclasses => $superclasses ? $superclasses : [$existing_class], |
75 | roles => $roles, |
76 | cache => 1, |
77 | )->name(); |
78 | } |
79 | |
80 | 1; |
81 | |
82 | __END__ |
83 | |
84 | =head1 NAME |
85 | |
86 | Mouse::Util::MetaRole - Apply roles to any metaclass, as well as the object base class |
87 | |
88 | =head1 SYNOPSIS |
89 | |
90 | package MyApp::Mouse; |
91 | |
92 | use Mouse (); |
93 | use Mouse::Exporter; |
94 | use Mouse::Util::MetaRole; |
95 | |
96 | use MyApp::Role::Meta::Class; |
97 | use MyApp::Role::Meta::Method::Constructor; |
98 | use MyApp::Role::Object; |
99 | |
100 | Mouse::Exporter->setup_import_methods( also => 'Mouse' ); |
101 | |
102 | sub init_meta { |
103 | shift; |
104 | my %options = @_; |
105 | |
106 | Mouse->init_meta(%options); |
107 | |
108 | Mouse::Util::MetaRole::apply_metaclass_roles( |
109 | for_class => $options{for_class}, |
110 | metaclass_roles => ['MyApp::Role::Meta::Class'], |
111 | constructor_class_roles => ['MyApp::Role::Meta::Method::Constructor'], |
112 | ); |
113 | |
114 | Mouse::Util::MetaRole::apply_base_class_roles( |
115 | for_class => $options{for_class}, |
116 | roles => ['MyApp::Role::Object'], |
117 | ); |
118 | |
119 | return $options{for_class}->meta(); |
120 | } |
121 | |
122 | =head1 DESCRIPTION |
123 | |
124 | This utility module is designed to help authors of Mouse extensions |
125 | write extensions that are able to cooperate with other Mouse |
126 | extensions. To do this, you must write your extensions as roles, which |
127 | can then be dynamically applied to the caller's metaclasses. |
128 | |
129 | This module makes sure to preserve any existing superclasses and roles |
130 | already set for the meta objects, which means that any number of |
131 | extensions can apply roles in any order. |
132 | |
133 | =head1 USAGE |
134 | |
135 | B<It is very important that you only call this module's functions when |
136 | your module is imported by the caller>. The process of applying roles |
137 | to the metaclass reinitializes the metaclass object, which wipes out |
138 | any existing attributes already defined. However, as long as you do |
139 | this when your module is imported, the caller should not have any |
140 | attributes defined yet. |
141 | |
142 | The easiest way to ensure that this happens is to use |
143 | L<Mouse::Exporter>, which can generate the appropriate C<init_meta> |
144 | method for you, and make sure it is called when imported. |
145 | |
146 | =head1 FUNCTIONS |
147 | |
148 | This module provides two functions. |
149 | |
150 | =head2 apply_metaclass_roles( ... ) |
151 | |
152 | This function will apply roles to one or more metaclasses for the |
153 | specified class. It accepts the following parameters: |
154 | |
155 | =over 4 |
156 | |
157 | =item * for_class => $name |
158 | |
159 | This specifies the class for which to alter the meta classes. |
160 | |
161 | =item * metaclass_roles => \@roles |
162 | |
163 | =item * attribute_metaclass_roles => \@roles |
164 | |
165 | =item * method_metaclass_roles => \@roles |
166 | |
167 | =item * constructor_class_roles => \@roles |
168 | |
169 | =item * destructor_class_roles => \@roles |
170 | |
171 | These parameter all specify one or more roles to be applied to the |
172 | specified metaclass. You can pass any or all of these parameters at |
173 | once. |
174 | |
175 | =back |
176 | |
177 | =head2 apply_base_class_roles( for_class => $class, roles => \@roles ) |
178 | |
179 | This function will apply the specified roles to the object's base class. |
180 | |
181 | =head1 SEE ASLSO |
182 | |
183 | L<Moose::Util::MetaRole> |
184 | |
185 | =cut |