--- /dev/null
+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
+
+=cut
--- /dev/null
+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
+
+=cut
--- /dev/null
+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
+
+=cut
projects / gitmo/Moose-OldDocs.git / commitdiff