From: Shawn M Moore <sartak@gmail.com>
Date: Sun, 9 Nov 2008 04:01:23 +0000 (+0000)
Subject: role sugar, which sets role_generator
X-Git-Tag: 0.05~105
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5b82ffb12a356dc3cb440b0feac3202215870bfc;p=gitmo%2FMooseX-Role-Parameterized.git

role sugar, which sets role_generator
---

diff --git a/lib/MooseX/Role/Parameterized.pm b/lib/MooseX/Role/Parameterized.pm
index 2bc271f..d2e40ad 100644
--- a/lib/MooseX/Role/Parameterized.pm
+++ b/lib/MooseX/Role/Parameterized.pm
@@ -1,14 +1,13 @@
 #!/usr/bin/env perl
 package MooseX::Role::Parameterized;
-use strict;
-use warnings;
-use MooseX::Role::Parameterized::Meta::Role;
-
+use Moose;
 use Moose::Role ();
-use Moose::Exporter;
+extends 'Moose::Exporter';
 
-Moose::Exporter->setup_import_methods(
-    with_caller => ['parameter'],
+use MooseX::Role::Parameterized::Meta::Role;
+
+__PACKAGE__->setup_import_methods(
+    with_caller => ['parameter', 'role'],
 );
 
 sub parameter {
@@ -16,6 +15,12 @@ sub parameter {
     $caller->meta->add_parameter(@_);
 }
 
+sub role {
+    my $caller         = shift;
+    my $role_generator = shift;
+    $caller->meta->role_generator($role_generator);
+}
+
 sub init_meta {
     my $self = shift;
 
@@ -24,5 +29,17 @@ sub init_meta {
     );
 }
 
+# give role a (&) prototype
+around _make_wrapper => sub {
+    my $orig = shift;
+    my ($self, $caller, $sub, $fq_name) = @_;
+
+    if ($fq_name =~ /::role$/) {
+        return sub (&) { $sub->($caller, @_) };
+    }
+
+    return $orig->(@_);
+};
+
 1;
 
diff --git a/lib/MooseX/Role/Parameterized/Meta/Role.pm b/lib/MooseX/Role/Parameterized/Meta/Role.pm
index 742cfbf..522c6ab 100644
--- a/lib/MooseX/Role/Parameterized/Meta/Role.pm
+++ b/lib/MooseX/Role/Parameterized/Meta/Role.pm
@@ -16,6 +16,12 @@ has parameter_metaclass => (
     },
 );
 
+has role_generator => (
+    is        => 'rw',
+    isa       => 'CodeRef',
+    predicate => 'has_role_generator',
+);
+
 sub add_parameter {
     my $self = shift;
     $self->parameter_metaclass->add_attribute(@_);