X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FCookbook%2FRoles%2FRecipe1.pod;h=7478c19e60b3e6b2c804186e8240709d1284d016;hb=c79239a22fc3b30cac35dec0d704c7da52872aa5;hp=eca888745811ec5c18fdcfcc1405adf5b7233d96;hpb=021b8139fcacfbd1c0d4dc26e07936457f1ba12b;p=gitmo%2FMoose.git

diff --git a/lib/Moose/Cookbook/Roles/Recipe1.pod b/lib/Moose/Cookbook/Roles/Recipe1.pod
index eca8887..7478c19 100644
--- a/lib/Moose/Cookbook/Roles/Recipe1.pod
+++ b/lib/Moose/Cookbook/Roles/Recipe1.pod
@@ -9,180 +9,175 @@ Moose::Cookbook::Roles::Recipe1 - The Moose::Role example
 
   package Eq;
   use Moose::Role;
-  
+
   requires 'equal_to';
-  
-  sub not_equal_to { 
-      my ($self, $other) = @_;
+
+  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) = @_;
+      my ( $self, $other ) = @_;
       $self->compare($other) == 0;
-  }    
-  
+  }
+
   sub greater_than {
-      my ($self, $other) = @_;
+      my ( $self, $other ) = @_;
       $self->compare($other) == 1;
-  }    
-  
+  }
+
   sub less_than {
-      my ($self, $other) = @_;
+      my ( $self, $other ) = @_;
       $self->compare($other) == -1;
   }
-  
+
   sub greater_than_or_equal_to {
-      my ($self, $other) = @_;
+      my ( $self, $other ) = @_;
       $self->greater_than($other) || $self->equal_to($other);
-  }        
-  
+  }
+
   sub less_than_or_equal_to {
-      my ($self, $other) = @_;
+      my ( $self, $other ) = @_;
       $self->less_than($other) || $self->equal_to($other);
-  }  
-  
+  }
+
   package Printable;
   use Moose::Role;
-  
-  requires 'to_string';    
-  
+
+  requires 'to_string';
+
   package US::Currency;
   use Moose;
-  
+
   with 'Comparable', 'Printable';
-  
-  has 'amount' => (is => 'rw', isa => 'Num', default => 0);
-  
+
+  has 'amount' => ( is => 'rw', isa => 'Num', default => 0 );
+
   sub compare {
-      my ($self, $other) = @_;
+      my ( $self, $other ) = @_;
       $self->amount <=> $other->amount;
   }
-  
+
   sub to_string {
       my $self = shift;
-      sprintf '$%0.2f USD' => $self->amount
+      sprintf '$%0.2f USD' => $self->amount;
   }
 
 =head1 DESCRIPTION
 
-In this recipe we examine the role support provided in Moose. "Roles" may be
-described in many ways, but there are two main ways in which they are used: as
-interfaces, and as a means of code reuse. This recipe demonstrates the
-construction and incorporation of roles that define comparison and display of
-objects.
+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 by examining B<Eq>. You'll notice that instead of the familiar C<use
-Moose> you might be expecting, here we use C<Moose::Role> to make it clear that
-this is a role. We encounter a new keyword, C<requires>:
+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<required>:
 
   requires 'equal_to';
 
