lib/Moose/Cookbook/Recipe21.pod

   1
   2 =pod
   3
   4 =head1 NAME
   5
   6 Moose::Cookbook::Recipe21 - 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  => '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         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?)
 143
 144     has label => (
 145         is        => 'rw',
 146         isa       => 'Str',
 147         predicate => 'has_label',
 148     );
 149
 150 Hey, this looks pretty reasonable! This is plain jane Moose code. Recipe 1
 151 fare. This is merely making a new attribute. An attribute that attributes have.
 152 A meta-attribute. It may sound scary, but it really isn't! Reread
 153 L<REAL ATTRIBUTES 101> if this really is terrifying.
 154
 155 The name is "label", it will have a regular accessor, and is a string.
 156 C<predicate> is a standard part of C<has>. It just creates a method that asks
 157 the question "Does this attribute have a value?"
 158
 159     package Moose::Meta::Attribute::Custom::Labeled;
 160     sub register_implementation { 'MyApp::Meta::Attribute::Labeled' }
 161
 162 This lets Moose discover our new metaclass. That way attributes can actually
 163 use it. More on what this is doing in a moment.
 164
 165 Note that we're done defining the new metaclass! Only nine lines of code, and
 166 not particularly difficult lines, either. Now to start using the metaclass.
 167
 168     package MyApp::Website;
 169     use Moose;
 170     use MyApp::Meta::Attribute::Labeled;
 171
 172 Nothing new here. We do have to actually load our metaclass to be able to use
 173 it.
 174
 175     has url => (
 176         metaclass => 'Labeled',
 177         isa => 'Str',
 178         is => 'rw',
 179         label => "The site's URL",
 180     );
 181
 182 Ah ha! Now we're using the metaclass. We're adding a new attribute, C<url>, to
 183 C<MyApp::Website>. C<has> lets you set the metaclass of the attribute.
 184 Ordinarily (as we've seen), the metaclass is C<Moose::Meta::Attribute>.
 185
 186 When C<has> sees that you're using a new metaclass, it will take the
 187 metaclass's name, prepend C<Moose::Meta::Attribute::Custom::>, and call the
 188 C<register_implementation> function in that package. So here Moose calls
 189 C<Moose::Meta::Attribute::Custom::Labeled::register_implementation>. We defined
 190 that function in the beginning -- it just returns our "real" metaclass'
 191 package, C<MyApp::Meta::Attribute::Labeled>. So Moose uses that metaclass for
 192 the attribute. It may seem a bit convoluted, but the alternative would be to
 193 use C<< metaclass => 'MyApp::Meta::Attribute::Labeled' >> on every attribute.
 194 As usual, Moose optimizes in favor of the end user, not the metaprogrammer. :)
 195 We also could have just defined the metaclass in
 196 C<Moose::Meta::Attribute::Custom::Labeled>, but it's probably better to keep to
 197 your own namespaces.
 198
 199 Finally, we see that C<has> is setting our new meta-attribute, C<label>, to
 200 C<"The site's URL">. We can access this meta-attribute with:
 201
 202     $website->meta->get_attribute('url')->label()
 203
 204 Well, back to the code.
 205
 206     has name => (
 207         is => 'rw',
 208         isa => 'Str',
 209     );
 210
 211 Of course, you don't have to use the new metaclass for B<all> new attributes.
 212
 213 Now we begin defining a method that will dump the C<MyApp::Website> instance
 214 for human readers.
 215
 216     sub dump {
 217         my $self = shift;
 218
 219         # iterate over all the attributes in $self
 220         my %attributes = %{ $self->meta->get_attribute_map };
 221         while (my ($name, $attribute) = each %attributes) {
 222
 223 Recall that C<get_attribute_map> returns a hashref of attribute names and their
 224 associated objects.
 225
 226             # print the label if available
 227             if ($attribute->isa('MyApp::Meta::Attribute::Labeled')
 228                 && $attribute->has_label) {
 229                     print $attribute->label;
 230             }
 231
 232 We have two checks here. The first is "is this attribute an instance of
 233 C<MyApp::Meta::Attribute::Labeled>?". It's good to code defensively. Even if
 234 all of your attributes have this metaclass, you never know when someone is
 235 going to subclass your work of art. Poorly. In other words, it's likely that
 236 there will still be (many) attributes that are instances of the default
 237 C<Moose::Meta::Attribute>.
 238
 239 The second check is "does this attribute have a label?". This method was
 240 defined in the new metaclass as the "predicate". If we pass both checks, we
 241 print the attribute's label.
 242
 243             # otherwise print the name
 244             else {
 245                 print $name;
 246             }
 247
 248 Another good, defensive coding practice: Provide reasonable defaults.
 249
 250             # print the attribute's value
 251             my $reader = $attribute->get_read_method;
 252             print ": " . $self->$reader . "\n";
 253         }
 254     }
 255
 256 Here's another example of using the attribute metaclass.
 257 C<< $attribute->get_read_method >> returns the name of the method that can
 258 be invoked on the original object to read the attribute's value.
 259 C<< $self->$reader >> is an example of "reflection" -- instead of using the
 260 name of the method, we're using a variable with the name of the method in it.
 261 Perl doesn't mind. Another way to write this would be
 262 C<< $self->can($reader)->($self) >>. Yuck. :)
 263
 264     package main;
 265     my $app = MyApp::Website->new(url => "http://google.com", name => "Google");
 266     $app->dump;
 267
 268 And we wrap up the example with a script to show off our newfound magic.
 269
 270 =head1 CONCLUSION
 271
 272 Why oh why would you want to go through all of these contortions when you can
 273 just print "The site's URL" directly in the C<dump> method? For one, the DRY
 274 (Don't Repeat Yourself) principle. If you have it in the C<dump> method, you'll
 275 probably also have it in the C<as_form> method, and C<to_file>, and so on. So
 276 why not have a method that maps attribute names to labels? That could work, but
 277 why not include the label where it belongs, in the attribute's definition?
 278 That way you're also less likely to forget to add the label.
 279
 280 More importantly, this was a very simple example. Your metaclasses aren't
 281 limited to just adding new meta-attributes. For example, you could implement
 282 a metaclass that expires attributes after a certain amount of time. You
 283 might use it as such:
 284
 285     has site_cache => (
 286         metaclass     => 'TimedExpiry',
 287         expires_after => { hours => 1 },
 288         refresh_with  => sub { get($_->url) },
 289         isa           => 'Str',
 290         is            => 'ro',
 291     );
 292
 293 The sky's the limit!
 294
 295 =head1 AUTHOR
 296
 297 Shawn M Moore E<lt>sartak@gmail.comE<gt>
 298
 299 =head1 COPYRIGHT AND LICENSE
 300
 301 Copyright 2006-2008 by Infinity Interactive, Inc.
 302
 303 L<http://www.iinteractive.com>
 304
 305 This library is free software; you can redistribute it and/or modify
 306 it under the same terms as Perl itself.
 307
 308 =cut
 309