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 Here's one thing you can do now that you can interact with the attribute's
 109 object directly:
 110
 111     print $point->meta->get_attribute_map->{x}->type_constraint;
 112       => Int
 113
 114 (As an aside, it's not called C<< ->isa >> because C<< $obj->isa >> is already
 115 taken)
 116
 117 So to actually beef up attributes, what we need to do is:
 118
 119 =over 4
 120
 121 =item Create a new attribute metaclass
 122
 123 =item Create attributes using that new metaclass
 124
 125 =back
 126
 127 Moose makes both of these easy!
 128
 129 Let's start dissecting the recipe's code.
 130
 131 =head1 DISSECTION
 132
 133 We get the ball rolling by creating a new attribute metaclass. It starts off
 134 somewhat ungloriously.
 135
 136     package MyApp::Meta::Attribute::Labeled;
 137     use Moose;
 138     extends 'Moose::Meta::Attribute';
 139
 140 You subclass metaclasses the same way you subclass regular classes. (Extra
 141 credit: how in the actual hell can you use the MOP to extend itself?) Moving
 142 on.
 143
 144     has label => (
 145         is        => 'ro',
 146         isa       => 'Str',
 147         predicate => 'has_label',
 148     );
 149
 150 Now things get a little icky. We're adding a attribute to the attribute
 151 metaclass. For clarity, I'm going to call this a meta-attribute.
 152
 153 This creates a new meta-attribute in the C<MyApp::Meta::Attribute::Labeled>
 154 metaclass. The new meta-attribute's name is 'label'. The predicate just creates
 155 a method that asks the question "Does this attribute have a value?"
 156
 157 Of course, if you step a foot back, you can see that this is really just adding
 158 an attribute to a class. Don't be alarmed!
 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
 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>.
 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
 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. :)
 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, $attribute) = each %attributes) {
 216
 217 We covered the latter two lines of code earlier.
 218
 219             # print the label if available
 220             if ($attribute->isa('MyApp::Meta::Attribute::Labeled')
 221                 && $attribute->has_label) {
 222                     print $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
 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".
 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 = $attribute->get_read_method;
 242             print ": " . $self->$reader . "\n";
 243         }
 244     }
 245
 246 Here's another example of using the attribute metaclass.  C<<
 247 $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)->() >>.
 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 { my $self = shift; get($self->url) },
 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