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<Eq>. First, note that we've replaced C<use Moose>
-with C<use Moose::Role>. We also have a new sugar function, C<requires>:
-
- requires 'equal_to';
-
-This says that any class which consumes this role must provide an
-C<equal_to> method. It can provide this method directly, or by
-consuming some other role.
-
-The C<Eq> role defines its C<not_equal_to> method in terms of the
-required C<equal_to> method. This lets us minimize the methods that
-consuming classes must provide.
-
-The next role, C<Comparable>, builds on the C<Eq> role. We include
-C<Eq> in C<Comparable> using C<with>, another new sugar function:
-
- with 'Eq';
-
-The C<with> function takes a list of roles to consume. In our example,
-the C<Comparable> role provides the C<equal_to> method required by
-C<Eq>. However, it could opt not to, in which case a class that
-consumed C<Comparable> would have to provide its own C<equal_to>. In
-other words, a role can consume another role I<without> providing any
-required methods.
-
-The C<Comparable> role requires a method, C<compare>:
-
- requires 'compare';
-
-The C<Comparable> role also provides a number of other methods, all of
-which ultimately rely on C<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);
- }
-
-Finally, we define the C<Printable> 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<to_string> method.
-
-An interface role is useful because it defines both a method and a
-I<name>. We know that any class which does this role has a
-C<to_string> 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<Printable> role. (1)
-
-Finally, we have the C<US::Currency> class which consumes both the
-C<Comparable> and C<Printable> roles.
-
- with 'Comparable', 'Printable';
-
-It also defines a regular Moose attribute, C<amount>:
-
- has 'amount' => ( is => 'rw', isa => 'Num', default => 0 );
-
-Finally we see the implementation of the methods required by our
-roles. We have a C<compare> method:
-
- sub compare {
- my ( $self, $other ) = @_;
- $self->amount <=> $other->amount;
- }
-
-By consuming the C<Comparable> role and defining this method, we gain
-the following methods for free: C<equal_to>, C<greater_than>,
-C<less_than>, C<greater_than_or_equal_to> and
-C<less_than_or_equal_to>.
-
-Then we have our C<to_string> 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<Runner> and C<Process>, both of which define a
-C<run> method. If we just require that an object implements a C<run>
-method, we still aren't saying anything about what that method
-I<actually does>. If we require an object that implements the
-C<Executable> 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<Moose::Cookbook::Roles::Comparable_CodeReuse>
=cut
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<Restartable>
-role which provides an C<is_paused> attribute, and two methods,
-C<stop> and C<start>.
-
-Then we have two more roles which implement the same interface, each
-putting their own spin on the C<stop> and C<start> methods.
-
-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).
-
-Note that aliasing simply I<adds> 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<Restartable::ButBroken> role, we want to provide an entirely
-new behavior for C<stop> and C<start>. We exclude them entirely when
-composing the C<Restartable> role into C<Restartable::ButBroken>.
-
-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<Restartable> 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<Moose::Cookbook::Roles::Restartable_AdvancedComposition>
=cut
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<Moose::Meta::Role>
-object provides an C<apply> 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<apply_all_roles> function from L<Moose::Util>.
-
- apply_all_roles( $person, MyApp::Role::Job::Manager->meta );
-
-The main advantage of using C<apply_all_roles> 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<roles
-recipe 2|Moose::Cookbook::Roles::Recipe2>.
-
-=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<Moose::Cookbook::Roles::ApplicationToInstance>
=cut
projects / gitmo/Moose-OldDocs.git / commitdiff