X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMoose-OldDocs.git;a=blobdiff_plain;f=lib%2FMoose%2FCookbook%2FRoles%2FRecipe1.pod;h=956b4c9b426accf14f112232c6c115f136b37dd4;hp=2a3d44aead97e6de280fa0d0e9ff2ae323431d09;hb=57e3c69eee6def4e480e55c41a300cf2b47c88f1;hpb=0720d94d9c327042036d9c1b7fcc6f9186ec950d 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