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         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