t/000_recipes/006_recipe.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 62;
   7 use Test::Exception;
   8
   9 BEGIN {
  10     use_ok('Moose');
  11 }
  12
  13 ## Roles
  14
  15 {
  16     package Eq;
  17     use Moose::Role;
  18
  19     requires 'equal_to';
  20
  21     sub not_equal_to {
  22         my ($self, $other) = @_;
  23         not $self->equal_to($other);
  24     }
  25
  26     package Comparable;
  27     use Moose::Role;
  28
  29     with 'Eq';
  30
  31     requires 'compare';
  32
  33     sub equal_to {
  34         my ($self, $other) = @_;
  35         $self->compare($other) == 0;
  36     }
  37
  38     sub greater_than {
  39         my ($self, $other) = @_;
  40         $self->compare($other) == 1;
  41     }
  42
  43     sub less_than {
  44         my ($self, $other) = @_;
  45         $self->compare($other) == -1;
  46     }
  47
  48     sub greater_than_or_equal_to {
  49         my ($self, $other) = @_;
  50         $self->greater_than($other) || $self->equal_to($other);
  51     }
  52
  53     sub less_than_or_equal_to {
  54         my ($self, $other) = @_;
  55         $self->less_than($other) || $self->equal_to($other);
  56     }
  57
  58     package Printable;
  59     use Moose::Role;
  60
  61     requires 'to_string';
  62 }
  63
  64 ## Classes
  65
  66 {
  67     package US::Currency;
  68     use Moose;
  69
  70     with 'Comparable', 'Printable';
  71
  72     has 'amount' => (is => 'rw', isa => 'Num', default => 0);
  73
  74     sub compare {
  75         my ($self, $other) = @_;
  76         $self->amount <=> $other->amount;
  77     }
  78
  79     sub to_string {
  80         my $self = shift;
  81         sprintf '$%0.2f USD' => $self->amount
  82     }
  83
  84     metaclass->make_immutable(debug => 0);
  85 }
  86
  87 ok(US::Currency->does('Comparable'), '... US::Currency does Comparable');
  88 ok(US::Currency->does('Eq'), '... US::Currency does Eq');
  89 ok(US::Currency->does('Printable'), '... US::Currency does Printable');
  90
  91 my $hundred = US::Currency->new(amount => 100.00);
  92 isa_ok($hundred, 'US::Currency');
  93
  94 can_ok($hundred, 'amount');
  95 is($hundred->amount, 100, '... got the right amount');
  96
  97 can_ok($hundred, 'to_string');
  98 is($hundred->to_string, '$100.00 USD', '... 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, 'Moose::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'), '... Eq requires_method not_equal_to');
 143
 144 # Comparable
 145
 146 my $comparable_meta = Comparable->meta;
 147 isa_ok($comparable_meta, 'Moose::Meta::Role');
 148
 149 ok($comparable_meta->does_role('Eq'), '... Comparable does Eq');
 150
 151 foreach my $method_name (qw(
 152                         equal_to not_equal_to
 153                         greater_than greater_than_or_equal_to
 154                         less_than less_than_or_equal_to
 155                         )) {
 156     ok($comparable_meta->has_method($method_name), '... Comparable has_method ' . $method_name);
 157 }
 158
 159 ok($comparable_meta->requires_method('compare'), '... Comparable requires_method compare');
 160
 161 # Printable
 162
 163 my $printable_meta = Printable->meta;
 164 isa_ok($printable_meta, 'Moose::Meta::Role');
 165
 166 ok($printable_meta->requires_method('to_string'), '... Printable requires_method to_string');
 167
 168 # US::Currency
 169
 170 my $currency_meta = US::Currency->meta;
 171 isa_ok($currency_meta, 'Moose::Meta::Class');
 172
 173 ok($currency_meta->does_role('Comparable'), '... US::Currency does Comparable');
 174 ok($currency_meta->does_role('Eq'), '... US::Currency does Eq');
 175 ok($currency_meta->does_role('Printable'), '... US::Currency does Printable');
 176
 177 foreach my $method_name (qw(
 178                         amount
 179                         equal_to not_equal_to
 180                         compare
 181                         greater_than greater_than_or_equal_to
 182                         less_than less_than_or_equal_to
 183                         to_string
 184                         )) {
 185     ok($currency_meta->has_method($method_name), '... US::Currency has_method ' . $method_name);
 186 }
 187