lib/Moose/Cookbook/Recipe11.pod

   1
   2 =pod
   3
   4 =head1 NAME
   5
   6 Moose::Cookbook::Recipe11 - The meta-attribute example
   7
   8 =head1 SYNOPSIS
   9
  10     package MyApp::Meta::Attribute::Labeled;
  11     use Moose;
  12     extends 'Moose::Meta::Attribute';
  13
  14     has label => (
  15         is  => 'ro',
  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         isa => 'Str',
  30         is => 'rw',
  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             # otherwise print the name
  52             else {
  53                 print $name;
  54             }
  55
  56             # print the attribute's value
  57             my $reader = $attribute->get_read_method;
  58             print ": " . $self->$reader . "\n";
  59         }
  60     }
  61
  62     package main;
  63     my $app = MyApp::Website->new(url => "http://google.com", name => "Google");
  64     $app->dump;
  65
  66 =head1 SUMMARY
  67
  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.
  72
  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.
  77
  78 =head1 REAL ATTRIBUTES 101
  79
  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
  82 concrete example.
  83
  84     has 'x' => (isa => 'Int', is => 'ro');
  85     has 'y' => (isa => 'Int', is => 'rw');
  86
  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.
  93
  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:
  96
  97     $point->meta->get_attribute_map()
  98
  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:
 102
 103     {
 104         x => Moose::Meta::Attribute=HASH(0x196c23c),
 105         y => Moose::Meta::Attribute=HASH(0x18d1690),
 106     }
 107
 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:
 111
 112     print $point->meta->get_attribute('x')->type_constraint;
 113        => Int
 114
 115 (As an aside, it's not called C<< ->isa >> because C<< $obj->isa >> is already
 116 taken)
 117
 118 So to actually beef up attributes, what we need to do is:
 119
 120 =over 4
 121
 122 =item Create a new attribute metaclass
 123
 124 =item Create attributes using that new metaclass
 125
 126 =back
 127
 128 Moose makes both of these easy!
 129
 130 Let's start dissecting the recipe's code.
 131
 132 =head1 DISSECTION
 133
 134 We get the ball rolling by creating a new attribute metaclass. It starts off
 135 somewhat ungloriously.
 136
 137     package MyApp::Meta::Attribute::Labeled;
 138     use Moose;
 139     extends 'Moose::Meta::Attribute';
 140
 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
 143 on.
 144
 145     has label => (
 146         is        => 'ro',
 147         isa       => 'Str',
 148         predicate => 'has_label',
 149     );
 150
 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.
 153
 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?"
 157
 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!
 160
 161     package Moose::Meta::Attribute::Custom::Labeled;
 162     sub register_implementation { 'MyApp::Meta::Attribute::Labeled' }
 163
 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.
 166
 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.
 169
 170     package MyApp::Website;
 171     use Moose;
 172     use MyApp::Meta::Attribute::Labeled;
 173
 174 Nothing new here. We do have to actually load our metaclass to be able to use
 175 it.
 176
 177     has url => (
 178         metaclass => 'Labeled',
 179         isa => 'Str',
 180         is => 'rw',
 181         label => "The site's URL",
 182     );
 183
 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>.
 187
 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. :)
 197
 198 Finally, we see that C<has> is setting our new meta-attribute, C<label>, to
 199 C<"The site's URL">.
 200
 201     has name => (
 202         is => 'rw',
 203         isa => 'Str',
 204     );
 205
 206 You do not of course need to use the new metaclass for all new attributes.
 207
 208 Now we begin defining a method that will dump the C<MyApp::Website> instance
 209 for human readers.
 210
 211     sub dump {
 212         my $self = shift;
 213
 214         # iterate over all the attributes in $self
 215         my %attributes = %{ $self->meta->get_attribute_map };
 216         while (my ($name, $attribute) = each %attributes) {
 217
 218 We covered the latter two lines of code earlier.
 219
 220             # print the label if available
 221             if ($attribute->isa('MyApp::Meta::Attribute::Labeled')
 222                 && $attribute->has_label) {
 223                     print $attribute->label;
 224             }
 225
 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".
 233
 234             # otherwise print the name
 235             else {
 236                 print $name;
 237             }
 238
 239 Another good, defensive coding practice: Provide reasonable defaults.
 240
 241             # print the attribute's value
 242             my $reader = $attribute->get_read_method;
 243             print ": " . $self->$reader . "\n";
 244         }
 245     }
 246
 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)->() >>.
 254
 255     package main;
 256     my $app = MyApp::Website->new(url => "http://google.com", name => "Google");
 257     $app->dump;
 258
 259 And finish off the example with a script to show off our newfound magic.
 260
 261 =head1 CONCLUSION
 262
 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.
 270
 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.
 274
 275     has site_cache => (
 276         metaclass => 'Expiry',
 277         expires_after => '1 hour',
 278         refresh_with => sub { my $self = shift; get($self->url) },
 279         isa => 'Str',
 280     );
 281
 282 The sky's the limit!
 283
 284 =head1 AUTHOR
 285
 286 Shawn M Moore E<lt>sartak@gmail.comE<gt>
 287
 288 =head1 COPYRIGHT AND LICENSE
 289
 290 Copyright 2006, 2007 by Infinity Interactive, Inc.
 291
 292 L<http://www.iinteractive.com>
 293
 294 This library is free software; you can redistribute it and/or modify
 295 it under the same terms as Perl itself.
 296
 297 =cut
 298
 299 1;
 300