-What this does is to indicate that any class which "consumes" (that is to say,
-"includes using C<with>", as we'll see a little later) the B<Eq> role I<must>
-include an C<equal_to> method, whether this is provided by the class itself, one
-of its superclasses, or another role consumed by the class (1).
+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.
 
-In addition to requiring an C<equal_to> method, B<Eq> defines a C<not_equal_to>
-method, which simply inverts the result of C<equal_to>. Defining additional
-methods in this way, by using only a few base methods that target classes must
-define, is a useful pattern to provide maximum functionality with minimum
-effort.
+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.
 
-After the minimal B<Eq>, we next move on to B<Comparable>. The first thing you
-will notice is another new keyword, C<with>:
+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';
 
-C<with> is used to provide a list of roles which this class (or role) consumes.
-Here, B<Comparable> only consumes one role (B<Eq>). In effect, it is as if we
-defined a C<not_equal_to> method within Comparable, and also promised to fulfill
-the requirement of an C<equal_to> method.
+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.
 
-B<Comparable> itself states that it requires C<compare>. Again, it means that
-any classes consuming this role must implement a C<compare> method.
+The C<Comparable> role requires a method,  C<compare>:
 
   requires 'compare';
 
-B<Comparable> defines an C<equal_to> method which satisfies the B<Eq> role's
-requirements. This, along with a number of other methods (C<greater_than>,
-C<less_than>, C<greater_than_or_equal_to>, and C<less_than_or_equal_to>) is
-simply defined in terms of C<compare>, once again demonstrating the pattern of
-defining a number of utility methods in terms of only a single method that the
-target class need implement.
+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) = @_;
+      my ( $self, $other ) = @_;
       $self->compare($other) == 0;
   }
-  
+
   sub greater_than {
-      my ($self, $other) = @_;
+      my ( $self, $other ) = @_;
       $self->compare($other) == 1;
-  }    
-  
+  }
+
   sub less_than {
-      my ($self, $other) = @_;
+      my ( $self, $other ) = @_;
       $self->compare($other) == -1;
   }
-  
+
   sub greater_than_or_equal_to {
-      my ($self, $other) = @_;
+      my ( $self, $other ) = @_;
       $self->greater_than($other) || $self->equal_to($other);
-  }        
-  
+  }
+
   sub less_than_or_equal_to {
-      my ($self, $other) = @_;
+      my ( $self, $other ) = @_;
       $self->less_than($other) || $self->equal_to($other);
   }
 
-Next up is B<Printable>. This is a very simple role, akin to B<Eq>. It merely
-requires a C<to_string> method.
+Finally, we 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 come to B<US::Currency>, a class that allows us to reap the benefits
-of our hard work. This is a regular Moose class, so we include the normal C<use
-Moose>. It consumes both B<Comparable> and B<Printable>, as the following line
-shows:
+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>, with a type constraint of
-C<Num> and a default of C<0>:
+It also defines a regular Moose attribute, C<amount>:
 
-  has 'amount' => (is => 'rw', isa => 'Num', default => 0);
+  has 'amount' => ( is => 'rw', isa => 'Num', default => 0 );
 
-Now we come to the core of the class. First up, we define a C<compare> method:
+Finally we see the implementation of the methods required by our
+roles. We have a C<compare> method:
 
   sub compare {
-      my ($self, $other) = @_;
+      my ( $self, $other ) = @_;
       $self->amount <=> $other->amount;
   }
 
-As you can see, it simply compares the C<amount> attribute of this object with
-the C<amount> attribute of the other object passed to it. With the single
-definition of 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
+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>.
 
-We end the class with a definition of the C<to_string> method, which formats the
-C<amount> attribute for display:
+Then we have our C<to_string> method:
 
   sub to_string {
       my $self = shift;
-      sprintf '$%0.2f USD' => $self->amount
+      sprintf '$%0.2f USD' => $self->amount;
   }
 
 =head1 CONCLUSION
 
-This recipe has shown that roles can be very powerful and immensely useful, and
-save a great deal of repetition.
+Roles can 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
 
@@ -190,23 +185,147 @@ save a great deal of repetition.
 
 =item (1)
 
-At present, method requirements from roles cannot be satisfied by attribute
-accessors. This is a limitation of Moose, and will most likely be rectified in a
-future release.
+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
 
-=head1 AUTHOR
+=head1 AUTHORS
 
 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 
+Dave Rolsky E<lt>autarch@urth.orgE<gt>
+
 =head1 COPYRIGHT AND LICENSE
 
-Copyright 2006-2008 by Infinity Interactive, Inc.
+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       
+=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