use Carp 'confess';
use Sub::Name 'subname';
-our $VERSION = '0.02';
+use Sub::Exporter;
+
+our $VERSION = '0.03';
use Moose::Meta::Role;
-sub import {
- shift;
- my $pkg = caller();
-
- # we should never export to main
- return if $pkg eq 'main';
-
- Moose::Util::TypeConstraints->import($pkg);
-
- my $meta;
- if ($pkg->can('meta')) {
- $meta = $pkg->meta();
- (blessed($meta) && $meta->isa('Moose::Meta::Role'))
- || confess "Whoops, not møøsey enough";
- }
- else {
- $meta = Moose::Meta::Role->new(role_name => $pkg);
- $meta->_role_meta->add_method('meta' => sub { $meta })
- }
-
- # NOTE:
- # &alias_method will install the method, but it
- # will not name it with
-
- # handle superclasses
- $meta->alias_method('extends' => subname 'Moose::Role::extends' => sub {
- confess "Moose::Role does not currently support 'extends'"
- });
-
- # handle roles
- $meta->alias_method('with' => subname 'Moose::with' => sub {
- my ($role) = @_;
- Moose::_load_all_classes($role);
- $role->meta->apply($meta);
- });
-
- # handle attributes
- $meta->alias_method('has' => subname 'Moose::Role::has' => sub {
- my ($name, %options) = @_;
- $meta->add_attribute($name, %options)
- });
-
- # handle method modifers
- $meta->alias_method('before' => subname 'Moose::Role::before' => sub {
- my $code = pop @_;
- $meta->add_before_method_modifier($_, $code) for @_;
- });
- $meta->alias_method('after' => subname 'Moose::Role::after' => sub {
- my $code = pop @_;
- $meta->add_after_method_modifier($_, $code) for @_;
- });
- $meta->alias_method('around' => subname 'Moose::Role::around' => sub {
- my $code = pop @_;
- $meta->add_around_method_modifier($_, $code) for @_;
- });
-
- $meta->alias_method('super' => subname 'Moose::Role::super' => sub {});
- $meta->alias_method('override' => subname 'Moose::Role::override' => sub {
- my ($name, $code) = @_;
- $meta->add_override_method_modifier($name, $code);
- });
+{
+ my ( $CALLER, %METAS );
+
+ sub _find_meta {
+ my $class = $CALLER;
+
+ return $METAS{$class} if exists $METAS{$class};
+
+ my $meta;
+ if ($class->can('meta')) {
+ $meta = $class->meta();
+ (blessed($meta) && $meta->isa('Moose::Meta::Role'))
+ || confess "Whoops, not møøsey enough";
+ }
+ else {
+ $meta = Moose::Meta::Role->new(role_name => $class);
+ $meta->_role_meta->add_method('meta' => sub { $meta })
+ }
+
+ return $METAS{$class} = $meta;
+ }
+
- $meta->alias_method('inner' => subname 'Moose::Role::inner' => sub {
- confess "Moose::Role does not currently support 'inner'";
- });
- $meta->alias_method('augment' => subname 'Moose::Role::augment' => sub {
- confess "Moose::Role does not currently support 'augment'";
- });
-
- # we recommend using these things
- # so export them for them
- $meta->alias_method('confess' => \&Carp::confess);
- $meta->alias_method('blessed' => \&Scalar::Util::blessed);
+ my %exports = (
+ extends => sub {
+ my $meta = _find_meta();
+ return subname 'Moose::Role::extends' => sub {
+ confess "Moose::Role does not currently support 'extends'"
+ };
+ },
+ with => sub {
+ my $meta = _find_meta();
+ return subname 'Moose::Role::with' => sub {
+ my ($role) = @_;
+ Moose::_load_all_classes($role);
+ $role->meta->apply($meta);
+ };
+ },
+ requires => sub {
+ my $meta = _find_meta();
+ return subname 'Moose::Role::requires' => sub {
+ $meta->add_required_methods(@_);
+ };
+ },
+ has => sub {
+ my $meta = _find_meta();
+ return subname 'Moose::Role::has' => sub {
+ my ($name, %options) = @_;
+ $meta->add_attribute($name, %options)
+ };
+ },
+ before => sub {
+ my $meta = _find_meta();
+ return subname 'Moose::Role::before' => sub {
+ my $code = pop @_;
+ $meta->add_before_method_modifier($_, $code) for @_;
+ };
+ },
+ after => sub {
+ my $meta = _find_meta();
+ return subname 'Moose::Role::after' => sub {
+ my $code = pop @_;
+ $meta->add_after_method_modifier($_, $code) for @_;
+ };
+ },
+ around => sub {
+ my $meta = _find_meta();
+ return subname 'Moose::Role::around' => sub {
+ my $code = pop @_;
+ $meta->add_around_method_modifier($_, $code) for @_;
+ };
+ },
+ super => sub {
+ my $meta = _find_meta();
+ return subname 'Moose::Role::super' => sub {};
+ },
+ override => sub {
+ my $meta = _find_meta();
+ return subname 'Moose::Role::override' => sub {
+ my ($name, $code) = @_;
+ $meta->add_override_method_modifier($name, $code);
+ };
+ },
+ inner => sub {
+ my $meta = _find_meta();
+ return subname 'Moose::Role::inner' => sub {
+ confess "Moose::Role does not currently support 'inner'";
+ };
+ },
+ augment => sub {
+ my $meta = _find_meta();
+ return subname 'Moose::Role::augment' => sub {
+ confess "Moose::Role does not currently support 'augment'";
+ };
+ },
+ confess => sub {
+ return \&Carp::confess;
+ },
+ blessed => sub {
+ return \&Scalar::Util::blessed;
+ }
+ );
+
+ my $exporter = Sub::Exporter::build_exporter({
+ exports => \%exports,
+ groups => {
+ default => [':all']
+ }
+ });
+
+ sub import {
+ $CALLER = caller();
+
+ # we should never export to main
+ return if $CALLER eq 'main';
+
+ goto $exporter;
+ };
+
}
1;
use warnings;
use Moose::Role;
- sub equal { confess "equal must be implemented" }
+ requires 'equal';
sub no_equal {
my ($self, $other) = @_;
=head1 DESCRIPTION
This is currently a very early release of Perl 6 style Roles for
-Moose, it should be considered experimental and incomplete.
-
-This feature is being actively developed, but $work is currently
-preventing me from paying as much attention to it as I would like.
-So I am releasing it in hopes people will help me on this I<hint hint>.
-
-If you are interested in helping, please come to #moose on irc.perl.org
-and we can talk.
+Moose, it is still incomplete, but getting much closer. If you are
+interested in helping move this feature along, please come to
+#moose on irc.perl.org and we can talk.
=head1 CAVEATS
-Currently, the role support has a number of caveats. They are as follows:
+Currently, the role support has a few of caveats. They are as follows:
=over 4
=item *
-There is no support for Roles consuming other Roles. The details of this
-are not totally worked out yet, but it will mostly follow what is set out
-in the Perl 6 Synopsis 12.
-
-=item *
-
-At this time classes I<can> consume more than one Role, but they are simply
-applied one after another in the order you ask for them. This is incorrect
-behavior, the roles should be merged first, and conflicts determined, etc.
-However, if your roles do not have any conflicts, then things will work just
-fine.
-
-=item *
-
-I want to have B<required> methods, which is unlike Perl 6 roles, and more
-like the original Traits on which roles are based. This would be similar
-in behavior to L<Class::Trait>. These are not yet implemented or course.
+At this time classes I<cannot> correctly consume more than one role. The
+role composition process, and it's conflict detection has not been added
+yet. While this should be considered a major feature, it can easily be
+worked around, and in many cases, is not needed at all.
+
+A class can actually consume multiple roles, they are just applied one
+after another in the order you ask for them. This is incorrect behavior,
+the roles should be merged first, and conflicts determined, etc. However,
+if your roles do not have any conflicts, then things will work just
+fine. This actually tends to be quite sufficient for basic roles.
=item *
=back
-Basically thats all I can think of for now, I am sure there are more though.
-
=head1 BUGS
All complex software has bugs lurking in it, and this module is no
projects / gitmo/Moose.git / blobdiff