t/000_recipes/moose_cookbook_roles_recipe1.t

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use Test::More 'no_plan';
   5 use Test::Exception;
   6 $| = 1;
   7
   8
   9
  10 # =begin testing SETUP
  11 {
  12
  13   package Eq;
  14   use Mouse::Role;
  15
  16   requires 'equal_to';
  17
  18   sub not_equal_to {
  19       my ( $self, $other ) = @_;
  20       not $self->equal_to($other);
  21   }
  22
  23   package Comparable;
  24   use Mouse::Role;
  25
  26   with 'Eq';
  27
  28   requires 'compare';
  29
  30   sub equal_to {
  31       my ( $self, $other ) = @_;
  32       $self->compare($other) == 0;
  33   }
  34
  35   sub greater_than {
  36       my ( $self, $other ) = @_;
  37       $self->compare($other) == 1;
  38   }
  39
  40   sub less_than {
  41       my ( $self, $other ) = @_;
  42       $self->compare($other) == -1;
  43   }
  44
  45   sub greater_than_or_equal_to {
  46       my ( $self, $other ) = @_;
  47       $self->greater_than($other) || $self->equal_to($other);
  48   }
  49
  50   sub less_than_or_equal_to {
  51       my ( $self, $other ) = @_;
  52       $self->less_than($other) || $self->equal_to($other);
  53   }
  54
  55   package Printable;
  56   use Mouse::Role;
  57
  58   requires 'to_string';
  59
  60   package US::Currency;
  61   use Mouse;
  62
  63   with 'Comparable', 'Printable';
  64
  65   has 'amount' => ( is => 'rw', isa => 'Num', default => 0 );
  66
  67   sub compare {
  68       my ( $self, $other ) = @_;
  69       $self->amount <=> $other->amount;
  70   }
  71
  72   sub to_string {
  73       my $self = shift;
  74       sprintf '$%0.2f USD' => $self->amount;
  75   }
  76 }
  77
  78
  79
  80 # =begin testing
  81 {
  82 ok( US::Currency->does('Comparable'), '... US::Currency does Comparable' );
  83 ok( US::Currency->does('Eq'),         '... US::Currency does Eq' );
  84 ok( US::Currency->does('Printable'),  '... US::Currency does Printable' );
  85
  86 my $hundred = US::Currency->new( amount => 100.00 );
  87 isa_ok( $hundred, 'US::Currency' );
  88 {
  89 local $TODO = 'UNIVERSAL::DOES is not supported';
  90 ok( $hundred->DOES("US::Currency"), "UNIVERSAL::DOES for class" );
  91 ok( $hundred->DOES("Comparable"),   "UNIVERSAL::DOES for role" );
  92 }
  93 can_ok( $hundred, 'amount' );
  94 is( $hundred->amount, 100, '... got the right amount' );
  95
  96 can_ok( $hundred, 'to_string' );
  97 is( $hundred->to_string, '$100.00 USD',
  98     '... got the right stringified value' );
  99
 100 ok( $hundred->does('Comparable'), '... US::Currency does Comparable' );
 101 ok( $hundred->does('Eq'),         '... US::Currency does Eq' );
 102 ok( $hundred->does('Printable'),  '... US::Currency does Printable' );
 103
 104 my $fifty = US::Currency->new( amount => 50.00 );
 105 isa_ok( $fifty, 'US::Currency' );
 106
 107 can_ok( $fifty, 'amount' );
 108 is( $fifty->amount, 50, '... got the right amount' );
 109
 110 can_ok( $fifty, 'to_string' );
 111 is( $fifty->to_string, '$50.00 USD', '... got the right stringified value' );
 112
 113 ok( $hundred->greater_than($fifty),             '... 100 gt 50' );
 114 ok( $hundred->greater_than_or_equal_to($fifty), '... 100 ge 50' );
 115 ok( !$hundred->less_than($fifty),               '... !100 lt 50' );
 116 ok( !$hundred->less_than_or_equal_to($fifty),   '... !100 le 50' );
 117 ok( !$hundred->equal_to($fifty),                '... !100 eq 50' );
 118 ok( $hundred->not_equal_to($fifty),             '... 100 ne 50' );
 119
 120 ok( !$fifty->greater_than($hundred),             '... !50 gt 100' );
 121 ok( !$fifty->greater_than_or_equal_to($hundred), '... !50 ge 100' );
 122 ok( $fifty->less_than($hundred),                 '... 50 lt 100' );
 123 ok( $fifty->less_than_or_equal_to($hundred),     '... 50 le 100' );
 124 ok( !$fifty->equal_to($hundred),                 '... !50 eq 100' );
 125 ok( $fifty->not_equal_to($hundred),              '... 50 ne 100' );
 126
 127 ok( !$fifty->greater_than($fifty),            '... !50 gt 50' );
 128 ok( $fifty->greater_than_or_equal_to($fifty), '... !50 ge 50' );
 129 ok( !$fifty->less_than($fifty),               '... 50 lt 50' );
 130 ok( $fifty->less_than_or_equal_to($fifty),    '... 50 le 50' );
 131 ok( $fifty->equal_to($fifty),                 '... 50 eq 50' );
 132 ok( !$fifty->not_equal_to($fifty),            '... !50 ne 50' );
 133
 134 ## ... check some meta-stuff
 135
 136 # Eq
 137
 138 my $eq_meta = Eq->meta;
 139 isa_ok( $eq_meta, 'Mouse::Meta::Role' );
 140
 141 ok( $eq_meta->has_method('not_equal_to'), '... Eq has_method not_equal_to' );
 142 ok( $eq_meta->requires_method('equal_to'),
 143     '... Eq requires_method not_equal_to' );
 144
 145 # Comparable
 146
 147 my $comparable_meta = Comparable->meta;
 148 isa_ok( $comparable_meta, 'Mouse::Meta::Role' );
 149
 150 ok( $comparable_meta->does_role('Eq'), '... Comparable does Eq' );
 151
 152 foreach my $method_name (
 153     qw(
 154     equal_to not_equal_to
 155     greater_than greater_than_or_equal_to
 156     less_than less_than_or_equal_to
 157     )
 158     ) {
 159     ok( $comparable_meta->has_method($method_name),
 160         '... Comparable has_method ' . $method_name );
 161 }
 162
 163 ok( $comparable_meta->requires_method('compare'),
 164     '... Comparable requires_method compare' );
 165
 166 # Printable
 167
 168 my $printable_meta = Printable->meta;
 169 isa_ok( $printable_meta, 'Mouse::Meta::Role' );
 170
 171 ok( $printable_meta->requires_method('to_string'),
 172     '... Printable requires_method to_string' );
 173
 174 # US::Currency
 175
 176 my $currency_meta = US::Currency->meta;
 177 isa_ok( $currency_meta, 'Mouse::Meta::Class' );
 178
 179 ok( $currency_meta->does_role('Comparable'),
 180     '... US::Currency does Comparable' );
 181 ok( $currency_meta->does_role('Eq'), '... US::Currency does Eq' );
 182 ok( $currency_meta->does_role('Printable'),
 183     '... US::Currency does Printable' );
 184
 185 foreach my $method_name (
 186     qw(
 187     amount
 188     equal_to not_equal_to
 189     compare
 190     greater_than greater_than_or_equal_to
 191     less_than less_than_or_equal_to
 192     to_string
 193     )
 194     ) {
 195     ok( $currency_meta->has_method($method_name),
 196         '... US::Currency has_method ' . $method_name );
 197 }
 198 }
 199
 200
 201
 202
 203 1;