Commit | Line | Data |
d55c8861 |
1 | #!/usr/bin/env perl |
2 | use strict; |
3 | use warnings; |
4 | use Test::More tests => 6; |
5 | |
6 | do { |
7 | package MyItem::Role::Wearable; |
8 | use Moose::Role; |
9 | |
10 | has is_worn => ( |
11 | is => 'rw', |
12 | isa => 'Bool', |
13 | default => 0, |
14 | ); |
15 | |
16 | sub equip { shift->is_worn(1) } |
17 | sub remove { shift->is_worn(0) } |
18 | }; |
19 | |
20 | do { |
21 | package MyItem::Role::Equippable; |
22 | use MooseX::Role::Parameterized; |
23 | |
24 | parameter slot => ( |
25 | is => 'ro', |
26 | isa => 'Str', |
27 | required => 1, |
28 | ); |
29 | |
30 | role { |
31 | my $p = shift; |
32 | |
33 | with 'MyItem::Role::Wearable'; |
34 | |
35 | method slot => sub { $p->slot }; |
36 | }; |
37 | }; |
38 | |
39 | do { |
40 | package MyItem::Helmet; |
41 | use Moose; |
42 | with 'MyItem::Role::Equippable' => { |
43 | slot => 'head', |
44 | }; |
45 | }; |
46 | |
47 | do { |
48 | package MyItem::Belt; |
49 | use Moose; |
50 | with 'MyItem::Role::Equippable' => { |
51 | slot => 'waist', |
52 | }; |
53 | }; |
54 | |
55 | can_ok('MyItem::Helmet', qw/is_worn equip remove slot/); |
56 | can_ok('MyItem::Belt', qw/is_worn equip remove slot/); |
57 | |
58 | my $visored = MyItem::Helmet->new(is_worn => 1); |
59 | ok($visored->is_worn); |
60 | is($visored->slot, 'head'); |
61 | |
62 | my $utility = MyItem::Belt->new; |
63 | ok(!$utility->is_worn); |
64 | is($utility->slot, 'waist'); |
65 | |