From: Shawn M Moore <sartak@gmail.com>
Date: Tue, 25 Nov 2008 07:06:00 +0000 (+0000)
Subject: with()ing ordinary roles
X-Git-Tag: 0.05~73
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d55c88619b6587f64fb0d0b76d44d3c3b12266d7;p=gitmo%2FMooseX-Role-Parameterized.git

with()ing ordinary roles
---

diff --git a/lib/MooseX/Role/Parameterized.pm b/lib/MooseX/Role/Parameterized.pm
index 24152fe..0ef576e 100644
--- a/lib/MooseX/Role/Parameterized.pm
+++ b/lib/MooseX/Role/Parameterized.pm
@@ -15,7 +15,7 @@ our $CURRENT_METACLASS;
 
 __PACKAGE__->setup_import_methods(
     with_caller => ['parameter', 'role', 'method'],
-    as_is       => ['has', 'extends', 'augment', 'inner'],
+    as_is       => ['has', 'with', 'extends', 'augment', 'inner'],
 );
 
 sub parameter {
@@ -84,6 +84,12 @@ sub method {
     $CURRENT_METACLASS->add_method($name => $method);
 }
 
+sub with {
+    confess "with must be called within the role { ... } block."
+        unless $CURRENT_METACLASS;
+    Moose::Util::apply_all_roles($CURRENT_METACLASS, @_);
+}
+
 sub extends { croak "Roles do not currently support 'extends'" }
 
 sub inner { croak "Roles cannot support 'inner'" }
diff --git a/t/004-with.t b/t/004-with.t
new file mode 100644
index 0000000..9bb650b
--- /dev/null
+++ b/t/004-with.t
@@ -0,0 +1,65 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More tests => 6;
+
+do {
+    package MyItem::Role::Wearable;
+    use Moose::Role;
+
+    has is_worn => (
+        is => 'rw',
+        isa => 'Bool',
+        default => 0,
+    );
+
+    sub equip { shift->is_worn(1) }
+    sub remove { shift->is_worn(0) }
+};
+
+do {
+    package MyItem::Role::Equippable;
+    use MooseX::Role::Parameterized;
+
+    parameter slot => (
+        is       => 'ro',
+        isa      => 'Str',
+        required => 1,
+    );
+
+    role {
+        my $p = shift;
+
+        with 'MyItem::Role::Wearable';
+
+        method slot => sub { $p->slot };
+    };
+};
+
+do {
+    package MyItem::Helmet;
+    use Moose;
+    with 'MyItem::Role::Equippable' => {
+        slot => 'head',
+    };
+};
+
+do {
+    package MyItem::Belt;
+    use Moose;
+    with 'MyItem::Role::Equippable' => {
+        slot => 'waist',
+    };
+};
+
+can_ok('MyItem::Helmet', qw/is_worn equip remove slot/);
+can_ok('MyItem::Belt', qw/is_worn equip remove slot/);
+
+my $visored = MyItem::Helmet->new(is_worn => 1);
+ok($visored->is_worn);
+is($visored->slot, 'head');
+
+my $utility = MyItem::Belt->new;
+ok(!$utility->is_worn);
+is($utility->slot, 'waist');
+