Commit | Line | Data |
8323a774 |
1 | |
2 | =pod |
3 | |
4 | =head1 NAME |
5 | |
6 | Moose::Cookbook::Recipe11 - The meta-attribute example |
7 | |
8d8832a4 |
8 | =head1 SYNOPSIS |
9 | |
8323a774 |
10 | package MyApp::Meta::Attribute::Labeled; |
11 | use Moose; |
12 | extends 'Moose::Meta::Attribute'; |
13 | |
14 | __PACKAGE__->meta->add_attribute('label' => ( |
15 | reader => 'label', |
16 | predicate => 'has_label', |
17 | )); |
18 | |
19 | package Moose::Meta::Attribute::Custom::Labeled; |
20 | sub register_implementation { 'MyApp::Meta::Attribute::Labeled' } |
21 | |
22 | package MyApp::Website; |
23 | use Moose; |
24 | use MyApp::Meta::Attribute::Labeled; |
25 | |
26 | has url => ( |
27 | metaclass => 'Labeled', |
28 | isa => 'Str', |
29 | is => 'rw', |
30 | label => "The site's URL", |
31 | ); |
32 | |
33 | has name => ( |
34 | is => 'rw', |
35 | isa => 'Str', |
36 | ); |
37 | |
38 | sub dump { |
39 | my $self = shift; |
40 | |
41 | # iterate over all the attributes in $self |
42 | my %attributes = %{ $self->meta->get_attribute_map }; |
43 | while (my ($name, $meta_attribute) = each %attributes) { |
44 | |
45 | # print the label if available |
46 | if ($meta_attribute->isa('MyApp::Meta::Attribute::Labeled') |
47 | && $meta_attribute->has_label) { |
48 | print $meta_attribute->label; |
49 | } |
50 | # otherwise print the name |
51 | else { |
52 | print $name; |
53 | } |
54 | |
55 | # print the attribute's value |
56 | my $reader = $meta_attribute->get_read_method; |
57 | print ": " . $self->$reader . "\n"; |
58 | } |
59 | } |
60 | |
61 | package main; |
62 | my $app = MyApp::Website->new(url => "http://google.com", name => "Google"); |
63 | $app->dump; |
64 | |
65 | =head1 SUMMARY |
66 | |
67 | In this recipe, we begin to really delve into the wonder of meta-programming. |
68 | Some readers may scoff and claim that this is the arena only of the most |
69 | twisted Moose developers. Absolutely not! Any sufficiently twisted developer |
70 | can benefit greatly from going more meta. |
71 | |
72 | The high-level goal of this recipe's code is to allow each attribute to have a |
73 | human-readable "label" attached to it. Such labels would be used when showing |
74 | data to an end user. In this recipe we label the "url" attribute with "The |
75 | site's URL" and create a simple method to demonstrate how to use that label. |
76 | |
77 | =head1 REAL ATTRIBUTES 101 |
78 | |
79 | All the attributes of a Moose-based object are actually objects themselves. |
80 | These objects have methods and (surprisingly) attributes. Let's look at a |
81 | concrete example. |
82 | |
83 | has 'x' => (isa => 'Int', is => 'ro'); |
84 | has 'y' => (isa => 'Int', is => 'rw'); |
85 | |
86 | Ahh, the veritable x and y of the Point example. Internally, every Point has an |
87 | x object and a y object. They have methods (such as "get_value") and attributes |
88 | (such as "is_lazy"). What class are they instances of? |
89 | L<Moose::Meta::Attribute>. You don't normally see the objects lurking behind |
90 | the scenes, because you usually just use C<< $point->x >> and C<< $point->y >> |
91 | and forget that there's a lot of machinery lying in such methods. |
92 | |
93 | So you have a C<$point> object, which has C<x> and C<y> methods. How can you |
94 | actually access the objects behind these attributes? Here's one way: |
95 | |
96 | $point->meta->get_attribute_map() |
97 | |
98 | C<get_attribute_map> returns a hash reference that maps attribute names to |
99 | their objects. In our case, C<get_attribute_map> might return something that |
100 | looks like the following: |
101 | |
102 | { |
103 | x => Moose::Meta::Attribute=HASH(0x196c23c), |
104 | y => Moose::Meta::Attribute=HASH(0x18d1690), |
105 | } |
106 | |
107 | Here's one thing you can do now that you can interact with the attribute's |
108 | object directly: |
109 | |
110 | print $point->meta->get_attribute_map->{x}->type_constraint; |
111 | => Int |
112 | |
113 | (As an aside, it's not called C<< ->isa >> because C<< $obj->isa >> is already |
114 | taken) |
115 | |
116 | So to actually beef up attributes, what we need to do is: |
117 | |
118 | =over 4 |
119 | |
120 | =item Create a new attribute metaclass |
121 | |
122 | =item Create attributes using that new metaclass |
123 | |
124 | =back |
125 | |
126 | Moose makes both of these easy! |
127 | |
128 | Let's start dissecting the recipe's code. |
129 | |
130 | =head1 DISSECTION |
131 | |
132 | We get the ball rolling by creating a new attribute metaclass. It starts off |
133 | somewhat ungloriously. |
134 | |
135 | package MyApp::Meta::Attribute::Labeled; |
136 | use Moose; |
137 | extends 'Moose::Meta::Attribute'; |
138 | |
139 | You subclass metaclasses the same way you subclass regular classes. (Extra |
140 | credit: how in the actual hell can you use the MOP to extend itself?) Moving |
141 | on. |
142 | |
143 | __PACKAGE__->meta->add_attribute('label' => ( |
144 | reader => 'label', |
145 | predicate => 'has_label', |
146 | )); |
147 | |
148 | Now things get a little icky. We're adding a attribute to the attribute |
149 | metaclass. For clarity, I'm going to call this a meta-attribute. |
150 | |
151 | So. This creates a new meta-attribute in the C<MyApp::Meta::Attribute::Labeled> |
152 | metaclass. The new meta-attribute's name is 'label'. We get reader and |
153 | predicate methods, too. The reader method retrieves the value of this |
154 | meta-attribute, the predicate method just asks the question "Does this |
155 | meta-attribute even have a value?" |
156 | |
157 | Note the resemblance between C<add_attribute> and C<has>. C<has> actually just |
158 | uses C<add_attribute> behind the scenes. |
159 | |
160 | package Moose::Meta::Attribute::Custom::Labeled; |
161 | sub register_implementation { 'MyApp::Meta::Attribute::Labeled' } |
162 | |
163 | This registers the new metaclass with Moose. That way attributes can actually |
164 | use it. More on what this is doing in a moment. |
165 | |
166 | Note that we're done defining the new metaclass! Only nine lines of code, and |
167 | not particularly difficult lines, either. Now to start using the metaclass. |
168 | |
169 | package MyApp::Website; |
170 | use Moose; |
171 | use MyApp::Meta::Attribute::Labeled; |
172 | |
173 | Nothing new here. We do have to actually load our metaclass to be able to use |
174 | it. |
175 | |
176 | has url => ( |
177 | metaclass => 'Labeled', |
178 | isa => 'Str', |
179 | is => 'rw', |
180 | label => "The site's URL", |
181 | ); |
182 | |
183 | Ah ha! Now we're using the metaclass. We're adding a new attribute, C<url>, to |
dbea36a1 |
184 | C<MyApp::Website>. C<has> lets you set the metaclass of the attribute. |
185 | Ordinarily (as we've seen), the metaclass is C<Moose::Meta::Attribute>. |
8323a774 |
186 | |
187 | When C<has> sees that you're using a new metaclass, it will take the |
188 | metaclass's name, prepend C<Moose::Meta::Attribute::Custom::>, and call the |
189 | C<register_implementation> function in that package. So here Moose calls |
dbea36a1 |
190 | C<Moose::Meta::Attribute::Custom::Labeled::register_implementation>. We defined |
191 | that function in the beginning -- it just returns our "real" metaclass' |
192 | package, C<MyApp::Meta::Attribute::Labeled>. So Moose uses that metaclass for |
193 | the attribute. It may seem a bit convoluted, but the alternative would be to |
194 | use C<< metaclass => 'MyApp::Meta::Attribute::Labeled' >> on every attribute. |
195 | As usual, Moose optimizes in favor of the end user, not the metaprogrammer. :) |
8323a774 |
196 | |
197 | Finally, we see that C<has> is setting our new meta-attribute, C<label>, to |
198 | C<"The site's URL">. |
199 | |
200 | has name => ( |
201 | is => 'rw', |
202 | isa => 'Str', |
203 | ); |
204 | |
205 | You do not of course need to use the new metaclass for all new attributes. |
206 | |
207 | Now we begin defining a method that will dump the C<MyApp::Website> instance |
208 | for human readers. |
209 | |
210 | sub dump { |
211 | my $self = shift; |
212 | |
213 | # iterate over all the attributes in $self |
214 | my %attributes = %{ $self->meta->get_attribute_map }; |
215 | while (my ($name, $meta_attribute) = each %attributes) { |
216 | |
217 | We covered the latter two lines of code earlier. |
218 | |
219 | # print the label if available |
220 | if ($meta_attribute->isa('MyApp::Meta::Attribute::Labeled') |
221 | && $meta_attribute->has_label) { |
222 | print $meta_attribute->label; |
223 | } |
224 | |
225 | Note that we have two checks here. The first is "is this attribute an instance |
226 | of C<MyApp::Meta::Attribute::Labeled>?". It's good to code defensively, even if |
227 | all of your attributes have this metaclass. You never know when someone is |
228 | going to subclass your work of art, poorly. The second check is "does this |
229 | attribute have a label?". This method was defined in the new metaclass as the |
dbea36a1 |
230 | "predicate". If we pass both checks, we print the attribute's label. The |
231 | C<< ->label >> method was defined in the new metaclass as the "reader". |
8323a774 |
232 | |
233 | # otherwise print the name |
234 | else { |
235 | print $name; |
236 | } |
237 | |
238 | Another good, defensive coding practice: Provide reasonable defaults. |
239 | |
240 | # print the attribute's value |
241 | my $reader = $meta_attribute->get_read_method; |
242 | print ": " . $self->$reader . "\n"; |
243 | } |
244 | } |
245 | |
dbea36a1 |
246 | Here's another example of using the attribute metaclass. C<< |
247 | $meta_attribute->get_read_method >> returns the name of the method that can |
248 | invoked on the original object to read the attribute's value. C<< |
249 | $self->$reader >> is an example of "reflection". Instead of using the name of |
250 | the method, we're using a variable with the name of the method in it. Perl |
251 | doesn't mind. Another way to write this would be |
252 | C<< $self->can($reader)->() >>. |
8323a774 |
253 | |
254 | package main; |
255 | my $app = MyApp::Website->new(url => "http://google.com", name => "Google"); |
256 | $app->dump; |
257 | |
258 | And finish off the example with a script to show off our newfound magic. |
259 | |
260 | =head1 CONCLUSION |
261 | |
262 | Why oh why would you want to go through all of these contortions when you can |
263 | just print "The site's URL" directly in the C<dump> method? For one, the DRY |
264 | (Don't Repeat Yourself) principle. If you have it in the C<dump> method, you'll |
265 | probably also have it in the C<as_form> method, and C<to_file>, and so on. So |
266 | why not have a method that maps attribute names to labels? That could work, but |
267 | why not include the label where it belongs, in the attribute's definition? |
268 | That way you're also less likely to forget to add the label. |
269 | |
270 | More importantly, this was a very simple example. Your metaclasses aren't |
271 | limited to just adding new meta-attributes. For example, you could implement |
272 | a metaclass that expires attributes after a certain amount of time. |
273 | |
274 | has site_cache => ( |
275 | metaclass => 'Expiry', |
276 | expires_after => '1 hour', |
277 | refresh_with => sub { ... }, |
278 | isa => 'Str', |
279 | ); |
280 | |
281 | The sky's the limit! |
282 | |
283 | =head1 AUTHOR |
284 | |
285 | Shawn M Moore E<lt>sartak@gmail.comE<gt> |
286 | |
287 | =head1 COPYRIGHT AND LICENSE |
288 | |
289 | Copyright 2006, 2007 by Infinity Interactive, Inc. |
290 | |
291 | L<http://www.iinteractive.com> |
292 | |
293 | This library is free software; you can redistribute it and/or modify |
294 | it under the same terms as Perl itself. |
295 | |
296 | =cut |
297 | |
298 | 1; |
299 | |