From: Dave Rolsky Date: Mon, 20 Feb 2012 22:47:52 +0000 (-0600) Subject: Add links for Roles recipes X-Git-Tag: v0.02~3 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMoose-OldDocs.git;a=commitdiff_plain;h=57e3c69eee6def4e480e55c41a300cf2b47c88f1 Add links for Roles recipes --- diff --git a/lib/Moose/Cookbook/Roles/Recipe1.pod b/lib/Moose/Cookbook/Roles/Recipe1.pod index 2a3d44a..956b4c9 100644 --- a/lib/Moose/Cookbook/Roles/Recipe1.pod +++ b/lib/Moose/Cookbook/Roles/Recipe1.pod @@ -1,318 +1,9 @@ package Moose::Cookbook::Roles::Recipe1; -# ABSTRACT: The Moose::Role example - __END__ - =pod -=head1 SYNOPSIS - - package Eq; - use Moose::Role; - - requires 'equal_to'; - - sub not_equal_to { - my ( $self, $other ) = @_; - not $self->equal_to($other); - } - - package Comparable; - use Moose::Role; - - with 'Eq'; - - requires 'compare'; - - sub equal_to { - my ( $self, $other ) = @_; - $self->compare($other) == 0; - } - - sub greater_than { - my ( $self, $other ) = @_; - $self->compare($other) == 1; - } - - sub less_than { - my ( $self, $other ) = @_; - $self->compare($other) == -1; - } - - sub greater_than_or_equal_to { - my ( $self, $other ) = @_; - $self->greater_than($other) || $self->equal_to($other); - } - - sub less_than_or_equal_to { - my ( $self, $other ) = @_; - $self->less_than($other) || $self->equal_to($other); - } - - package Printable; - use Moose::Role; - - requires 'to_string'; - - package US::Currency; - use Moose; - - with 'Comparable', 'Printable'; - - has 'amount' => ( is => 'rw', isa => 'Num', default => 0 ); - - sub compare { - my ( $self, $other ) = @_; - $self->amount <=> $other->amount; - } - - sub to_string { - my $self = shift; - sprintf '$%0.2f USD' => $self->amount; - } - -=head1 DESCRIPTION - -Roles have two primary purposes: as interfaces, and as a means of code -reuse. This recipe demonstrates the latter, with roles that define -comparison and display code for objects. - -Let's start with C. First, note that we've replaced C -with C. We also have a new sugar function, C: - - requires 'equal_to'; - -This says that any class which consumes this role must provide an -C method. It can provide this method directly, or by -consuming some other role. - -The C role defines its C method in terms of the -required C method. This lets us minimize the methods that -consuming classes must provide. - -The next role, C, builds on the C role. We include -C in C using C, another new sugar function: - - with 'Eq'; - -The C function takes a list of roles to consume. In our example, -the C role provides the C method required by -C. However, it could opt not to, in which case a class that -consumed C would have to provide its own C. In -other words, a role can consume another role I providing any -required methods. - -The C role requires a method, C: - - requires 'compare'; - -The C role also provides a number of other methods, all of -which ultimately rely on C. - - sub equal_to { - my ( $self, $other ) = @_; - $self->compare($other) == 0; - } - - sub greater_than { - my ( $self, $other ) = @_; - $self->compare($other) == 1; - } - - sub less_than { - my ( $self, $other ) = @_; - $self->compare($other) == -1; - } - - sub greater_than_or_equal_to { - my ( $self, $other ) = @_; - $self->greater_than($other) || $self->equal_to($other); - } - - sub less_than_or_equal_to { - my ( $self, $other ) = @_; - $self->less_than($other) || $self->equal_to($other); - } - -Finally, we define the C role. This role exists solely to -provide an interface. It has no methods, just a list of required methods. -In this case, it just requires a C method. - -An interface role is useful because it defines both a method and a -I. We know that any class which does this role has a -C method, but we can also assume that this method has the -semantics we want. Presumably, in real code we would define those -semantics in the documentation for the C role. (1) - -Finally, we have the C class which consumes both the -C and C roles. - - with 'Comparable', 'Printable'; - -It also defines a regular Moose attribute, C: - - has 'amount' => ( is => 'rw', isa => 'Num', default => 0 ); - -Finally we see the implementation of the methods required by our -roles. We have a C method: - - sub compare { - my ( $self, $other ) = @_; - $self->amount <=> $other->amount; - } - -By consuming the C role and defining this method, we gain -the following methods for free: C, C, -C, C and -C. - -Then we have our C method: - - sub to_string { - my $self = shift; - sprintf '$%0.2f USD' => $self->amount; - } - -=head1 CONCLUSION - -Roles can be very powerful. They are a great way of encapsulating -reusable behavior, as well as communicating (semantic and interface) -information about the methods our classes provide. - -=head1 FOOTNOTES - -=over 4 - -=item (1) - -Consider two classes, C and C, both of which define a -C method. If we just require that an object implements a C -method, we still aren't saying anything about what that method -I. If we require an object that implements the -C role, we're saying something about semantics. - -=back - -=begin testing - -ok( US::Currency->does('Comparable'), '... US::Currency does Comparable' ); -ok( US::Currency->does('Eq'), '... US::Currency does Eq' ); -ok( US::Currency->does('Printable'), '... US::Currency does Printable' ); - -my $hundred = US::Currency->new( amount => 100.00 ); -isa_ok( $hundred, 'US::Currency' ); - -ok( $hundred->DOES("US::Currency"), "UNIVERSAL::DOES for class" ); -ok( $hundred->DOES("Comparable"), "UNIVERSAL::DOES for role" ); - -can_ok( $hundred, 'amount' ); -is( $hundred->amount, 100, '... got the right amount' ); - -can_ok( $hundred, 'to_string' ); -is( $hundred->to_string, '$100.00 USD', - '... got the right stringified value' ); - -ok( $hundred->does('Comparable'), '... US::Currency does Comparable' ); -ok( $hundred->does('Eq'), '... US::Currency does Eq' ); -ok( $hundred->does('Printable'), '... US::Currency does Printable' ); - -my $fifty = US::Currency->new( amount => 50.00 ); -isa_ok( $fifty, 'US::Currency' ); - -can_ok( $fifty, 'amount' ); -is( $fifty->amount, 50, '... got the right amount' ); - -can_ok( $fifty, 'to_string' ); -is( $fifty->to_string, '$50.00 USD', '... got the right stringified value' ); - -ok( $hundred->greater_than($fifty), '... 100 gt 50' ); -ok( $hundred->greater_than_or_equal_to($fifty), '... 100 ge 50' ); -ok( !$hundred->less_than($fifty), '... !100 lt 50' ); -ok( !$hundred->less_than_or_equal_to($fifty), '... !100 le 50' ); -ok( !$hundred->equal_to($fifty), '... !100 eq 50' ); -ok( $hundred->not_equal_to($fifty), '... 100 ne 50' ); - -ok( !$fifty->greater_than($hundred), '... !50 gt 100' ); -ok( !$fifty->greater_than_or_equal_to($hundred), '... !50 ge 100' ); -ok( $fifty->less_than($hundred), '... 50 lt 100' ); -ok( $fifty->less_than_or_equal_to($hundred), '... 50 le 100' ); -ok( !$fifty->equal_to($hundred), '... !50 eq 100' ); -ok( $fifty->not_equal_to($hundred), '... 50 ne 100' ); - -ok( !$fifty->greater_than($fifty), '... !50 gt 50' ); -ok( $fifty->greater_than_or_equal_to($fifty), '... !50 ge 50' ); -ok( !$fifty->less_than($fifty), '... 50 lt 50' ); -ok( $fifty->less_than_or_equal_to($fifty), '... 50 le 50' ); -ok( $fifty->equal_to($fifty), '... 50 eq 50' ); -ok( !$fifty->not_equal_to($fifty), '... !50 ne 50' ); - -## ... check some meta-stuff - -# Eq - -my $eq_meta = Eq->meta; -isa_ok( $eq_meta, 'Moose::Meta::Role' ); - -ok( $eq_meta->has_method('not_equal_to'), '... Eq has_method not_equal_to' ); -ok( $eq_meta->requires_method('equal_to'), - '... Eq requires_method not_equal_to' ); - -# Comparable - -my $comparable_meta = Comparable->meta; -isa_ok( $comparable_meta, 'Moose::Meta::Role' ); - -ok( $comparable_meta->does_role('Eq'), '... Comparable does Eq' ); - -foreach my $method_name ( - qw( - equal_to not_equal_to - greater_than greater_than_or_equal_to - less_than less_than_or_equal_to - ) - ) { - ok( $comparable_meta->has_method($method_name), - '... Comparable has_method ' . $method_name ); -} - -ok( $comparable_meta->requires_method('compare'), - '... Comparable requires_method compare' ); - -# Printable - -my $printable_meta = Printable->meta; -isa_ok( $printable_meta, 'Moose::Meta::Role' ); - -ok( $printable_meta->requires_method('to_string'), - '... Printable requires_method to_string' ); - -# US::Currency - -my $currency_meta = US::Currency->meta; -isa_ok( $currency_meta, 'Moose::Meta::Class' ); - -ok( $currency_meta->does_role('Comparable'), - '... US::Currency does Comparable' ); -ok( $currency_meta->does_role('Eq'), '... US::Currency does Eq' ); -ok( $currency_meta->does_role('Printable'), - '... US::Currency does Printable' ); - -foreach my $method_name ( - qw( - amount - equal_to not_equal_to - compare - greater_than greater_than_or_equal_to - less_than less_than_or_equal_to - to_string - ) - ) { - ok( $currency_meta->has_method($method_name), - '... US::Currency has_method ' . $method_name ); -} - -=end testing +=head1 RENAMED TO L =cut diff --git a/lib/Moose/Cookbook/Roles/Recipe2.pod b/lib/Moose/Cookbook/Roles/Recipe2.pod index 096abfd..c425e32 100644 --- a/lib/Moose/Cookbook/Roles/Recipe2.pod +++ b/lib/Moose/Cookbook/Roles/Recipe2.pod @@ -1,169 +1,9 @@ package Moose::Cookbook::Roles::Recipe2; -# ABSTRACT: Advanced Role Composition - method exclusion and aliasing - __END__ - =pod -=head1 SYNOPSIS - - package Restartable; - use Moose::Role; - - has 'is_paused' => ( - is => 'rw', - isa => 'Bool', - default => 0, - ); - - requires 'save_state', 'load_state'; - - sub stop { 1 } - - sub start { 1 } - - package Restartable::ButUnreliable; - use Moose::Role; - - with 'Restartable' => { - -alias => { - stop => '_stop', - start => '_start' - }, - -excludes => [ 'stop', 'start' ], - }; - - sub stop { - my $self = shift; - - $self->explode() if rand(1) > .5; - - $self->_stop(); - } - - sub start { - my $self = shift; - - $self->explode() if rand(1) > .5; - - $self->_start(); - } - - package Restartable::ButBroken; - use Moose::Role; - - with 'Restartable' => { -excludes => [ 'stop', 'start' ] }; - - sub stop { - my $self = shift; - - $self->explode(); - } - - sub start { - my $self = shift; - - $self->explode(); - } - -=head1 DESCRIPTION - -In this example, we demonstrate how to exercise fine-grained control -over what methods we consume from a role. We have a C -role which provides an C attribute, and two methods, -C and C. - -Then we have two more roles which implement the same interface, each -putting their own spin on the C and C methods. - -In the C role, we want to provide a new -implementation of C and C, but still have access to the -original implementation. To do this, we alias the methods from -C to private methods, and provide wrappers around the -originals (1). - -Note that aliasing simply I a name, so we also need to exclude the -methods with their original names. - - with 'Restartable' => { - -alias => { - stop => '_stop', - start => '_start' - }, - -excludes => [ 'stop', 'start' ], - }; - -In the C role, we want to provide an entirely -new behavior for C and C. We exclude them entirely when -composing the C role into C. - -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. - - with 'Restartable' => { -excludes => [ 'stop', 'start' ] }; - -=head1 CONCLUSION - -Exclusion and renaming are a power tool that can be handy, especially -when building roles out of other roles. In this example, all of our -roles implement the C role. Each role provides same API, -but each has a different implementation under the hood. - -You can also use the method aliasing and excluding features when -composing a role into a class. - -=head1 FOOTNOTES - -=over 4 - -=item (1) - -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. - -=back - -=begin testing - -{ - my $unreliable = Moose::Meta::Class->create_anon_class( - superclasses => [], - roles => [qw/Restartable::ButUnreliable/], - methods => { - explode => sub { }, # nop. - 'save_state' => sub { }, - 'load_state' => sub { }, - }, - )->new_object(); - ok( $unreliable, 'made anon class with Restartable::ButUnreliable role' ); - can_ok( $unreliable, qw/start stop/ ); -} - -{ - my $cnt = 0; - my $broken = Moose::Meta::Class->create_anon_class( - superclasses => [], - roles => [qw/Restartable::ButBroken/], - methods => { - explode => sub { $cnt++ }, - 'save_state' => sub { }, - 'load_state' => sub { }, - }, - )->new_object(); - - ok( $broken, 'made anon class with Restartable::ButBroken role' ); - - $broken->start(); - - is( $cnt, 1, '... start called explode' ); - - $broken->stop(); - - is( $cnt, 2, '... stop also called explode' ); -} - -=end testing +=head1 RENAMED TO L =cut diff --git a/lib/Moose/Cookbook/Roles/Recipe3.pod b/lib/Moose/Cookbook/Roles/Recipe3.pod index b81c9f4..b03f8b2 100644 --- a/lib/Moose/Cookbook/Roles/Recipe3.pod +++ b/lib/Moose/Cookbook/Roles/Recipe3.pod @@ -1,131 +1,9 @@ package Moose::Cookbook::Roles::Recipe3; -# ABSTRACT: Applying a role to an object instance - __END__ -package Moose::Cookbook::Roles::Recipe3; - =pod -=begin testing-SETUP - -{ - # Not in the recipe, but needed for writing tests. - package Employee; - - use Moose; - - has 'name' => ( - is => 'ro', - isa => 'Str', - required => 1, - ); - - has 'work' => ( - is => 'rw', - isa => 'Str', - predicate => 'has_work', - ); -} - -=end testing-SETUP - -=head1 SYNOPSIS - - package MyApp::Role::Job::Manager; - - use List::Util qw( first ); - - use Moose::Role; - - has 'employees' => ( - is => 'rw', - isa => 'ArrayRef[Employee]', - ); - - sub assign_work { - my $self = shift; - my $work = shift; - - my $employee = first { !$_->has_work } @{ $self->employees }; - - die 'All my employees have work to do!' unless $employee; - - $employee->work($work); - } - - package main; - - my $lisa = Employee->new( name => 'Lisa' ); - MyApp::Role::Job::Manager->meta->apply($lisa); - - my $homer = Employee->new( name => 'Homer' ); - my $bart = Employee->new( name => 'Bart' ); - my $marge = Employee->new( name => 'Marge' ); - - $lisa->employees( [ $homer, $bart, $marge ] ); - $lisa->assign_work('mow the lawn'); - -=head1 DESCRIPTION - -In this recipe, we show how a role can be applied to an object. In -this specific case, we are giving an employee managerial -responsibilities. - -Applying a role to an object is simple. The L -object provides an C method. This method will do the right -thing when given an object instance. - - MyApp::Role::Job::Manager->meta->apply($lisa); - -We could also use the C function from L. - - apply_all_roles( $person, MyApp::Role::Job::Manager->meta ); - -The main advantage of using C is that it can be used -to apply more than one role at a time. - -We could also pass parameters to the role we're applying: - - MyApp::Role::Job::Manager->meta->apply( - $lisa, - -alias => { assign_work => 'get_off_your_lazy_behind' }, - ); - -We saw examples of how method exclusion and alias working in L. - -=head1 CONCLUSION - -Applying a role to an object instance is a useful tool for adding -behavior to existing objects. In our example, it is effective used to -model a promotion. - -It can also be useful as a sort of controlled monkey-patching for -existing code, particularly non-Moose code. For example, you could -create a debugging role and apply it to an object at runtime. - -=begin testing - -{ - my $lisa = Employee->new( name => 'Lisa' ); - MyApp::Role::Job::Manager->meta->apply($lisa); - - my $homer = Employee->new( name => 'Homer' ); - my $bart = Employee->new( name => 'Bart' ); - my $marge = Employee->new( name => 'Marge' ); - - $lisa->employees( [ $homer, $bart, $marge ] ); - $lisa->assign_work('mow the lawn'); - - ok( $lisa->does('MyApp::Role::Job::Manager'), - 'lisa now does the manager role' ); - - is( $homer->work, 'mow the lawn', - 'homer was assigned a task by lisa' ); -} - -=end testing +=head1 RENAMED TO L =cut