6 Moose::Cookbook::Recipe11 - The meta-attribute example
10 package MyApp::Meta::Attribute::Labeled;
12 extends 'Moose::Meta::Attribute';
17 predicate => 'has_label',
20 package Moose::Meta::Attribute::Custom::Labeled;
21 sub register_implementation { 'MyApp::Meta::Attribute::Labeled' }
23 package MyApp::Website;
25 use MyApp::Meta::Attribute::Labeled;
28 metaclass => 'Labeled',
31 label => "The site's URL",
42 # iterate over all the attributes in $self
43 my %attributes = %{ $self->meta->get_attribute_map };
44 while (my ($name, $attribute) = each %attributes) {
46 # print the label if available
47 if ($attribute->isa('MyApp::Meta::Attribute::Labeled')
48 && $attribute->has_label) {
49 print $attribute->label;
51 # otherwise print the name
56 # print the attribute's value
57 my $reader = $attribute->get_read_method;
58 print ": " . $self->$reader . "\n";
63 my $app = MyApp::Website->new(url => "http://google.com", name => "Google");
68 In this recipe, we begin to really delve into the wonder of meta-programming.
69 Some readers may scoff and claim that this is the arena only of the most
70 twisted Moose developers. Absolutely not! Any sufficiently twisted developer
71 can benefit greatly from going more meta.
73 The high-level goal of this recipe's code is to allow each attribute to have a
74 human-readable "label" attached to it. Such labels would be used when showing
75 data to an end user. In this recipe we label the "url" attribute with "The
76 site's URL" and create a simple method to demonstrate how to use that label.
78 =head1 REAL ATTRIBUTES 101
80 All the attributes of a Moose-based object are actually objects themselves.
81 These objects have methods and (surprisingly) attributes. Let's look at a
84 has 'x' => (isa => 'Int', is => 'ro');
85 has 'y' => (isa => 'Int', is => 'rw');
87 Ahh, the veritable x and y of the Point example. Internally, every Point has an
88 x object and a y object. They have methods (such as "get_value") and attributes
89 (such as "is_lazy"). What class are they instances of?
90 L<Moose::Meta::Attribute>. You don't normally see the objects lurking behind
91 the scenes, because you usually just use C<< $point->x >> and C<< $point->y >>
92 and forget that there's a lot of machinery lying in such methods.
94 So you have a C<$point> object, which has C<x> and C<y> methods. How can you
95 actually access the objects behind these attributes? Here's one way:
97 $point->meta->get_attribute_map()
99 C<get_attribute_map> returns a hash reference that maps attribute names to
100 their objects. In our case, C<get_attribute_map> might return something that
101 looks like the following:
104 x => Moose::Meta::Attribute=HASH(0x196c23c),
105 y => Moose::Meta::Attribute=HASH(0x18d1690),
108 Another way to get a handle on an attribute's object is
109 C<< $self->meta->get_attribute('name') >>. Here's one thing you can do now that
110 you can interact with the attribute's object directly:
112 print $point->meta->get_attribute('x')->type_constraint;
115 (As an aside, it's not called C<< ->isa >> because C<< $obj->isa >> is already
118 So to actually beef up attributes, what we need to do is:
122 =item Create a new attribute metaclass
124 =item Create attributes using that new metaclass
128 Moose makes both of these easy!
130 Let's start dissecting the recipe's code.
134 We get the ball rolling by creating a new attribute metaclass. It starts off
135 somewhat ungloriously.
137 package MyApp::Meta::Attribute::Labeled;
139 extends 'Moose::Meta::Attribute';
141 You subclass metaclasses the same way you subclass regular classes. (Extra
142 credit: how in the actual hell can you use the MOP to extend itself?) Moving
148 predicate => 'has_label',
151 Now things get a little icky. We're adding a attribute to the attribute
152 metaclass. For clarity, I'm going to call this a meta-attribute.
154 This creates a new meta-attribute in the C<MyApp::Meta::Attribute::Labeled>
155 metaclass. The new meta-attribute's name is 'label'. The predicate just creates
156 a method that asks the question "Does this attribute have a value?"
158 Of course, if you step a foot back, you can see that this is really just adding
159 an attribute to a class. Don't be alarmed!
161 package Moose::Meta::Attribute::Custom::Labeled;
162 sub register_implementation { 'MyApp::Meta::Attribute::Labeled' }
164 This registers the new metaclass with Moose. That way attributes can actually
165 use it. More on what this is doing in a moment.
167 Note that we're done defining the new metaclass! Only nine lines of code, and
168 not particularly difficult lines, either. Now to start using the metaclass.
170 package MyApp::Website;
172 use MyApp::Meta::Attribute::Labeled;
174 Nothing new here. We do have to actually load our metaclass to be able to use
178 metaclass => 'Labeled',
181 label => "The site's URL",
184 Ah ha! Now we're using the metaclass. We're adding a new attribute, C<url>, to
185 C<MyApp::Website>. C<has> lets you set the metaclass of the attribute.
186 Ordinarily (as we've seen), the metaclass is C<Moose::Meta::Attribute>.
188 When C<has> sees that you're using a new metaclass, it will take the
189 metaclass's name, prepend C<Moose::Meta::Attribute::Custom::>, and call the
190 C<register_implementation> function in that package. So here Moose calls
191 C<Moose::Meta::Attribute::Custom::Labeled::register_implementation>. We defined
192 that function in the beginning -- it just returns our "real" metaclass'
193 package, C<MyApp::Meta::Attribute::Labeled>. So Moose uses that metaclass for
194 the attribute. It may seem a bit convoluted, but the alternative would be to
195 use C<< metaclass => 'MyApp::Meta::Attribute::Labeled' >> on every attribute.
196 As usual, Moose optimizes in favor of the end user, not the metaprogrammer. :)
198 Finally, we see that C<has> is setting our new meta-attribute, C<label>, to
206 You do not of course need to use the new metaclass for all new attributes.
208 Now we begin defining a method that will dump the C<MyApp::Website> instance
214 # iterate over all the attributes in $self
215 my %attributes = %{ $self->meta->get_attribute_map };
216 while (my ($name, $attribute) = each %attributes) {
218 We covered the latter two lines of code earlier.
220 # print the label if available
221 if ($attribute->isa('MyApp::Meta::Attribute::Labeled')
222 && $attribute->has_label) {
223 print $attribute->label;
226 Note that we have two checks here. The first is "is this attribute an instance
227 of C<MyApp::Meta::Attribute::Labeled>?". It's good to code defensively, even if
228 all of your attributes have this metaclass. You never know when someone is
229 going to subclass your work of art, poorly. The second check is "does this
230 attribute have a label?". This method was defined in the new metaclass as the
231 "predicate". If we pass both checks, we print the attribute's label. The
232 C<< ->label >> method was defined in the new metaclass as the "reader".
234 # otherwise print the name
239 Another good, defensive coding practice: Provide reasonable defaults.
241 # print the attribute's value
242 my $reader = $attribute->get_read_method;
243 print ": " . $self->$reader . "\n";
247 Here's another example of using the attribute metaclass. C<<
248 $attribute->get_read_method >> returns the name of the method that can
249 invoked on the original object to read the attribute's value. C<<
250 $self->$reader >> is an example of "reflection". Instead of using the name of
251 the method, we're using a variable with the name of the method in it. Perl
252 doesn't mind. Another way to write this would be
253 C<< $self->can($reader)->() >>.
256 my $app = MyApp::Website->new(url => "http://google.com", name => "Google");
259 And finish off the example with a script to show off our newfound magic.
263 Why oh why would you want to go through all of these contortions when you can
264 just print "The site's URL" directly in the C<dump> method? For one, the DRY
265 (Don't Repeat Yourself) principle. If you have it in the C<dump> method, you'll
266 probably also have it in the C<as_form> method, and C<to_file>, and so on. So
267 why not have a method that maps attribute names to labels? That could work, but
268 why not include the label where it belongs, in the attribute's definition?
269 That way you're also less likely to forget to add the label.
271 More importantly, this was a very simple example. Your metaclasses aren't
272 limited to just adding new meta-attributes. For example, you could implement
273 a metaclass that expires attributes after a certain amount of time.
276 metaclass => 'Expiry',
277 expires_after => '1 hour',
278 refresh_with => sub { my $self = shift; get($self->url) },
286 Shawn M Moore E<lt>sartak@gmail.comE<gt>
288 =head1 COPYRIGHT AND LICENSE
290 Copyright 2006, 2007 by Infinity Interactive, Inc.
292 L<http://www.iinteractive.com>
294 This library is free software; you can redistribute it and/or modify
295 it under the same terms as Perl itself.