Commit | Line | Data |
01d364b5 |
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 MooseX::Role::Parameterized; |
9 | |
10 | parameter is_worn_default => ( |
11 | is => 'rw', |
12 | isa => 'Bool', |
13 | default => 1, |
14 | ); |
15 | |
16 | role { |
17 | my $p = shift; |
18 | has is_worn => ( |
19 | is => 'rw', |
20 | isa => 'Bool', |
21 | default => $p->is_worn_default, |
22 | ); |
23 | |
24 | method equip => sub { shift->is_worn(1) }; |
25 | method remove => sub { shift->is_worn(0) }; |
26 | }; |
27 | }; |
28 | |
29 | do { |
30 | package MyItem::Role::Equippable; |
31 | use MooseX::Role::Parameterized; |
32 | |
33 | parameter slot => ( |
34 | is => 'ro', |
35 | isa => 'Str', |
36 | required => 1, |
37 | ); |
38 | |
39 | # XXX: UGH! We need some way of making this work I think.. |
40 | parameter is_worn_default => ( |
41 | is => 'rw', |
42 | isa => 'Bool', |
43 | default => 1, |
44 | ); |
45 | |
46 | role { |
47 | my $p = shift; |
48 | |
49 | with 'MyItem::Role::Wearable' => { |
50 | is_worn_default => $p->is_worn_default, |
51 | }; |
52 | |
53 | method slot => sub { $p->slot }; |
54 | }; |
55 | }; |
56 | |
57 | do { |
58 | package MyItem::Helmet; |
59 | use Moose; |
60 | with 'MyItem::Role::Equippable' => { |
61 | slot => 'head', |
62 | is_worn_default => 0, |
63 | }; |
64 | }; |
65 | |
66 | do { |
67 | package MyItem::Belt; |
68 | use Moose; |
69 | with 'MyItem::Role::Equippable' => { |
70 | slot => 'waist', |
71 | is_worn_default => 1, |
72 | }; |
73 | }; |
74 | |
75 | can_ok('MyItem::Helmet', qw/is_worn equip remove slot/); |
76 | can_ok('MyItem::Belt', qw/is_worn equip remove slot/); |
77 | |
78 | my $feathered = MyItem::Helmet->new; |
79 | ok(!$feathered->is_worn, "default for helmet is not worn"); |
80 | is($feathered->slot, 'head'); |
81 | |
82 | my $chastity = MyItem::Belt->new; |
83 | ok($chastity->is_worn, "default for belt is worn"); |
84 | is($chastity->slot, 'waist'); |
85 | |