wrote roles recipe 3 - applying a role to an object instance

diff --git a/Changes b/Changes
index db54afb..f2c62bf 100644 (file)
--- a/Changes
+++ b/Changes
@@ -5,6 +5,10 @@ Revision history for Perl extension Moose
       - A new recipe which demonstrates the use of BUILDARGS and
         BUILD. (Dave Rolsky)
 
+    * Moose::Cookbook::Roles::Recipe3
+      - A new recipe, applying a role to an object instance. (Dave
+        Rolsky)
+
 0.70 Sat, February 14, 2009
     * Moose::Util::TypeConstraints
       - Added the RoleName type (stevan)

diff --git a/lib/Moose/Cookbook.pod b/lib/Moose/Cookbook.pod
index 9940871..138c68a 100644 (file)
--- a/lib/Moose/Cookbook.pod
+++ b/lib/Moose/Cookbook.pod
@@ -101,9 +101,9 @@ class. Sometimes you want the whole role but one if its methods
 conflicts with one in your class. With method exclusion and aliasing,
 you can work around these problems.
 
-=item L<Moose::Cookbook::Roles::Recipe3> - Runtime Role Composition (TODO)
+=item L<Moose::Cookbook::Roles::Recipe3> - Applying a role to an object instance
 
-I<abstract goes here>
+In this recipe, we apply a role to an existing object instance.
 
 =back
 

diff --git a/lib/Moose/Cookbook/Roles/Recipe3.pod b/lib/Moose/Cookbook/Roles/Recipe3.pod
new file mode 100644 (file)
index 0000000..6e38fd2
--- /dev/null
+++ b/lib/Moose/Cookbook/Roles/Recipe3.pod
@@ -0,0 +1,96 @@
+
+=pod
+
+=head1 NAME
+
+Moose::Cookbook::Roles::Recipe3 - Applying a role to an object instance
+
+=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->assign_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.
+
+=head1 AUTHOR
+
+Dave Rolsky E<lt>autarch@urth.orgE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2006-2009 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut

diff --git a/t/000_recipes/roles/003_instance_application.t b/t/000_recipes/roles/003_instance_application.t
new file mode 100644 (file)
index 0000000..1d71129
--- /dev/null
+++ b/t/000_recipes/roles/003_instance_application.t
@@ -0,0 +1,66 @@
+use strict;
+use warnings;
+
+use Test::More tests => 2;
+
+
+{
+    # 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',
+    );
+}
+
+{
+    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);
+    }
+}
+
+{
+    my $lisa = Employee->new( name => 'Lisa' );
+    MyApp::Role::Job::Manager->meta->apply($lisa);
+
+    ok( $lisa->does('MyApp::Role::Job::Manager'),
+        'lisa now does the manager role' );
+
+    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');
+
+    is( $homer->work, 'mow the lawn',
+        'homer was assigned a task by lisa' );
+}