The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

NAME

Moose::Cookbook::Recipe21 - The meta-attribute example

SYNOPSIS

    package MyApp::Meta::Attribute::Labeled;
    use Moose;
    extends 'Moose::Meta::Attribute';

    has label => (
        is  => 'rw',
        isa => 'Str',
        predicate => 'has_label',
    );

    package Moose::Meta::Attribute::Custom::Labeled;
    sub register_implementation { 'MyApp::Meta::Attribute::Labeled' }

    package MyApp::Website;
    use Moose;
    use MyApp::Meta::Attribute::Labeled;

    has url => (
        metaclass => 'Labeled',
        is        => 'rw',
        isa       => 'Str',
        label     => "The site's URL",
    );

    has name => (
        is  => 'rw',
        isa => 'Str',
    );

    sub dump {
        my $self = shift;

        # iterate over all the attributes in $self
        my %attributes = %{ $self->meta->get_attribute_map };
        while (my ($name, $attribute) = each %attributes) {

            # print the label if available
            if ($attribute->isa('MyApp::Meta::Attribute::Labeled')
                && $attribute->has_label) {
                    print $attribute->label;
            }
            # otherwise print the name
            else {
                print $name;
            }

            # print the attribute's value
            my $reader = $attribute->get_read_method;
            print ": " . $self->$reader . "\n";
        }
    }

    package main;
    my $app = MyApp::Website->new(url => "http://google.com", name => "Google");
    $app->dump;

SUMMARY

In this recipe, we begin to really delve into the wonder of meta-programming. Some readers may scoff and claim that this is the arena only of the most twisted Moose developers. Absolutely not! Any sufficiently twisted developer can benefit greatly from going more meta.

The high-level goal of this recipe's code is to allow each attribute to have a human-readable "label" attached to it. Such labels would be used when showing data to an end user. In this recipe we label the "url" attribute with "The site's URL" and create a simple method to demonstrate how to use that label.

REAL ATTRIBUTES 101

All the attributes of a Moose-based object are actually objects themselves. These objects have methods and (surprisingly) attributes. Let's look at a concrete example.

    has 'x' => (isa => 'Int', is => 'ro');
    has 'y' => (isa => 'Int', is => 'rw');

Ahh, the veritable x and y of the Point example. Internally, every Point has an x object and a y object. They have methods (such as "get_value") and attributes (such as "is_lazy"). What class are they instances of? Moose::Meta::Attribute. You don't normally see the objects lurking behind the scenes, because you usually just use $point->x and $point->y and forget that there's a lot of machinery lying in such methods.

So you have a $point object, which has x and y methods. How can you actually access the objects behind these attributes? Here's one way:

    $point->meta->get_attribute_map()

get_attribute_map returns a hash reference that maps attribute names to their objects. In our case, get_attribute_map might return something that looks like the following:

    {
        x => Moose::Meta::Attribute=HASH(0x196c23c),
        y => Moose::Meta::Attribute=HASH(0x18d1690),
    }

Another way to get a handle on an attribute's object is $self->meta->get_attribute('name'). Here's one thing you can do now that you can interact with the attribute's object directly:

    print $point->meta->get_attribute('x')->type_constraint;
       => Int

