X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FRole%2FParameterized.pm;h=13fb7450acb2deecfd9b1002c7f7d6a66e6c78e5;hb=70afb58daccc23d3434ed5699683a4d7e7ccca8d;hp=3f23a53dab43a1e027a64b6e9de3195198b31d48;hpb=bd3dd853b42e6c81f85dccf242f8f87a0897d24f;p=gitmo%2FMooseX-Role-Parameterized.git

diff --git a/lib/MooseX/Role/Parameterized.pm b/lib/MooseX/Role/Parameterized.pm
index 3f23a53..13fb745 100644
--- a/lib/MooseX/Role/Parameterized.pm
+++ b/lib/MooseX/Role/Parameterized.pm
@@ -1,53 +1,294 @@
-#!/usr/bin/env perl
 package MooseX::Role::Parameterized;
-use Moose;
+use Moose (
+    extends => { -as => 'moose_extends' },
+    around  => { -as => 'moose_around' },
+    qw/confess blessed/,
+);
+moose_extends 'Moose::Exporter';
+
 use Moose::Role ();
-extends 'Moose::Exporter';
 
-use MooseX::Role::Parameterized::Meta::Role;
+use MooseX::Role::Parameterized::Meta::Role::Parameterizable;
 
-our $CURRENT_ROLE;
+our $CURRENT_METACLASS;
 
 __PACKAGE__->setup_import_methods(
-    with_caller => ['parameter', 'role'],
+    with_caller => ['parameter', 'role', 'method', 'has', 'with', 'extends',
+                    'requires', 'excludes', 'augment', 'inner', 'before',
+                    'after', 'around', 'super', 'override'],
+    as_is => [ 'confess', 'blessed' ],
 );
 
 sub parameter {
     my $caller = shift;
-    my $names  = shift;
 
+    confess "'parameter' may not be used inside of the role block"
+        if $CURRENT_METACLASS;
+
+    my $meta   = Class::MOP::Class->initialize($caller);
+
+    my $names = shift;
     $names = [$names] if !ref($names);
 
     for my $name (@$names) {
-        $caller->meta->add_parameter($name, @_);
+        $meta->add_parameter($name, @_);
     }
 }
 
