use warnings;
use metaclass;
-use Sub::Name 'subname';
use Carp 'confess';
-use Scalar::Util 'blessed', 'reftype';
+use Scalar::Util 'blessed';
-our $VERSION = '0.12';
+our $VERSION = '0.56';
our $AUTHORITY = 'cpan:STEVAN';
use Moose::Meta::Class;
get_list => 'get_required_method_list',
existence => 'requires_method',
}
- },
+ },
{
name => 'attribute_map',
attr_reader => 'get_attribute_map',
my $role_name = $self->name;
my $method_metaclass = $self->method_metaclass;
- foreach my $symbol ($self->list_all_package_symbols('CODE')) {
+ my %all_code = $self->get_all_package_symbols('CODE');
- my $code = $self->get_package_symbol('&' . $symbol);
+ foreach my $symbol (keys %all_code) {
+ my $code = $all_code{$symbol};
my ($pkg, $name) = Class::MOP::get_code_info($code);
next unless $self->does_role($role);
}
else {
- next if ($pkg || '') ne $role_name &&
- ($name || '') ne '__ANON__';
+ # NOTE:
+ # in 5.10 constant.pm the constants show up
+ # as being in the right package, but in pre-5.10
+ # they show up as constant::__ANON__ so we
+ # make an exception here to be sure that things
+ # work as expected in both.
+ # - SL
+ unless ($pkg eq 'constant' && $name eq '__ANON__') {
+ next if ($pkg || '') ne $role_name ||
+ (($name || '') ne '__ANON__' && ($pkg || '') ne $role_name);
+ }
}
-
- $map->{$symbol} = $method_metaclass->wrap($code);
+
+ $map->{$symbol} = $method_metaclass->wrap(
+ $code,
+ package_name => $role_name,
+ name => $name
+ );
}
return $map;
sub get_method {
my ($self, $name) = @_;
- $self->get_method_map->{$name}
+ $self->get_method_map->{$name};
}
sub has_method {
|| confess "You must define a method name";
my $body = (blessed($method) ? $method->body : $method);
- ('CODE' eq (reftype($body) || ''))
+ ('CODE' eq ref($body))
|| confess "Your code block must be a CODE reference";
- $self->add_package_symbol("&${method_name}" => $body);
+ $self->add_package_symbol(
+ { sigil => '&', type => 'CODE', name => $method_name },
+ $body
+ );
}
-#sub reset_package_cache_flag { () }
-#sub update_package_cache_flag { () }
-
## ------------------------------------------------------------------
## role construction
## ------------------------------------------------------------------
if ($other->isa('Moose::Meta::Role')) {
require Moose::Meta::Role::Application::ToRole;
- return Moose::Meta::Role::Application::ToRole->new->apply($self, $other, @args);
+ return Moose::Meta::Role::Application::ToRole->new(@args)->apply($self, $other);
}
elsif ($other->isa('Moose::Meta::Class')) {
require Moose::Meta::Role::Application::ToClass;
- return Moose::Meta::Role::Application::ToClass->new->apply($self, $other, @args);
+ return Moose::Meta::Role::Application::ToClass->new(@args)->apply($self, $other);
}
else {
require Moose::Meta::Role::Application::ToInstance;
- return Moose::Meta::Role::Application::ToInstance->new->apply($self, $other, @args);
+ return Moose::Meta::Role::Application::ToInstance->new(@args)->apply($self, $other);
}
}
sub combine {
- my ($class, @roles) = @_;
+ my ($class, @role_specs) = @_;
require Moose::Meta::Role::Application::RoleSummation;
- require Moose::Meta::Role::Composite;
+ require Moose::Meta::Role::Composite;
+
+ my (@roles, %role_params);
+ while (@role_specs) {
+ my ($role, $params) = @{ splice @role_specs, 0, 1 };
+ push @roles => $role->meta;
+ next unless defined $params;
+ $role_params{$role} = $params;
+ }
my $c = Moose::Meta::Role::Composite->new(roles => \@roles);
- Moose::Meta::Role::Application::RoleSummation->new->apply($c);
+ Moose::Meta::Role::Application::RoleSummation->new(
+ role_params => \%role_params
+ )->apply($c);
+
return $c;
}
=head1 COPYRIGHT AND LICENSE
-Copyright 2006, 2007 by Infinity Interactive, Inc.
+Copyright 2006-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>