(As an aside, it's not called ->isa because $obj->isa is already taken)

So to actually beef up attributes, what we need to do is:

Create a new attribute metaclass
Create attributes using that new metaclass

Moose makes both of these easy!

Let's start dissecting the recipe's code.

DISSECTION

We get the ball rolling by creating a new attribute metaclass. It starts off somewhat ungloriously.

    package MyApp::Meta::Attribute::Labeled;
    use Moose;
    extends 'Moose::Meta::Attribute';

You subclass metaclasses the same way you subclass regular classes. (Extra credit: how in the actual hell can you use the MOP to extend itself?)

    has label => (
        is        => 'rw',
        isa       => 'Str',
        predicate => 'has_label',
    );

Hey, this looks pretty reasonable! This is plain jane Moose code. Recipe 1 fare. This is merely making a new attribute. An attribute that attributes have. A meta-attribute. It may sound scary, but it really isn't! Reread "REAL ATTRIBUTES 101" if this really is terrifying.

The name is "label", it will have a regular accessor, and is a string. predicate is a standard part of has. It just creates a method that asks the question "Does this attribute have a value?"

    package Moose::Meta::Attribute::Custom::Labeled;
    sub register_implementation { 'MyApp::Meta::Attribute::Labeled' }

This lets Moose discover our new metaclass. That way attributes can actually use it. More on what this is doing in a moment.

Note that we're done defining the new metaclass! Only nine lines of code, and not particularly difficult lines, either. Now to start using the metaclass.

    package MyApp::Website;
    use Moose;
    use MyApp::Meta::Attribute::Labeled;

Nothing new here. We do have to actually load our metaclass to be able to use it.

    has url => (
        metaclass => 'Labeled',
        is        => 'rw',
        isa       => 'Str',
        label     => "The site's URL",
    );

Ah ha! Now we're using the metaclass. We're adding a new attribute, url, to MyApp::Website. has lets you set the metaclass of the attribute. Ordinarily (as we've seen), the metaclass is Moose::Meta::Attribute.

When has sees that you're using a new metaclass, it will take the metaclass's name, prepend Moose::Meta::Attribute::Custom::, and call the register_implementation function in that package. So here Moose calls Moose::Meta::Attribute::Custom::Labeled::register_implementation. We defined that function in the beginning -- it just returns our "real" metaclass' package, MyApp::Meta::Attribute::Labeled. So Moose uses that metaclass for the attribute. It may seem a bit convoluted, but the alternative would be to use metaclass => 'MyApp::Meta::Attribute::Labeled' on every attribute. As usual, Moose optimizes in favor of the end user, not the metaprogrammer. :) We also could have just defined the metaclass in Moose::Meta::Attribute::Custom::Labeled, but it's probably better to keep to your own namespaces.

Finally, we see that has is setting our new meta-attribute, label, to "The site's URL". We can access this meta-attribute with:

    $website->meta->get_attribute('url')->label()

Well, back to the code.

    has name => (
        is  => 'rw',
        isa => 'Str',
    );

Of course, you don't have to use the new metaclass for all new attributes.

Now we begin defining a method that will dump the MyApp::Website instance for human readers.

    sub dump {
        my $self = shift;

        # iterate over all the attributes in $self
        my %attributes = %{ $self->meta->get_attribute_map };
        while (my ($name, $attribute) = each %attributes) {

Recall that get_attribute_map returns a hashref of attribute names and their associated objects.

            # print the label if available
            if ($attribute->isa('MyApp::Meta::Attribute::Labeled')
                && $attribute->has_label) {
                    print $attribute->label;
            }

We have two checks here. The first is "is this attribute an instance of MyApp::Meta::Attribute::Labeled?". It's good to code defensively. Even if all of your attributes have this metaclass, you never know when someone is going to subclass your work of art. Poorly. In other words, it's likely that there will still be (many) attributes that are instances of the default Moose::Meta::Attribute.

The second check is "does this attribute have a label?". This method was defined in the new metaclass as the "predicate". If we pass both checks, we print the attribute's label.

            # otherwise print the name
            else {
                print $name;
            }

Another good, defensive coding practice: Provide reasonable defaults.

            # print the attribute's value
            my $reader = $attribute->get_read_method;
            print ": " . $self->$reader . "\n";
        }
    }

Here's another example of using the attribute metaclass. $attribute->get_read_method returns the name of the method that can be invoked on the original object to read the attribute's value. $self->$reader is an example of "reflection" -- instead of using the name of the method, we're using a variable with the name of the method in it. Perl doesn't mind. Another way to write this would be $self->can($reader)->($self). Yuck. :)

    package main;
    my $app = MyApp::Website->new(url => "http://google.com", name => "Google");
    $app->dump;

And we wrap up the example with a script to show off our newfound magic.

CONCLUSION

Why oh why would you want to go through all of these contortions when you can just print "The site's URL" directly in the dump method? For one, the DRY (Don't Repeat Yourself) principle. If you have it in the dump method, you'll probably also have it in the as_form method, and to_file, and so on. So why not have a method that maps attribute names to labels? That could work, but why not include the label where it belongs, in the attribute's definition? That way you're also less likely to forget to add the label.

More importantly, this was a very simple example. Your metaclasses aren't limited to just adding new meta-attributes. For example, you could implement a metaclass that expires attributes after a certain amount of time. You might use it as such:

    has site_cache => (
        metaclass     => 'TimedExpiry',
        expires_after => { hours => 1 },
        refresh_with  => sub { get($_->url) },
        isa           => 'Str',
        is            => 'ro',
    );

The sky's the limit!

AUTHOR

Shawn M Moore <sartak@gmail.com>

COPYRIGHT AND LICENSE

Copyright 2006-2008 by Infinity Interactive, Inc.

http://www.iinteractive.com

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.