X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FRole%2FParameterized.pm;h=2ec5f1802ad47ea1e77e2bf33d0e64176f3eed6a;hb=aeaaabaf192414bedf70c9144df18cd70b9f6a0a;hp=47377c1f938c95efe3705d0e22558d20f4f576cf;hpb=30788701eeebd921d6a20ce1fe9bb70b5779b3cd;p=gitmo%2FMooseX-Role-Parameterized.git diff --git a/lib/MooseX/Role/Parameterized.pm b/lib/MooseX/Role/Parameterized.pm index 47377c1..2ec5f18 100644 --- a/lib/MooseX/Role/Parameterized.pm +++ b/lib/MooseX/Role/Parameterized.pm @@ -1,40 +1,41 @@ package MooseX::Role::Parameterized; - use Moose ( extends => { -as => 'moose_extends' }, around => { -as => 'moose_around' }, qw/confess blessed/, ); +moose_extends 'Moose::Exporter'; -use Carp 'croak'; use Moose::Role (); -moose_extends 'Moose::Exporter'; use MooseX::Role::Parameterized::Meta::Role::Parameterizable; our $CURRENT_METACLASS; __PACKAGE__->setup_import_methods( - with_caller => ['parameter', 'role', 'method'], - as_is => [ - 'has', 'with', 'extends', 'requires', 'excludes', 'augment', 'inner', - 'before', 'after', 'around', 'super', 'override', 'confess', - 'blessed', - ], + 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) { - Class::MOP::Class->initialize($caller)->add_parameter($name, @_); + $meta->add_parameter($name, @_); } } -sub role { +sub role (&) { my $caller = shift; my $role_generator = shift; Class::MOP::Class->initialize($caller)->role_generator($role_generator); @@ -48,110 +49,100 @@ sub init_meta { ); } -# give role a (&) prototype -moose_around _make_wrapper => sub { - my $orig = shift; - my ($self, $caller, $sub, $fq_name) = @_; - - if ($fq_name =~ /::role$/) { - return sub (&) { $sub->($caller, @_) }; - } - - return $orig->(@_); -}; - sub has { - confess "has must be called within the role { ... } block." - unless $CURRENT_METACLASS; + my $caller = shift; + my $meta = $CURRENT_METACLASS || Class::MOP::Class->initialize($caller); my $names = shift; $names = [$names] if !ref($names); for my $name (@$names) { - $CURRENT_METACLASS->add_attribute($name, @_); + $meta->add_attribute($name, @_); } } sub method { - confess "method must be called within the role { ... } block." - unless $CURRENT_METACLASS; - my $caller = shift; + my $meta = $CURRENT_METACLASS || Class::MOP::Class->initialize($caller); + my $name = shift; my $body = shift; - my $method = $CURRENT_METACLASS->method_metaclass->wrap( + my $method = $meta->method_metaclass->wrap( package_name => $caller, name => $name, body => $body, ); - $CURRENT_METACLASS->add_method($name => $method); + $meta->add_method($name => $method); } sub before { - confess "before must be called within the role { ... } block." - unless $CURRENT_METACLASS; + my $caller = shift; + my $meta = $CURRENT_METACLASS || Class::MOP::Class->initialize($caller); my $code = pop @_; for (@_) { - croak "Roles do not currently support " + Carp::croak "Roles do not currently support " . ref($_) . " references for before method modifiers" if ref $_; - $CURRENT_METACLASS->add_before_method_modifier($_, $code); + $meta->add_before_method_modifier($_, $code); } } sub after { - confess "after must be called within the role { ... } block." - unless $CURRENT_METACLASS; + my $caller = shift; + my $meta = $CURRENT_METACLASS || Class::MOP::Class->initialize($caller); my $code = pop @_; for (@_) { - croak "Roles do not currently support " + Carp::croak "Roles do not currently support " . ref($_) . " references for after method modifiers" if ref $_; - $CURRENT_METACLASS->add_after_method_modifier($_, $code); + $meta->add_after_method_modifier($_, $code); } } sub around { - confess "around must be called within the role { ... } block." - unless $CURRENT_METACLASS; + my $caller = shift; + my $meta = $CURRENT_METACLASS || Class::MOP::Class->initialize($caller); my $code = pop @_; for (@_) { - croak "Roles do not currently support " + Carp::croak "Roles do not currently support " . ref($_) . " references for around method modifiers" if ref $_; - $CURRENT_METACLASS->add_around_method_modifier($_, $code); + $meta->add_around_method_modifier($_, $code); } } sub with { - confess "with must be called within the role { ... } block." - unless $CURRENT_METACLASS; - Moose::Util::apply_all_roles($CURRENT_METACLASS, @_); + my $caller = shift; + my $meta = $CURRENT_METACLASS || Class::MOP::Class->initialize($caller); + + Moose::Util::apply_all_roles($meta, @_); } sub requires { - confess "requires must be called within the role { ... } block." - unless $CURRENT_METACLASS; - croak "Must specify at least one method" unless @_; - $CURRENT_METACLASS->add_required_methods(@_); + 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 { - confess "excludes must be called within the role { ... } block." - unless $CURRENT_METACLASS; - croak "Must specify at least one role" unless @_; - $CURRENT_METACLASS->add_excluded_roles(@_); + 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 @@ -161,18 +152,18 @@ sub super { } sub override { - confess "override must be called within the role { ... } block." - unless $CURRENT_METACLASS; + my $caller = shift; + my $meta = $CURRENT_METACLASS || Class::MOP::Class->initialize($caller); my ($name, $code) = @_; - $CURRENT_METACLASS->add_override_method_modifier($name, $code); + $meta->add_override_method_modifier($name, $code); } -sub extends { croak "Roles do not currently support 'extends'" } +sub extends { Carp::croak "Roles do not currently support 'extends'" } -sub inner { croak "Roles cannot support 'inner'" } +sub inner { Carp::croak "Roles cannot support 'inner'" } -sub augment { croak "Roles cannot support 'augment'" } +sub augment { Carp::croak "Roles cannot support 'augment'" } 1; @@ -188,7 +179,6 @@ MooseX::Role::Parameterized - parameterized roles use MooseX::Role::Parameterized; parameter name => ( - is => 'ro', isa => 'Str', required => 1, ); @@ -227,45 +217,63 @@ L. =head1 DESCRIPTION -Your parameterized role consists of two things: parameter declarations and a -C block. +Your parameterized role consists of two new things: parameter declarations +and a C block. Parameters are declared using the L keyword which very much -resembles L. You can use any option that L accepts. -These parameters will get their values when the consuming class (or role) uses +resembles L. You can use any option that L accepts. The +default value for the C option is C as that's a very common case. These +parameters will get their values when the consuming class (or role) uses L. A parameter object will be constructed with these values, and passed to the C block. The C block then uses the usual L keywords to build up a role. You can shift off the parameter object to inspect what the consuming -class provided as parameters. You can use the parameters to make your role -customizable! +class provided as parameters. You use the parameters to customize your +role however you wish. -There are many paths to parameterized roles (hopefully with a consistent enough -API); I believe this to be the easiest and most flexible implementation. -Coincidentally, Pugs has a very similar design (I'm not yet convinced that that -is a good thing). +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 has an eerily similar design. =head1 CAVEATS You must use this syntax to declare methods in the role block: -C sub { ... };>. This is due to a limitation in Perl. In return -though you can use parameters I! - -You must use all the keywords in the role block. If it turns out to be correct, -we'll compose the parameterizable role (everything outside the role block) with -the parameterized role (everything inside the role block). We throw an error if -you try to use a keyword outside of the role block, so don't worry about it for -now. +C<< method NAME => sub { ... }; >>. This is due to a limitation in Perl. In +return though you can use parameters I! L and L are not yet supported. I'm completely unsure of whether they should be handled by this module. Until we -figure out a plan, both declaring and providing a parameter named C or +figure out a plan, either declaring or providing a parameter named C or C is an error. =head1 AUTHOR Shawn M Moore, C<< >> +=head1 EXAMPLES + +=over 4 + +=item L + +=item L + +=item L + +=item L + +=item L + +=item L + +=item L + +=item L + +=item L + +=back + =cut