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; |
6a7e3999 |
25 | |
26 | has url => ( |
27 | metaclass => 'Labeled', |
28 | is => 'rw', |
29 | isa => 'Str', |
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 | |
c79239a2 |
41 | my $dump = ''; |
42 | |
6a7e3999 |
43 | my %attributes = %{ $self->meta->get_attribute_map }; |
c79239a2 |
44 | for my $name ( sort keys %attributes ) { |
45 | my $attribute = $attributes{$name}; |
6a7e3999 |
46 | |
6a7e3999 |
47 | if ( $attribute->isa('MyApp::Meta::Attribute::Labeled') |
48 | && $attribute->has_label ) { |
c79239a2 |
49 | $dump .= $attribute->label; |
6a7e3999 |
50 | } |
6a7e3999 |
51 | else { |
c79239a2 |
52 | $dump .= $name; |
6a7e3999 |
53 | } |
54 | |
6a7e3999 |
55 | my $reader = $attribute->get_read_method; |
c79239a2 |
56 | $dump .= ": " . $self->$reader . "\n"; |
6a7e3999 |
57 | } |
c79239a2 |
58 | |
59 | return $dump; |
6a7e3999 |
60 | } |
61 | |
62 | package main; |
c79239a2 |
63 | |
6a7e3999 |
64 | my $app = MyApp::Website->new( url => "http://google.com", name => "Google" ); |
8323a774 |
65 | |
66 | =head1 SUMMARY |
67 | |
de4b3855 |
68 | In this recipe, we begin to delve into the wonder of meta-programming. |
69 | Some readers may scoff and claim that this is the arena of only the |
70 | most twisted Moose developers. Absolutely not! Any sufficiently |
71 | twisted developer can benefit greatly from going more meta. |
8323a774 |
72 | |
de4b3855 |
73 | Our goal is to allow each attribute to have a human-readable "label" |
74 | attached to it. Such labels would be used when showing data to an end |
75 | user. In this recipe we label the C<url> attribute with "The site's |
76 | URL" and create a simple method showing how to use that label. |
8323a774 |
77 | |
de4b3855 |
78 | =head1 META-ATTRIBUTE OBJECTS |
8323a774 |
79 | |
de4b3855 |
80 | All the attributes of a Moose-based object are actually objects |
81 | themselves. These objects have methods and attributes. Let's look at |
82 | a concrete example. |
8323a774 |
83 | |
6a7e3999 |
84 | has 'x' => ( isa => 'Int', is => 'ro' ); |
85 | has 'y' => ( isa => 'Int', is => 'rw' ); |
8323a774 |
86 | |
de4b3855 |
87 | Internally, the metaclass for C<Point> has two |
88 | L<Moose::Meta::Attribute>. There are several methods for getting |
89 | meta-attributes out of a metaclass, one of which is |
90 | C<get_attribute_map>. This method is called on the metaclass object. |
8323a774 |
91 | |
de4b3855 |
92 | The C<get_attribute_map> method returns a hash reference that maps |
93 | attribute names to their objects. In our case, C<get_attribute_map> |
94 | might return something that looks like the following: |
8323a774 |
95 | |
6a7e3999 |
96 | { |
de4b3855 |
97 | x => $attr_object_for_x, |
98 | y => $attr_object_for_y, |
6a7e3999 |
99 | } |
8323a774 |
100 | |
de4b3855 |
101 | You can also get a single L<Moose::Meta::Attribute> with |
102 | C<get_attribute('name')>. Once you have this meta-attribute object, |
103 | you can call methods on it like this: |
8323a774 |
104 | |
6a7e3999 |
105 | print $point->meta->get_attribute('x')->type_constraint; |
106 | => Int |
8323a774 |
107 | |
de4b3855 |
108 | To add a label to our attributes there are two steps. First, we need a |
109 | new attribute metaclass that can store a label for an |
19320607 |
110 | attribute. Second, we need to create attributes that use that |
de4b3855 |
111 | attribute metaclass. |
8323a774 |
112 | |
de4b3855 |
113 | =head1 RECIPE REVIEW |
8323a774 |
114 | |
de4b3855 |
115 | We start by creating a new attribute metaclass. |
8323a774 |
116 | |
6a7e3999 |
117 | package MyApp::Meta::Attribute::Labeled; |
118 | use Moose; |
119 | extends 'Moose::Meta::Attribute'; |
8323a774 |
120 | |
de4b3855 |
121 | We can subclass a Moose metaclass in the same way that we subclass |
122 | anything else. |
8323a774 |
123 | |
6a7e3999 |
124 | has label => ( |
125 | is => 'rw', |
126 | isa => 'Str', |
127 | predicate => 'has_label', |
128 | ); |
8323a774 |
129 | |
de4b3855 |
130 | Again, this is standard Moose code. |
8323a774 |
131 | |
de4b3855 |
132 | Then we need to register our metaclass with Moose: |
8323a774 |
133 | |
6a7e3999 |
134 | package Moose::Meta::Attribute::Custom::Labeled; |
135 | sub register_implementation { 'MyApp::Meta::Attribute::Labeled' } |
8323a774 |
136 | |
de4b3855 |
137 | This is a bit of magic that lets us use a short name, "Labeled", when |
19320607 |
138 | referring to our new metaclass. |
de4b3855 |
139 | |
140 | That was the whole attribute metaclass. |
8323a774 |
141 | |
de4b3855 |
142 | Now we start using it. |
8323a774 |
143 | |
6a7e3999 |
144 | package MyApp::Website; |
145 | use Moose; |
146 | use MyApp::Meta::Attribute::Labeled; |
8323a774 |
147 | |
de4b3855 |
148 | We have to load the metaclass to use it, just like any Perl class. |
149 | |
150 | Finally, we use it for an attribute: |
8323a774 |
151 | |
6a7e3999 |
152 | has url => ( |
153 | metaclass => 'Labeled', |
154 | is => 'rw', |
155 | isa => 'Str', |
156 | label => "The site's URL", |
157 | ); |
8323a774 |
158 | |
19320607 |
159 | This looks like a normal attribute declaration, except for two things, |
de4b3855 |
160 | the C<metaclass> and C<label> parameters. The C<metaclass> parameter |
161 | tells Moose we want to use a custom metaclass for this (one) |
162 | attribute. The C<label> parameter will be stored in the meta-attribute |
163 | object. |
164 | |
165 | The reason that we can pass the name C<Labeled>, instead of |
166 | C<MyApp::Meta::Attribute::Labeled>, is because of the |
167 | C<register_implementation> code we touched on previously. |
168 | |
169 | When you pass a metaclass to C<has>, it will take the name you provide |
170 | and prefix it with C<Moose::Meta::Attribute::Custom::>. Then it calls |
171 | C<register_implementation> in the package. In this case, that means |
172 | Moose ends up calling |
173 | C<Moose::Meta::Attribute::Custom::Labeled::register_implementation>. |
174 | |
175 | If this function exists, it should return the I<real> metaclass |
176 | package name. This is exactly what our code does, returning |
177 | C<MyApp::Meta::Attribute::Labeled>. This is a little convoluted, and |
178 | if you don't like it, you can always use the fully-qualified name. |
179 | |
180 | We can access this meta-attribute and its label like this: |
94acbcd7 |
181 | |
6a7e3999 |
182 | $website->meta->get_attribute('url')->label() |
94acbcd7 |
183 | |
de4b3855 |
184 | MyApp::Website->meta->get_attribute('url')->label() |
185 | |
186 | We also have a regular attribute, C<name>: |
8323a774 |
187 | |
6a7e3999 |
188 | has name => ( |
189 | is => 'rw', |
190 | isa => 'Str', |
191 | ); |
8323a774 |
192 | |
de4b3855 |
193 | This is a regular Moose attribute, because we have not specified a new |
194 | metaclass. |
8323a774 |
195 | |
de4b3855 |
196 | Finally, we have a C<dump> method, which creates a human-readable |
197 | representation of a C<MyApp::Website> object. It will use an |
198 | attribute's label if it has one. |
8323a774 |
199 | |
6a7e3999 |
200 | sub dump { |
201 | my $self = shift; |
8323a774 |
202 | |
c79239a2 |
203 | my $dump = ''; |
204 | |
6a7e3999 |
205 | my %attributes = %{ $self->meta->get_attribute_map }; |
c79239a2 |
206 | for my $name ( sort keys %attributes ) { |
207 | my $attribute = $attributes{$name}; |
8323a774 |
208 | |
6a7e3999 |
209 | if ( $attribute->isa('MyApp::Meta::Attribute::Labeled') |
210 | && $attribute->has_label ) { |
c79239a2 |
211 | $dump .= $attribute->label; |
6a7e3999 |
212 | } |
8323a774 |
213 | |
de4b3855 |
214 | This is a bit of defensive code. We cannot depend on every |
215 | meta-attribute having a label. Even if we define one for every |
216 | attribute in our class, a subclass may neglect to do so. Or a |
217 | superclass could add an attribute without a label. |
fe2d5aba |
218 | |
de4b3855 |
219 | We also check that the attribute has a label using the predicate we |
220 | defined. We could instead make the label C<required>. If we have a |
c79239a2 |
221 | label, we use it, otherwise we use the attribute name: |
8323a774 |
222 | |
6a7e3999 |
223 | else { |
c79239a2 |
224 | $dump .= $name; |
6a7e3999 |
225 | } |
8323a774 |
226 | |
6a7e3999 |
227 | my $reader = $attribute->get_read_method; |
c79239a2 |
228 | $dump .= ": " . $self->$reader . "\n"; |
6a7e3999 |
229 | } |
c79239a2 |
230 | |
231 | return $dump; |
6a7e3999 |
232 | } |
8323a774 |
233 | |
de4b3855 |
234 | The C<get_read_method> is part of the L<Moose::Meta::Attribute> |
235 | API. It returns the name of a method that can read the attribute's |
236 | value, I<when called on the real object> (don't call this on the |
237 | meta-attribute). |
8323a774 |
238 | |
239 | =head1 CONCLUSION |
240 | |
de4b3855 |
241 | You might wonder why you'd bother with all this. You could just |
242 | hardcode "The Site's URL" in the C<dump> method. But we want to avoid |
243 | repetition. If you need the label once, you may need it elsewhere, |
244 | maybe in the C<as_form> method you write next. |
245 | |
246 | Associating a label with an attribute just makes sense! The label is a |
247 | piece of information I<about> the attribute. |
8323a774 |
248 | |
de4b3855 |
249 | It's also important to realize that this was a trivial example. You |
250 | can make much more powerful metaclasses that I<do> things, as opposed |
251 | to just storing some more information. For example, you could |
252 | implement a metaclass that expires attributes after a certain amount |
253 | of time: |
8323a774 |
254 | |
6a7e3999 |
255 | has site_cache => ( |
256 | metaclass => 'TimedExpiry', |
257 | expires_after => { hours => 1 }, |
de4b3855 |
258 | refresh_with => sub { get( $_[0]->url ) }, |
6a7e3999 |
259 | isa => 'Str', |
260 | is => 'ro', |
261 | ); |
8323a774 |
262 | |
263 | The sky's the limit! |
264 | |
265 | =head1 AUTHOR |
266 | |
267 | Shawn M Moore E<lt>sartak@gmail.comE<gt> |
268 | |
de4b3855 |
269 | Dave Rolsky E<lt>autarch@urth.org<gt> |
270 | |
8323a774 |
271 | =head1 COPYRIGHT AND LICENSE |
272 | |
2840a3b2 |
273 | Copyright 2006-2009 by Infinity Interactive, Inc. |
8323a774 |
274 | |
275 | L<http://www.iinteractive.com> |
276 | |
277 | This library is free software; you can redistribute it and/or modify |
278 | it under the same terms as Perl itself. |
279 | |
c79239a2 |
280 | =begin testing |
281 | |
282 | my $app = MyApp::Website->new( url => "http://google.com", name => "Google" ); |
283 | is( |
284 | $app->dump, q{name: Google |
285 | The site's URL: http://google.com |
286 | }, '... got the expected dump value' |
287 | ); |
288 | |
289 | =end testing |
290 | |
8323a774 |
291 | =cut |
292 | |