t/004-with.t

   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         isa      => 'Str',
  26         required => 1,
  27     );
  28
  29     role {
  30         my $p = shift;
  31
  32         with 'MyItem::Role::Wearable';
  33
  34         method slot => sub { $p->slot };
  35     };
  36 };
  37
  38 do {
  39     package MyItem::Helmet;
  40     use Moose;
  41     with 'MyItem::Role::Equippable' => {
  42         slot => 'head',
  43     };
  44 };
  45
  46 do {
  47     package MyItem::Belt;
  48     use Moose;
  49     with 'MyItem::Role::Equippable' => {
  50         slot => 'waist',
  51     };
  52 };
  53
  54 can_ok('MyItem::Helmet', qw/is_worn equip remove slot/);
  55 can_ok('MyItem::Belt', qw/is_worn equip remove slot/);
  56
  57 my $visored = MyItem::Helmet->new(is_worn => 1);
  58 ok($visored->is_worn);
  59 is($visored->slot, 'head');
  60
  61 my $utility = MyItem::Belt->new;
  62 ok(!$utility->is_worn);
  63 is($utility->slot, 'waist');
  64