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