t/005-with-parameterized.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 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         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