=head1 NAME
-Moose::Cookbook::Recipe11 - The meta-attribute example
+Moose::Cookbook::Recipe11 - Advanced Role Composition - method exclusion and aliasing
=head1 SYNOPSIS
- package MyApp::Meta::Attribute::Labeled;
- use Moose;
- extends 'Moose::Meta::Attribute';
-
- __PACKAGE__->meta->add_attribute('label' => (
- reader => 'label',
- predicate => 'has_label',
- ));
+ package Restartable;
+ use Moose::Role;
- package Moose::Meta::Attribute::Custom::Labeled;
- sub register_implementation { 'MyApp::Meta::Attribute::Labeled' }
+ has 'is_paused' => (
+ is => 'rw',
+ isa => 'Boo',
+ default => 0,
+ );
- package MyApp::Website;
- use Moose;
- use MyApp::Meta::Attribute::Labeled;
+ requires 'save_state', 'load_state';
- has url => (
- metaclass => 'Labeled',
- isa => 'Str',
- is => 'rw',
- label => "The site's URL",
- );
+ sub stop { ... }
- has name => (
- is => 'rw',
- isa => 'Str',
- );
+ sub start { ... }
- sub dump {
- my $self = shift;
+ package Restartable::ButUnreliable;
+ use Moose::Role;
- # iterate over all the attributes in $self
- my %attributes = %{ $self->meta->get_attribute_map };
- while (my ($name, $meta_attribute) = each %attributes) {
+ with 'Restartable' => { alias => { stop => '_stop',
+ start => '_start' } };
- # print the label if available
- if ($meta_attribute->isa('MyApp::Meta::Attribute::Labeled')
- && $meta_attribute->has_label) {
- print $meta_attribute->label;
- }
- # otherwise print the name
- else {
- print $name;
- }
+ sub stop {
+ my $self = shift;
- # print the attribute's value
- my $reader = $meta_attribute->get_read_method;
- print ": " . $self->$reader . "\n";
- }
- }
+ $self->explode() if rand(1) > .5;
- package main;
- my $app = MyApp::Website->new(url => "http://google.com", name => "Google");
- $app->dump;
+ $self->_stop();
+ }
-=head1 SUMMARY
+ sub start {
+ my $self = shift;
-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.
+ $self->explode() if rand(1) > .5;
-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.
+ $self->_start();
+ }
-=head1 REAL ATTRIBUTES 101
+ package Restartable::ButBroken;
+ use Moose::Role;
-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.
+ with 'Restartable' => { excludes => [ 'stop', 'start' ] };
- has 'x' => (isa => 'Int', is => 'ro');
- has 'y' => (isa => 'Int', is => 'rw');
+ sub stop {
+ my $self = shift;
-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?
-L<Moose::Meta::Attribute>. You don't normally see the objects lurking behind
-the scenes, because you usually just use C<< $point->x >> and C<< $point->y >>
-and forget that there's a lot of machinery lying in such methods.
+ $self->explode();
+ }
-So you have a C<$point> object, which has C<x> and C<y> methods. How can you
-actually access the objects behind these attributes? Here's one way:
+ sub start {
+ my $self = shift;
- $point->meta->get_attribute_map()
+ $self->explode();
+ }
-C<get_attribute_map> returns a hash reference that maps attribute names to
-their objects. In our case, C<get_attribute_map> might return something that
-looks like the following:
+=head1 DESCRIPTION
- {
- x => Moose::Meta::Attribute=HASH(0x196c23c),
- y => Moose::Meta::Attribute=HASH(0x18d1690),
- }
+Sometimes when you include a role in a class, you may want to leave
+out some of its methods. In this example, we have a role C<Restartable>
+which provides an C<is_paused> attribute, and two methods, C<stop> and
+C<start>. The implementation of those two methods is irrelevant.
-Here's one thing you can do now that you can interact with the attribute's
-object directly:
+Then we have two more roles which also implement the same interface,
+each putting their own spin on the C<stop> and C<start> method.
- print $point->meta->get_attribute_map->{x}->type_constraint;
- => Int
+In the C<Restartable::ButUnreliable> role, we want to provide a new
+implementation of C<stop> and C<start>, but still have access to the
+original implementation. To do this, we alias the methods from
+C<Restartable> to private methods, and provide wrappers around the
+originals (1).
-(As an aside, it's not called C<< ->isa >> because C<< $obj->isa >> is already
-taken)
+In the C<Restartable::ButBroken> role, we want to provide an entirely
+new behavior for C<stop> and C<start>, so we exclude them when
+composing the C<Restartable> role into C<Restartable::ButBroken>.
-So to actually beef up attributes, what we need to do is:
+It's worth noting that the C<excludes> parameter also accepts a single
+string as an argument if you just want to exclude one method.
-=over 4
-
-=item Create a new attribute metaclass
-
-=item Create attributes using that new metaclass
-
-=back
-
-Moose makes both of these easy!
-
-Let's start dissecting the recipe's code.
-
-=head1 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?) Moving
-on.
-
- __PACKAGE__->meta->add_attribute('label' => (
- reader => 'label',
- predicate => 'has_label',
- ));
-
-Now things get a little icky. We're adding a attribute to the attribute
-metaclass. For clarity, I'm going to call this a meta-attribute.
-
-So. This creates a new meta-attribute in the C<MyApp::Meta::Attribute::Labeled>
-metaclass. The new meta-attribute's name is 'label'. We get reader and
-predicate methods, too. The reader method retrieves the value of this
-meta-attribute, the predicate method just asks the question "Does this
-meta-attribute even have a value?"
-
-Note the resemblance between C<add_attribute> and C<has>. C<has> actually just
-uses C<add_attribute> behind the scenes.
-
- package Moose::Meta::Attribute::Custom::Labeled;
- sub register_implementation { 'MyApp::Meta::Attribute::Labeled' }
-
-This registers the new metaclass with Moose. 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',
- isa => 'Str',
- is => 'rw',
- label => "The site's URL",
- );
-
-Ah ha! Now we're using the metaclass. We're adding a new attribute, C<url>, to
-C<MyApp::Website>. C<has> lets you set the metaclass of the attribute.
-Ordinarily (as we've seen), the metaclass is C<Moose::Meta::Attribute>.
-
-When C<has> sees that you're using a new metaclass, it will take the
-metaclass's name, prepend C<Moose::Meta::Attribute::Custom::>, and call the
-C<register_implementation> function in that package. So here Moose calls
-C<Moose::Meta::Attribute::Custom::Labeled::register_implementation>. We defined
-that function in the beginning -- it just returns our "real" metaclass'
-package, C<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 C<< metaclass => 'MyApp::Meta::Attribute::Labeled' >> on every attribute.
-As usual, Moose optimizes in favor of the end user, not the metaprogrammer. :)
-
-Finally, we see that C<has> is setting our new meta-attribute, C<label>, to
-C<"The site's URL">.
-
- has name => (
- is => 'rw',
- isa => 'Str',
- );
-
-You do not of course need to use the new metaclass for all new attributes.
-
-Now we begin defining a method that will dump the C<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, $meta_attribute) = each %attributes) {
-
-We covered the latter two lines of code earlier.
+=head1 CONCLUSION
- # print the label if available
- if ($meta_attribute->isa('MyApp::Meta::Attribute::Labeled')
- && $meta_attribute->has_label) {
- print $meta_attribute->label;
- }
+Method exclusion and renaming can come in handy, especially when
+building roles out of other roles. In this example, all of our roles
+implement the C<Restartable> role. Each role provides same API, but
+each has a different implementation under the hood.
-Note that we have two checks here. The first is "is this attribute an instance
-of C<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. 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. The
-C<< ->label >> method was defined in the new metaclass as the "reader".
-
- # otherwise print the name
- else {
- print $name;
- }
-
-Another good, defensive coding practice: Provide reasonable defaults.
-
- # print the attribute's value
- my $reader = $meta_attribute->get_read_method;
- print ": " . $self->$reader . "\n";
- }
- }
-
-Here's another example of using the attribute metaclass. C<<
-$meta_attribute->get_read_method >> returns the name of the method that can
-invoked on the original object to read the attribute's value. C<<
-$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
-C<< $self->can($reader)->() >>.
-
- package main;
- my $app = MyApp::Website->new(url => "http://google.com", name => "Google");
- $app->dump;
-
-And finish off the example with a script to show off our newfound magic.
+You can also use the method aliasing and excluding features when
+composing a role into a class.
-=head1 CONCLUSION
+=head1 FOOTNOTES
-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 C<dump> method? For one, the DRY
-(Don't Repeat Yourself) principle. If you have it in the C<dump> method, you'll
-probably also have it in the C<as_form> method, and C<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.
+=over 4
-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.
+=item (1)
- has site_cache => (
- metaclass => 'Expiry',
- expires_after => '1 hour',
- refresh_with => sub { ... },
- isa => 'Str',
- );
+The mention of wrapper should tell you that we could do the same thing
+using method modifiers, but for the sake of this example, we don't.
-The sky's the limit!
+=back
=head1 AUTHOR
-Shawn M Moore E<lt>sartak@gmail.comE<gt>
+Dave Rolsky E<lt>autarch@urth.orgE<gt>
=head1 COPYRIGHT AND LICENSE
-Copyright 2006, 2007 by Infinity Interactive, Inc.
+Copyright 2006-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
it under the same terms as Perl itself.
=cut
-
-1;
-
projects / gitmo/Moose.git / blobdiff