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