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; |
f87debb9 |
81 | __END__ |
82 | |
83 | =head1 NAME |
84 | |
85 | Mouse::Util::MetaRole - Apply roles to any metaclass, as well as the object base class |
86 | |
87 | =head1 SYNOPSIS |
88 | |
89 | package MyApp::Mouse; |
90 | |
91 | use Mouse (); |
92 | use Mouse::Exporter; |
93 | use Mouse::Util::MetaRole; |
94 | |
95 | use MyApp::Role::Meta::Class; |
96 | use MyApp::Role::Meta::Method::Constructor; |
97 | use MyApp::Role::Object; |
98 | |
99 | Mouse::Exporter->setup_import_methods( also => 'Mouse' ); |
100 | |
101 | sub init_meta { |
102 | shift; |
103 | my %options = @_; |
104 | |
105 | Mouse->init_meta(%options); |
106 | |
107 | Mouse::Util::MetaRole::apply_metaclass_roles( |
108 | for_class => $options{for_class}, |
109 | metaclass_roles => ['MyApp::Role::Meta::Class'], |
110 | constructor_class_roles => ['MyApp::Role::Meta::Method::Constructor'], |
111 | ); |
112 | |
113 | Mouse::Util::MetaRole::apply_base_class_roles( |
114 | for_class => $options{for_class}, |
115 | roles => ['MyApp::Role::Object'], |
116 | ); |
117 | |
118 | return $options{for_class}->meta(); |
119 | } |
120 | |
121 | =head1 DESCRIPTION |
122 | |
123 | This utility module is designed to help authors of Mouse extensions |
124 | write extensions that are able to cooperate with other Mouse |
125 | extensions. To do this, you must write your extensions as roles, which |
126 | can then be dynamically applied to the caller's metaclasses. |
127 | |
128 | This module makes sure to preserve any existing superclasses and roles |
129 | already set for the meta objects, which means that any number of |
130 | extensions can apply roles in any order. |
131 | |
132 | =head1 USAGE |
133 | |
134 | B<It is very important that you only call this module's functions when |
135 | your module is imported by the caller>. The process of applying roles |
136 | to the metaclass reinitializes the metaclass object, which wipes out |
137 | any existing attributes already defined. However, as long as you do |
138 | this when your module is imported, the caller should not have any |
139 | attributes defined yet. |
140 | |
141 | The easiest way to ensure that this happens is to use |
142 | L<Mouse::Exporter>, which can generate the appropriate C<init_meta> |
143 | method for you, and make sure it is called when imported. |
144 | |
145 | =head1 FUNCTIONS |
146 | |
147 | This module provides two functions. |
148 | |
149 | =head2 apply_metaclass_roles( ... ) |
150 | |
151 | This function will apply roles to one or more metaclasses for the |
152 | specified class. It accepts the following parameters: |
153 | |
154 | =over 4 |
155 | |
156 | =item * for_class => $name |
157 | |
158 | This specifies the class for which to alter the meta classes. |
159 | |
160 | =item * metaclass_roles => \@roles |
161 | |
162 | =item * attribute_metaclass_roles => \@roles |
163 | |
164 | =item * method_metaclass_roles => \@roles |
165 | |
166 | =item * constructor_class_roles => \@roles |
167 | |
168 | =item * destructor_class_roles => \@roles |
169 | |
170 | These parameter all specify one or more roles to be applied to the |
171 | specified metaclass. You can pass any or all of these parameters at |
172 | once. |
173 | |
174 | =back |
175 | |
176 | =head2 apply_base_class_roles( for_class => $class, roles => \@roles ) |
177 | |
178 | This function will apply the specified roles to the object's base class. |
179 | |
a9cf013d |
180 | =head1 SEE ALSO |
f87debb9 |
181 | |
182 | L<Moose::Util::MetaRole> |
183 | |
184 | =cut |