-sub role {
+sub role (&) {
     my $caller         = shift;
     my $role_generator = shift;
-    $caller->meta->role_generator($role_generator);
+    Class::MOP::Class->initialize($caller)->role_generator($role_generator);
 }
 
 sub init_meta {
     my $self = shift;
 
     return Moose::Role->init_meta(@_,
-        metaclass => 'MooseX::Role::Parameterized::Meta::Role',
+        metaclass => 'MooseX::Role::Parameterized::Meta::Role::Parameterizable',
     );
 }
 
-# give role a (&) prototype
-around _make_wrapper => sub {
-    my $orig = shift;
-    my ($self, $caller, $sub, $fq_name) = @_;
+sub has {
+    my $caller = shift;
+    my $meta   = $CURRENT_METACLASS || Class::MOP::Class->initialize($caller);
+
+    my $names = shift;
+    $names = [$names] if !ref($names);
 
-    if ($fq_name =~ /::role$/) {
-        return sub (&) { $sub->($caller, @_) };
+    for my $name (@$names) {
+        $meta->add_attribute($name, @_);
     }
+}
+
+sub method {
+    my $caller = shift;
+    my $meta   = $CURRENT_METACLASS || Class::MOP::Class->initialize($caller);
+
+    my $name   = shift;
+    my $body   = shift;
+
+    my $method = $meta->method_metaclass->wrap(
+        package_name => $caller,
+        name         => $name,
+        body         => $body,
+    );
+
+    $meta->add_method($name => $method);
+}
+
+sub before {
+    my $caller = shift;
+    my $meta   = $CURRENT_METACLASS || Class::MOP::Class->initialize($caller);
+
+    my $code = pop @_;
+
+    for (@_) {
+        Carp::croak "Roles do not currently support "
+            . ref($_)
+            . " references for before method modifiers"
+            if ref $_;
+        $meta->add_before_method_modifier($_, $code);
+    }
+}
+
+sub after {
+    my $caller = shift;
+    my $meta   = $CURRENT_METACLASS || Class::MOP::Class->initialize($caller);
+
+    my $code = pop @_;
 
-    return $orig->(@_);
-};
+    for (@_) {
+        Carp::croak "Roles do not currently support "
+            . ref($_)
+            . " references for after method modifiers"
+            if ref $_;
+        $meta->add_after_method_modifier($_, $code);
+    }
+}
+
+sub around {
+    my $caller = shift;
+    my $meta   = $CURRENT_METACLASS || Class::MOP::Class->initialize($caller);
+
+    my $code = pop @_;
+
+    for (@_) {
+        Carp::croak "Roles do not currently support "
+            . ref($_)
+            . " references for around method modifiers"
+            if ref $_;
+        $meta->add_around_method_modifier($_, $code);
+    }
+}
+
+sub with {
+    my $caller = shift;
+    my $meta   = $CURRENT_METACLASS || Class::MOP::Class->initialize($caller);
+
+    Moose::Util::apply_all_roles($meta, @_);
+}
+
+sub requires {
+    my $caller = shift;
+    my $meta   = $CURRENT_METACLASS || Class::MOP::Class->initialize($caller);
+
+    Carp::croak "Must specify at least one method" unless @_;
+    $meta->add_required_methods(@_);
+}
+
+sub excludes {
+    my $caller = shift;
+    my $meta   = $CURRENT_METACLASS || Class::MOP::Class->initialize($caller);
+
+    Carp::croak "Must specify at least one role" unless @_;
+    $meta->add_excluded_roles(@_);
+}
+
+# see Moose.pm for discussion
+sub super {
+    return unless $Moose::SUPER_BODY;
+    $Moose::SUPER_BODY->(@Moose::SUPER_ARGS);
+}
+
+sub override {
+    my $caller = shift;
+    my $meta   = $CURRENT_METACLASS || Class::MOP::Class->initialize($caller);
+
+    my ($name, $code) = @_;
+    $meta->add_override_method_modifier($name, $code);
+}
+
+sub extends { Carp::croak "Roles do not currently support 'extends'" }
+
+sub inner { Carp::croak "Roles cannot support 'inner'" }
+
+sub augment { Carp::croak "Roles cannot support 'augment'" }
 
 1;
 
+__END__
+
+=head1 NAME
+
+MooseX::Role::Parameterized - parameterized roles
+
+=head1 SYNOPSIS
+
+    package MyRole::Counter;
+    use MooseX::Role::Parameterized;
+
+    parameter name => (
+        isa      => 'Str',
+        required => 1,
+    );
+
+    role {
+        my $p = shift;
+
+        my $name = $p->name;
+
+        has $name => (
+            is      => 'rw',
+            isa     => 'Int',
+            default => 0,
+        );
+
+        method "increment_$name" => sub {
+            my $self = shift;
+            $self->$name($self->$name + 1);
+        };
+
+        method "decrement_$name" => sub {
+            my $self = shift;
+            $self->$name($self->$name - 1);
+        };
+    };
+
+    package MyGame::Tile;
+    use Moose;
+
+    with 'MyRole::Counter' => { name => 'stepped_on' };
+
+=head1 L<MooseX::Role::Parameterized::Tutorial>
+
+B<Stop!> If you're new here, please read
+L<MooseX::Role::Parameterized::Tutorial>.
+
+=head1 DESCRIPTION
+
+Your parameterized role consists of two new things: parameter declarations
+and a C<role> block.
+
+Parameters are declared using the L</parameter> keyword which very much
+resembles L<Moose/has>. You can use any option that L<Moose/has> accepts. The
+default value for the C<is> option is C<ro> as that's a very common case. These
+parameters will get their values when the consuming class (or role) uses
+L<Moose/with>. A parameter object will be constructed with these values, and
+passed to the C<role> block.
+
+The C<role> block then uses the usual L<Moose::Role> keywords to build up a
+role. You can shift off the parameter object to inspect what the consuming
+class provided as parameters. You use the parameters to customize your
+role however you wish.
+
+There are many possible implementations for parameterized roles (hopefully with
+a consistent enough API); I believe this to be the easiest and most flexible
+design. Coincidentally, Pugs originally had an eerily similar design.
+
+=head2 Why a parameters object?
+
+I've been asked several times "Why use a parameter I<object> and not just a
+parameter I<hashref>? That would eliminate the need to explicitly declare your
+parameters."
+
+The benefits of using an object are similar to the benefits of using Moose. You
+get an easy way to specify lazy defaults, type constraint, delegation, and so
+on. You get to use MooseX modules.
+
+You also get the usual introspective and intercessory abilities that come
+standard with the metaobject protocol. Ambitious users should be able to add
+traits to the parameters metaclass to further customize behavior. Please let
+me know if you're doing anything viciously complicated with this extension. :)
+
+=head1 CAVEATS
+
+You must use this syntax to declare methods in the role block:
+C<< method NAME => sub { ... }; >>. This is due to a limitation in Perl. In
+return though you can use parameters I<in your methods>!
+
+L<Moose::Role/alias> and L<Moose::Role/excludes> are not yet supported. I'm
+completely unsure of whether they should be handled by this module. Until we
+figure out a plan, either declaring or providing a parameter named C<alias> or
+C<excludes> is an error.
+
+=head1 AUTHOR
+
+Shawn M Moore, C<< <sartak@bestpractical.com> >>
+
+=head1 EXAMPLES
+
+=over 4
+
+=item L<MooseX::Role::Matcher>
+
+=item L<MooseX::Role::XMLRPC::Client>
+
+=item L<MooseX::RelatedClassRoles>
+
+=item L<WWW::Mechanize::TreeBuilder>
+
+=item L<TAEB::Action::Role::Item>
+
+=item L<KiokuDB::Role::Scan>
+
+=item L<Fey::Role::MakesAliasObjects>
+
+=item L<Fey::Role::HasAliasName>
+
+=item L<Fey::Role::SetOperation>
+
+=back
+
+=cut
+