diff options
Diffstat (limited to 'lib/Moose/Meta/Role')
| -rw-r--r-- | lib/Moose/Meta/Role/Application.pm | 225 | ||||
| -rw-r--r-- | lib/Moose/Meta/Role/Application/RoleSummation.pm | 440 | ||||
| -rw-r--r-- | lib/Moose/Meta/Role/Application/ToClass.pm | 314 | ||||
| -rw-r--r-- | lib/Moose/Meta/Role/Application/ToInstance.pm | 141 | ||||
| -rw-r--r-- | lib/Moose/Meta/Role/Application/ToRole.pm | 283 | ||||
| -rw-r--r-- | lib/Moose/Meta/Role/Attribute.pm | 263 | ||||
| -rw-r--r-- | lib/Moose/Meta/Role/Composite.pm | 324 | ||||
| -rw-r--r-- | lib/Moose/Meta/Role/Method.pm | 101 | ||||
| -rw-r--r-- | lib/Moose/Meta/Role/Method/Conflicting.pm | 139 | ||||
| -rw-r--r-- | lib/Moose/Meta/Role/Method/Required.pm | 129 |
10 files changed, 2359 insertions, 0 deletions
diff --git a/lib/Moose/Meta/Role/Application.pm b/lib/Moose/Meta/Role/Application.pm new file mode 100644 index 0000000..58a123e --- /dev/null +++ b/lib/Moose/Meta/Role/Application.pm @@ -0,0 +1,225 @@ +package Moose::Meta::Role::Application; +our $VERSION = '2.1405'; + +use strict; +use warnings; +use metaclass; +use overload (); + +use List::Util 1.33 qw( all ); + +use Moose::Util 'throw_exception'; + +__PACKAGE__->meta->add_attribute('method_exclusions' => ( + init_arg => '-excludes', + reader => 'get_method_exclusions', + default => sub { [] }, + Class::MOP::_definition_context(), +)); + +__PACKAGE__->meta->add_attribute('method_aliases' => ( + init_arg => '-alias', + reader => 'get_method_aliases', + default => sub { {} }, + Class::MOP::_definition_context(), +)); + +sub new { + my ($class, %params) = @_; + $class->_new(\%params); +} + +sub is_method_excluded { + my ($self, $method_name) = @_; + foreach (@{$self->get_method_exclusions}) { + return 1 if $_ eq $method_name; + } + return 0; +} + +sub is_method_aliased { + my ($self, $method_name) = @_; + exists $self->get_method_aliases->{$method_name} ? 1 : 0 +} + +sub is_aliased_method { + my ($self, $method_name) = @_; + my %aliased_names = reverse %{$self->get_method_aliases}; + exists $aliased_names{$method_name} ? 1 : 0; +} + +sub apply { + my $self = shift; + + $self->check_role_exclusions(@_); + $self->check_required_methods(@_); + $self->check_required_attributes(@_); + + $self->apply_overloading(@_); + $self->apply_attributes(@_); + $self->apply_methods(@_); + + $self->apply_override_method_modifiers(@_); + + $self->apply_before_method_modifiers(@_); + $self->apply_around_method_modifiers(@_); + $self->apply_after_method_modifiers(@_); +} + +sub check_role_exclusions { throw_exception( "CannotCallAnAbstractMethod" ); } +sub check_required_methods { throw_exception( "CannotCallAnAbstractMethod" ); } +sub check_required_attributes { throw_exception( "CannotCallAnAbstractMethod" ); } + +sub apply_attributes { throw_exception( "CannotCallAnAbstractMethod" ); } +sub apply_methods { throw_exception( "CannotCallAnAbstractMethod" ); } +sub apply_override_method_modifiers { throw_exception( "CannotCallAnAbstractMethod" ); } +sub apply_method_modifiers { throw_exception( "CannotCallAnAbstractMethod" ); } + +sub apply_before_method_modifiers { (shift)->apply_method_modifiers('before' => @_) } +sub apply_around_method_modifiers { (shift)->apply_method_modifiers('around' => @_) } +sub apply_after_method_modifiers { (shift)->apply_method_modifiers('after' => @_) } + +sub apply_overloading { + my ( $self, $role, $other ) = @_; + + return unless $role->is_overloaded; + + unless ( $other->is_overloaded ) { + $other->set_overload_fallback_value( + $role->get_overload_fallback_value ); + } + + for my $overload ( $role->get_all_overloaded_operators ) { + next if $other->has_overloaded_operator( $overload->operator ); + $other->add_overloaded_operator( + $overload->operator => $overload->clone ); + } +} + +1; + +# ABSTRACT: A base class for role application + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Moose::Meta::Role::Application - A base class for role application + +=head1 VERSION + +version 2.1405 + +=head1 DESCRIPTION + +This is the abstract base class for role applications. + +The API for this class and its subclasses still needs some +consideration, and is intentionally not yet documented. + +=head2 METHODS + +=over 4 + +=item B<new> + +=item B<meta> + +=item B<get_method_exclusions> + +=item B<is_method_excluded> + +=item B<get_method_aliases> + +=item B<is_aliased_method> + +=item B<is_method_aliased> + +=item B<apply> + +=item B<check_role_exclusions> + +=item B<check_required_methods> + +=item B<check_required_attributes> + +=item B<apply_attributes> + +=item B<apply_methods> + +=item B<apply_overloading> + +=item B<apply_method_modifiers> + +=item B<apply_before_method_modifiers> + +=item B<apply_after_method_modifiers> + +=item B<apply_around_method_modifiers> + +=item B<apply_override_method_modifiers> + +=back + +=head1 BUGS + +See L<Moose/BUGS> for details on reporting bugs. + +=head1 AUTHORS + +=over 4 + +=item * + +Stevan Little <stevan.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=back + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2006 by Infinity Interactive, Inc.. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Moose/Meta/Role/Application/RoleSummation.pm b/lib/Moose/Meta/Role/Application/RoleSummation.pm new file mode 100644 index 0000000..1276b66 --- /dev/null +++ b/lib/Moose/Meta/Role/Application/RoleSummation.pm @@ -0,0 +1,440 @@ +package Moose::Meta::Role::Application::RoleSummation; +our $VERSION = '2.1405'; + +use strict; +use warnings; +use metaclass; + +use List::Util 1.33 qw( all ); +use Scalar::Util 'blessed'; + +use Moose::Meta::Role::Composite; + +use parent 'Moose::Meta::Role::Application'; + +use Moose::Util 'throw_exception'; + +__PACKAGE__->meta->add_attribute('role_params' => ( + reader => 'role_params', + default => sub { {} }, + Class::MOP::_definition_context(), +)); + +sub get_exclusions_for_role { + my ($self, $role) = @_; + $role = $role->name if blessed $role; + my $excludes_key = exists $self->role_params->{$role}->{'-excludes'} ? + '-excludes' : 'excludes'; + if ($self->role_params->{$role} && defined $self->role_params->{$role}->{$excludes_key}) { + if (ref $self->role_params->{$role}->{$excludes_key} eq 'ARRAY') { + return $self->role_params->{$role}->{$excludes_key}; + } + return [ $self->role_params->{$role}->{$excludes_key} ]; + } + return []; +} + +sub get_method_aliases_for_role { + my ($self, $role) = @_; + $role = $role->name if blessed $role; + my $alias_key = exists $self->role_params->{$role}->{'-alias'} ? + '-alias' : 'alias'; + if ($self->role_params->{$role} && defined $self->role_params->{$role}->{$alias_key}) { + return $self->role_params->{$role}->{$alias_key}; + } + return {}; +} + +sub is_method_excluded { + my ($self, $role, $method_name) = @_; + foreach ($self->get_exclusions_for_role($role->name)) { + return 1 if $_ eq $method_name; + } + return 0; +} + +sub is_method_aliased { + my ($self, $role, $method_name) = @_; + exists $self->get_method_aliases_for_role($role->name)->{$method_name} ? 1 : 0 +} + +sub is_aliased_method { + my ($self, $role, $method_name) = @_; + my %aliased_names = reverse %{$self->get_method_aliases_for_role($role->name)}; + exists $aliased_names{$method_name} ? 1 : 0; +} + +sub check_role_exclusions { + my ($self, $c) = @_; + + my %excluded_roles; + for my $role (@{ $c->get_roles }) { + my $name = $role->name; + + for my $excluded ($role->get_excluded_roles_list) { + push @{ $excluded_roles{$excluded} }, $name; + } + } + + foreach my $role (@{$c->get_roles}) { + foreach my $excluded (keys %excluded_roles) { + next unless $role->does_role($excluded); + + my @excluding = @{ $excluded_roles{$excluded} }; + + throw_exception( RoleExclusionConflict => roles => \@excluding, + role_name => $excluded + ); + } + } + + $c->add_excluded_roles(keys %excluded_roles); +} + +sub check_required_methods { + my ($self, $c) = @_; + + my %all_required_methods = + map { $_->name => $_ } + map { $_->get_required_method_list } + @{$c->get_roles}; + + foreach my $role (@{$c->get_roles}) { + foreach my $required (keys %all_required_methods) { + + delete $all_required_methods{$required} + if $role->has_method($required) + || $self->is_aliased_method($role, $required); + } + } + + $c->add_required_methods(values %all_required_methods); +} + +sub check_required_attributes { + +} + +sub apply_attributes { + my ($self, $c) = @_; + + my @all_attributes; + + for my $role ( @{ $c->get_roles } ) { + push @all_attributes, + map { $role->get_attribute($_) } $role->get_attribute_list; + } + + my %seen; + foreach my $attr (@all_attributes) { + my $name = $attr->name; + + if ( exists $seen{$name} ) { + next if $seen{$name}->is_same_as($attr); + + my $role1 = $seen{$name}->associated_role->name; + my $role2 = $attr->associated_role->name; + + throw_exception( AttributeConflictInSummation => attribute_name => $name, + role_name => $role1, + second_role_name => $role2, + ); + } + + $seen{$name} = $attr; + } + + foreach my $attr (@all_attributes) { + $c->add_attribute( $attr->clone ); + } +} + +sub apply_methods { + my ($self, $c) = @_; + + my @all_methods = map { + my $role = $_; + my $aliases = $self->get_method_aliases_for_role($role); + my %excludes = map { $_ => undef } @{ $self->get_exclusions_for_role($role) }; + ( + (map { + exists $excludes{$_} ? () : + +{ + role => $role, + name => $_, + method => $role->get_method($_), + } + } map { $_->name } + grep { !$_->isa('Class::MOP::Method::Meta') } + $role->_get_local_methods), + (map { + +{ + role => $role, + name => $aliases->{$_}, + method => $role->get_method($_), + } + } keys %$aliases) + ); + } @{$c->get_roles}; + + my (%seen, %conflicts, %method_map); + foreach my $method (@all_methods) { + next if $conflicts{$method->{name}}; + my $seen = $seen{$method->{name}}; + + if ($seen) { + if ($seen->{method}->body != $method->{method}->body) { + $c->add_conflicting_method( + name => $method->{name}, + roles => [$method->{role}->name, $seen->{role}->name], + ); + + delete $method_map{$method->{name}}; + $conflicts{$method->{name}} = 1; + next; + } + } + + $seen{$method->{name}} = $method; + $method_map{$method->{name}} = $method->{method}; + } + + $c->add_method($_ => $method_map{$_}) for keys %method_map; +} + +sub apply_override_method_modifiers { + my ($self, $c) = @_; + + my @all_overrides = map { + my $role = $_; + map { + +{ + name => $_, + method => $role->get_override_method_modifier($_), + } + } $role->get_method_modifier_list('override'); + } @{$c->get_roles}; + + my %seen; + foreach my $override (@all_overrides) { + my @role_names = map { $_->name } @{$c->get_roles}; + if ( $c->has_method($override->{name}) ){ + throw_exception( OverrideConflictInSummation => role_names => \@role_names, + role_application => $self, + method_name => $override->{name} + ); + } + if (exists $seen{$override->{name}}) { + if ( $seen{$override->{name}} != $override->{method} ) { + throw_exception( OverrideConflictInSummation => role_names => \@role_names, + role_application => $self, + method_name => $override->{name}, + two_overrides_found => 1 + ); + } + } + $seen{$override->{name}} = $override->{method}; + } + + $c->add_override_method_modifier( + $_->{name}, $_->{method} + ) for @all_overrides; + +} + +sub apply_method_modifiers { + my ($self, $modifier_type, $c) = @_; + my $add = "add_${modifier_type}_method_modifier"; + my $get = "get_${modifier_type}_method_modifiers"; + foreach my $role (@{$c->get_roles}) { + foreach my $method_name ($role->get_method_modifier_list($modifier_type)) { + $c->$add( + $method_name, + $_ + ) foreach $role->$get($method_name); + } + } +} + +sub apply_overloading { + my ( $self, $c ) = @_; + + my @overloaded_roles = grep { $_->is_overloaded } @{ $c->get_roles }; + return unless @overloaded_roles; + + my %fallback; + for my $role (@overloaded_roles) { + $fallback{ $role->name } = $role->get_overload_fallback_value; + } + + for my $role_name ( keys %fallback ) { + for my $other_role_name ( grep { $_ ne $role_name } keys %fallback ) { + my @fb_values = @fallback{ $role_name, $other_role_name }; + if ( all {defined} @fb_values ) { + next if $fallback{$role_name} eq $fallback{$other_role_name}; + throw_exception( + 'OverloadConflictInSummation', + role_names => [ $role_name, $other_role_name ], + role_application => $self, + overloaded_op => 'fallback', + ); + } + + next if all { !defined } @fb_values; + throw_exception( + 'OverloadConflictInSummation', + role_names => [ $role_name, $other_role_name ], + role_application => $self, + overloaded_op => 'fallback', + ); + } + } + + if ( keys %fallback ) { + $c->set_overload_fallback_value( ( values %fallback )[0] ); + } + + my %overload_map; + for my $role (@overloaded_roles) { + for my $overload ( $role->get_all_overloaded_operators ) { + $overload_map{ $overload->operator }{ $role->name } = $overload; + } + } + + for my $op_name ( keys %overload_map ) { + my @roles = keys %{ $overload_map{$op_name} }; + my $overload = $overload_map{$op_name}{ $roles[0] }; + + if ( @roles > 1 && !all { $overload->_is_equal_to($_) } + values %{ $overload_map{$op_name} } ) { + + throw_exception( + 'OverloadConflictInSummation', + role_names => [ @roles[ 0, 1 ] ], + role_application => $self, + overloaded_op => $op_name, + ); + } + + $c->add_overloaded_operator( + $op_name => $overload_map{$op_name}{ $roles[0] } ); + } +} + +1; + +# ABSTRACT: Combine two or more roles + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Moose::Meta::Role::Application::RoleSummation - Combine two or more roles + +=head1 VERSION + +version 2.1405 + +=head1 DESCRIPTION + +Summation composes two traits, forming the union of non-conflicting +bindings and 'disabling' the conflicting bindings + +=head2 METHODS + +=over 4 + +=item B<new> + +=item B<meta> + +=item B<role_params> + +=item B<get_exclusions_for_role> + +=item B<get_method_aliases_for_role> + +=item B<is_aliased_method> + +=item B<is_method_aliased> + +=item B<is_method_excluded> + +=item B<apply> + +=item B<check_role_exclusions> + +=item B<check_required_methods> + +=item B<check_required_attributes> + +=item B<apply_attributes> + +=item B<apply_methods> + +=item B<apply_overloading> + +=item B<apply_method_modifiers> + +=item B<apply_override_method_modifiers> + +=back + +=head1 AUTHORS + +=over 4 + +=item * + +Stevan Little <stevan.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=back + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2006 by Infinity Interactive, Inc.. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Moose/Meta/Role/Application/ToClass.pm b/lib/Moose/Meta/Role/Application/ToClass.pm new file mode 100644 index 0000000..03eeedd --- /dev/null +++ b/lib/Moose/Meta/Role/Application/ToClass.pm @@ -0,0 +1,314 @@ +package Moose::Meta::Role::Application::ToClass; +our $VERSION = '2.1405'; + +use strict; +use warnings; +use metaclass; + +use List::Util 'first'; +use Moose::Util 'throw_exception'; +use Scalar::Util 'weaken'; + +use parent 'Moose::Meta::Role::Application'; + +__PACKAGE__->meta->add_attribute('role' => ( + reader => 'role', + Class::MOP::_definition_context(), +)); + +__PACKAGE__->meta->add_attribute('class' => ( + accessor => 'class', + Class::MOP::_definition_context(), +)); + +sub apply { + my ($self, $role, $class) = @_; + + # We need weak_ref in CMOP :( + weaken($self->{role} = $role); + weaken($self->{class} = $class); + + $self->SUPER::apply($role, $class); + + $class->add_role($role); + $class->add_role_application($self); +} + +sub check_role_exclusions { + my ($self, $role, $class) = @_; + if ($class->excludes_role($role->name)) { + throw_exception( ConflictDetectedInCheckRoleExclusionsInToClass => class_name => $class->name, + role_name => $role->name, + ); + } + foreach my $excluded_role_name ($role->get_excluded_roles_list) { + if ($class->does_role($excluded_role_name)) { + throw_exception( ClassDoesTheExcludedRole => role_name => $role->name, + excluded_role_name => $excluded_role_name, + class_name => $class->name, + ); + } + } +} + +sub check_required_methods { + my ($self, $role, $class) = @_; + + my @missing; + my @is_attr; + + # NOTE: + # we might need to move this down below the + # the attributes so that we can require any + # attribute accessors. However I am thinking + # that maybe those are somehow exempt from + # the require methods stuff. + foreach my $required_method ($role->get_required_method_list) { + my $required_method_name = $required_method->name; + + if (!$class->find_method_by_name($required_method_name)) { + + next if $self->is_aliased_method($required_method_name); + + push @missing, $required_method; + } + } + + return unless @missing; + + my $error = ''; + + @missing = sort { $a->name cmp $b->name } @missing; + my @conflicts = grep { $_->isa('Moose::Meta::Role::Method::Conflicting') } @missing; + + if (@conflicts) { + my $conflict = $conflicts[0]; + my $roles = $conflict->roles_as_english_list; + + my @same_role_conflicts = grep { $_->roles_as_english_list eq $roles } @conflicts; + + throw_exception( MethodNameConflictInRoles => conflict => \@same_role_conflicts, + class_name => $class->name + ); + } + elsif (@missing) { + if (my $meth = first { $class->name->can($_) } @missing) { + throw_exception( RequiredMethodsImportedByClass => class_name => $class->name, + role_name => $role->name, + missing_methods => \@missing, + imported_method => $meth + ); + } + else { + throw_exception( RequiredMethodsNotImplementedByClass => class_name => $class->name, + role_name => $role->name, + missing_methods => \@missing, + ); + } + } +} + +sub check_required_attributes { + +} + +sub apply_attributes { + my ($self, $role, $class) = @_; + + foreach my $attribute_name ($role->get_attribute_list) { + # it if it has one already + if ($class->has_attribute($attribute_name) && + # make sure we haven't seen this one already too + $class->get_attribute($attribute_name) != $role->get_attribute($attribute_name)) { + next; + } + else { + $class->add_attribute( + $role->get_attribute($attribute_name)->attribute_for_class + ); + } + } +} + +sub apply_methods { + my ( $self, $role, $class ) = @_; + + foreach my $method ( $role->_get_local_methods ) { + my $method_name = $method->name; + + next if $method->isa('Class::MOP::Method::Meta'); + + unless ( $self->is_method_excluded($method_name) ) { + + my $class_method = $class->get_method($method_name); + + next if $class_method && $class_method->body != $method->body; + + $class->add_method( + $method_name, + $method, + ); + } + + next unless $self->is_method_aliased($method_name); + + my $aliased_method_name = $self->get_method_aliases->{$method_name}; + + my $class_method = $class->get_method($aliased_method_name); + + if ( $class_method && $class_method->body != $method->body ) { + throw_exception( CannotCreateMethodAliasLocalMethodIsPresentInClass => aliased_method_name => $aliased_method_name, + method => $method, + role_name => $role->name, + class_name => $class->name, + ); + } + + $class->add_method( + $aliased_method_name, + $method, + ); + } + + # we must reset the cache here since + # we are just aliasing methods, otherwise + # the modifiers go wonky. + $class->reset_package_cache_flag; +} + +sub apply_override_method_modifiers { + my ($self, $role, $class) = @_; + foreach my $method_name ($role->get_method_modifier_list('override')) { + # it if it has one already then ... + if ($class->has_method($method_name)) { + next; + } + else { + # if this is not a role, then we need to + # find the original package of the method + # so that we can tell the class were to + # find the right super() method + my $method = $role->get_override_method_modifier($method_name); + my ($package) = Class::MOP::get_code_info($method); + # if it is a class, we just add it + $class->add_override_method_modifier($method_name, $method, $package); + } + } +} + +sub apply_method_modifiers { + my ($self, $modifier_type, $role, $class) = @_; + my $add = "add_${modifier_type}_method_modifier"; + my $get = "get_${modifier_type}_method_modifiers"; + foreach my $method_name ($role->get_method_modifier_list($modifier_type)) { + $class->$add( + $method_name, + $_ + ) foreach $role->$get($method_name); + } +} + +1; + +# ABSTRACT: Compose a role into a class + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Moose::Meta::Role::Application::ToClass - Compose a role into a class + +=head1 VERSION + +version 2.1405 + +=head1 DESCRIPTION + +=head2 METHODS + +=over 4 + +=item B<new> + +=item B<meta> + +=item B<apply> + +=item B<check_role_exclusions> + +=item B<check_required_methods> + +=item B<check_required_attributes> + +=item B<apply_attributes> + +=item B<apply_methods> + +=item B<apply_method_modifiers> + +=item B<apply_override_method_modifiers> + +=back + +=head1 BUGS + +See L<Moose/BUGS> for details on reporting bugs. + +=head1 AUTHORS + +=over 4 + +=item * + +Stevan Little <stevan.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=back + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2006 by Infinity Interactive, Inc.. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Moose/Meta/Role/Application/ToInstance.pm b/lib/Moose/Meta/Role/Application/ToInstance.pm new file mode 100644 index 0000000..5e82c45 --- /dev/null +++ b/lib/Moose/Meta/Role/Application/ToInstance.pm @@ -0,0 +1,141 @@ +package Moose::Meta::Role::Application::ToInstance; +our $VERSION = '2.1405'; + +use strict; +use warnings; +use metaclass; + +use Scalar::Util 'blessed'; +use List::Util 1.33 'all'; + +use parent 'Moose::Meta::Role::Application'; + +__PACKAGE__->meta->add_attribute('rebless_params' => ( + reader => 'rebless_params', + default => sub { {} }, + Class::MOP::_definition_context(), +)); + +use constant _NEED_OVERLOAD_HACK_FOR_OBJECTS => $] < 5.008009; + +sub apply { + my ( $self, $role, $object, $args ) = @_; + + my $obj_meta = Class::MOP::class_of($object) || 'Moose::Meta::Class'; + + # This is a special case to handle the case where the object's metaclass + # is a Class::MOP::Class, but _not_ a Moose::Meta::Class (for example, + # when applying a role to a Moose::Meta::Attribute object). + $obj_meta = 'Moose::Meta::Class' + unless $obj_meta->isa('Moose::Meta::Class'); + + my $class = $obj_meta->create_anon_class( + superclasses => [ blessed($object) ], + roles => [ $role, keys(%$args) ? ($args) : () ], + cache => (all { $_ eq '-alias' || $_ eq '-excludes' } keys %$args), + ); + + $class->rebless_instance( $object, %{ $self->rebless_params } ); + + if ( _NEED_OVERLOAD_HACK_FOR_OBJECTS + && overload::Overloaded( ref $object ) ) { + + # need to use $_[2] here to apply to the object in the caller + _reset_amagic($_[2]); + } + + return $object; +} + +1; + +# ABSTRACT: Compose a role into an instance + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Moose::Meta::Role::Application::ToInstance - Compose a role into an instance + +=head1 VERSION + +version 2.1405 + +=head1 DESCRIPTION + +=head2 METHODS + +=over 4 + +=item B<new> + +=item B<meta> + +=item B<apply> + +=item B<rebless_params> + +=back + +=head1 BUGS + +See L<Moose/BUGS> for details on reporting bugs. + +=head1 AUTHORS + +=over 4 + +=item * + +Stevan Little <stevan.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=back + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2006 by Infinity Interactive, Inc.. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Moose/Meta/Role/Application/ToRole.pm b/lib/Moose/Meta/Role/Application/ToRole.pm new file mode 100644 index 0000000..0d8af91 --- /dev/null +++ b/lib/Moose/Meta/Role/Application/ToRole.pm @@ -0,0 +1,283 @@ +package Moose::Meta::Role::Application::ToRole; +our $VERSION = '2.1405'; + +use strict; +use warnings; +use metaclass; + +use parent 'Moose::Meta::Role::Application'; + +use Moose::Util 'throw_exception'; + +sub apply { + my ($self, $role1, $role2) = @_; + $self->SUPER::apply($role1, $role2); + $role2->add_role($role1); +} + +sub check_role_exclusions { + my ($self, $role1, $role2) = @_; + if ( $role2->excludes_role($role1->name) ) { + throw_exception( ConflictDetectedInCheckRoleExclusions => role_name => $role2->name, + excluded_role_name => $role1->name, + ); + } + foreach my $excluded_role_name ($role1->get_excluded_roles_list) { + if ( $role2->does_role($excluded_role_name) ) { + throw_exception( RoleDoesTheExcludedRole => role_name => $role2->name, + excluded_role_name => $excluded_role_name, + second_role_name => $role1->name, + ); + } + $role2->add_excluded_roles($excluded_role_name); + } +} + +sub check_required_methods { + my ($self, $role1, $role2) = @_; + foreach my $required_method ($role1->get_required_method_list) { + my $required_method_name = $required_method->name; + + next if $self->is_aliased_method($required_method_name); + + $role2->add_required_methods($required_method) + unless $role2->find_method_by_name($required_method_name); + } +} + +sub check_required_attributes { + +} + +sub apply_attributes { + my ($self, $role1, $role2) = @_; + foreach my $attribute_name ($role1->get_attribute_list) { + # it if it has one already + if ($role2->has_attribute($attribute_name) && + # make sure we haven't seen this one already too + $role2->get_attribute($attribute_name) != $role1->get_attribute($attribute_name)) { + + my $role2_name = $role2->name; + + throw_exception( AttributeConflictInRoles => role_name => $role1->name, + second_role_name => $role2->name, + attribute_name => $attribute_name + ); + } + else { + $role2->add_attribute( + $role1->get_attribute($attribute_name)->clone + ); + } + } +} + +sub apply_methods { + my ( $self, $role1, $role2 ) = @_; + foreach my $method ( $role1->_get_local_methods ) { + + my $method_name = $method->name; + + next if $method->isa('Class::MOP::Method::Meta'); + + unless ( $self->is_method_excluded($method_name) ) { + + my $role2_method = $role2->get_method($method_name); + if ( $role2_method + && $role2_method->body != $method->body ) { + + # method conflicts between roles used to result in the method + # becoming a requirement but now are permitted just like + # for classes, hence no code in this branch anymore. + } + else { + $role2->add_method( + $method_name, + $method, + ); + } + } + + next unless $self->is_method_aliased($method_name); + + my $aliased_method_name = $self->get_method_aliases->{$method_name}; + + my $role2_method = $role2->get_method($aliased_method_name); + + if ( $role2_method + && $role2_method->body != $method->body ) { + + throw_exception( CannotCreateMethodAliasLocalMethodIsPresent => aliased_method_name => $aliased_method_name, + method => $method, + role_name => $role2->name, + role_being_applied_name => $role1->name, + ); + } + + $role2->add_method( + $aliased_method_name, + $role1->get_method($method_name) + ); + + if ( !$role2->has_method($method_name) ) { + $role2->add_required_methods($method_name) + unless $self->is_method_excluded($method_name); + } + } +} + +sub apply_override_method_modifiers { + my ($self, $role1, $role2) = @_; + foreach my $method_name ($role1->get_method_modifier_list('override')) { + # it if it has one already then ... + if ($role2->has_method($method_name)) { + # if it is being composed into another role + # we have a conflict here, because you cannot + # combine an overridden method with a locally + # defined one + throw_exception( OverrideConflictInComposition => role_name => $role2->name, + role_being_applied_name => $role1->name, + method_name => $method_name + ); + } + else { + # if we are a role, we need to make sure + # we don't have a conflict with the role + # we are composing into + if ($role2->has_override_method_modifier($method_name) && + $role1->get_override_method_modifier($method_name) != $role2->get_override_method_modifier($method_name)) { + + throw_exception( OverrideConflictInComposition => role_name => $role2->name, + role_being_applied_name => $role1->name, + method_name => $method_name, + two_overrides_found => 1 + ); + } + else { + # if there is no conflict, + # just add it to the role + $role2->add_override_method_modifier( + $method_name, + $role1->get_override_method_modifier($method_name) + ); + } + } + } +} + +sub apply_method_modifiers { + my ($self, $modifier_type, $role1, $role2) = @_; + my $add = "add_${modifier_type}_method_modifier"; + my $get = "get_${modifier_type}_method_modifiers"; + foreach my $method_name ($role1->get_method_modifier_list($modifier_type)) { + $role2->$add( + $method_name, + $_ + ) foreach $role1->$get($method_name); + } +} + +1; + +# ABSTRACT: Compose a role into another role + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Moose::Meta::Role::Application::ToRole - Compose a role into another role + +=head1 VERSION + +version 2.1405 + +=head1 DESCRIPTION + +=head2 METHODS + +=over 4 + +=item B<new> + +=item B<meta> + +=item B<apply> + +=item B<check_role_exclusions> + +=item B<check_required_methods> + +=item B<check_required_attributes> + +=item B<apply_attributes> + +=item B<apply_methods> + +=item B<apply_method_modifiers> + +=item B<apply_override_method_modifiers> + +=back + +=head1 BUGS + +See L<Moose/BUGS> for details on reporting bugs. + +=head1 AUTHORS + +=over 4 + +=item * + +Stevan Little <stevan.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=back + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2006 by Infinity Interactive, Inc.. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Moose/Meta/Role/Attribute.pm b/lib/Moose/Meta/Role/Attribute.pm new file mode 100644 index 0000000..0c09550 --- /dev/null +++ b/lib/Moose/Meta/Role/Attribute.pm @@ -0,0 +1,263 @@ +package Moose::Meta::Role::Attribute; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use List::Util 1.33 'all'; +use Scalar::Util 'blessed', 'weaken'; + +use parent 'Moose::Meta::Mixin::AttributeCore', 'Class::MOP::Object'; + +use Moose::Util 'throw_exception'; + +__PACKAGE__->meta->add_attribute( + 'metaclass' => ( + reader => 'metaclass', + Class::MOP::_definition_context(), + ) +); + +__PACKAGE__->meta->add_attribute( + 'associated_role' => ( + reader => 'associated_role', + Class::MOP::_definition_context(), + ) +); + +__PACKAGE__->meta->add_attribute( + '_original_role' => ( + reader => '_original_role', + Class::MOP::_definition_context(), + ) +); + +__PACKAGE__->meta->add_attribute( + 'is' => ( + reader => 'is', + Class::MOP::_definition_context(), + ) +); + +__PACKAGE__->meta->add_attribute( + 'original_options' => ( + reader => 'original_options', + Class::MOP::_definition_context(), + ) +); + +sub new { + my ( $class, $name, %options ) = @_; + + (defined $name) + || throw_exception( MustProvideANameForTheAttribute => params => \%options, + class => $class + ); + + my $role = delete $options{_original_role}; + + return bless { + name => $name, + original_options => \%options, + _original_role => $role, + %options, + }, $class; +} + +sub attach_to_role { + my ( $self, $role ) = @_; + + ( blessed($role) && $role->isa('Moose::Meta::Role') ) + || throw_exception( MustPassAMooseMetaRoleInstanceOrSubclass => class => $self, + role => $role + ); + + weaken( $self->{'associated_role'} = $role ); +} + +sub original_role { + my $self = shift; + + return $self->_original_role || $self->associated_role; +} + +sub attribute_for_class { + my $self = shift; + + my $metaclass = $self->original_role->applied_attribute_metaclass; + + return $metaclass->interpolate_class_and_new( + $self->name => %{ $self->original_options } ); +} + +sub clone { + my $self = shift; + + my $role = $self->original_role; + + return ( ref $self )->new( + $self->name, + %{ $self->original_options }, + _original_role => $role, + ); +} + +sub is_same_as { + my $self = shift; + my $attr = shift; + + my $self_options = $self->original_options; + my $other_options = $attr->original_options; + + return 0 + unless ( join q{|}, sort keys %{$self_options} ) eq ( join q{|}, sort keys %{$other_options} ); + + for my $key ( keys %{$self_options} ) { + return 0 if defined $self_options->{$key} && ! defined $other_options->{$key}; + return 0 if ! defined $self_options->{$key} && defined $other_options->{$key}; + + next if all { ! defined } $self_options->{$key}, $other_options->{$key}; + + return 0 unless $self_options->{$key} eq $other_options->{$key}; + } + + return 1; +} + +1; + +# ABSTRACT: The Moose attribute metaclass for Roles + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Moose::Meta::Role::Attribute - The Moose attribute metaclass for Roles + +=head1 VERSION + +version 2.1405 + +=head1 DESCRIPTION + +This class implements the API for attributes in roles. Attributes in roles are +more like attribute prototypes than full blown attributes. While they are +introspectable, they have very little behavior. + +=head1 METHODS + +This class provides the following methods: + +=over 4 + +=item B<< Moose::Meta::Role::Attribute->new(...) >> + +This method accepts all the options that would be passed to the constructor +for L<Moose::Meta::Attribute>. + +=item B<< $attr->metaclass >> + +=item B<< $attr->is >> + +Returns the option as passed to the constructor. + +=item B<< $attr->associated_role >> + +Returns the L<Moose::Meta::Role> to which this attribute belongs, if any. + +=item B<< $attr->original_role >> + +Returns the L<Moose::Meta::Role> in which this attribute was first +defined. This may not be the same as the value of C<associated_role()> for +attributes in a composite role, or when one role consumes other roles. + +=item B<< $attr->original_options >> + +Returns a hash reference of options passed to the constructor. This is used +when creating a L<Moose::Meta::Attribute> object from this object. + +=item B<< $attr->attach_to_role($role) >> + +Attaches the attribute to the given L<Moose::Meta::Role>. + +=item B<< $attr->attribute_for_class($metaclass) >> + +Given an attribute metaclass name, this method calls C<< +$metaclass->interpolate_class_and_new >> to construct an attribute object +which can be added to a L<Moose::Meta::Class>. + +=item B<< $attr->clone >> + +Creates a new object identical to the object on which the method is called. + +=item B<< $attr->is_same_as($other_attr) >> + +Compares two role attributes and returns true if they are identical. + +=back + +In addition, this class implements all informational predicates implements by +L<Moose::Meta::Attribute> (and L<Class::MOP::Attribute>). + +=head1 BUGS + +See L<Moose/BUGS> for details on reporting bugs. + +=head1 AUTHORS + +=over 4 + +=item * + +Stevan Little <stevan.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=back + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2006 by Infinity Interactive, Inc.. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Moose/Meta/Role/Composite.pm b/lib/Moose/Meta/Role/Composite.pm new file mode 100644 index 0000000..40e0dad --- /dev/null +++ b/lib/Moose/Meta/Role/Composite.pm @@ -0,0 +1,324 @@ +package Moose::Meta::Role::Composite; +our $VERSION = '2.1405'; + +use strict; +use warnings; +use metaclass; + +use Scalar::Util 'blessed'; +use Moose::Util 'throw_exception'; +use parent 'Moose::Meta::Role'; + +# NOTE: +# we need to override the ->name +# method from Class::MOP::Package +# since we don't have an actual +# package for this. +# - SL +__PACKAGE__->meta->add_attribute('name' => ( + reader => 'name', + Class::MOP::_definition_context(), +)); + +# NOTE: +# Again, since we don't have a real +# package to store our methods in, +# we use a HASH ref instead. +# - SL +__PACKAGE__->meta->add_attribute('_methods' => ( + reader => '_method_map', + default => sub { {} }, + Class::MOP::_definition_context(), +)); + +__PACKAGE__->meta->add_attribute('_overloads' => ( + reader => '_overload_map', + default => sub { {} }, + Class::MOP::_definition_context(), +)); + +__PACKAGE__->meta->add_attribute('_overload_fallback' => ( + accessor => '_overload_fallback', + Class::MOP::_definition_context(), +)); + +__PACKAGE__->meta->add_attribute( + 'application_role_summation_class', + reader => 'application_role_summation_class', + default => 'Moose::Meta::Role::Application::RoleSummation', + Class::MOP::_definition_context(), +); + +sub new { + my ($class, %params) = @_; + + # the roles param is required ... + foreach ( @{$params{roles}} ) { + unless ( $_->isa('Moose::Meta::Role') ) { + throw_exception( RolesListMustBeInstancesOfMooseMetaRole => params => \%params, + role => $_, + class => $class + ); + } + } + + my @composition_roles = map { + $_->composition_class_roles + } @{ $params{roles} }; + + if (@composition_roles) { + my $meta = Moose::Meta::Class->create_anon_class( + superclasses => [ $class ], + roles => [ @composition_roles ], + cache => 1, + ); + $class = $meta->name; + } + + # and the name is created from the + # roles if one has not been provided + $params{name} ||= (join "|" => map { $_->name } @{$params{roles}}); + $class->_new(\%params); +} + +# There's no such thing as an anonymous composite role since composites are an +# artifact of Moose's internals. However, a composite role that contains an +# anon role may _look_ like an anon role since $self->name =~ /$anon_key/ can +# return true if the first role in the composite is anonymous itself. +sub is_anon { 0 } + +# This is largely a copy of what's in Moose::Meta::Role (itself +# largely a copy of Class::MOP::Class). However, we can't actually +# call add_package_symbol, because there's no package into which to +# add the symbol. +sub add_method { + my ($self, $method_name, $method) = @_; + + unless ( defined $method_name && $method_name ) { + throw_exception( MustDefineAMethodName => instance => $self ); + } + + my $body; + if (blessed($method)) { + $body = $method->body; + if ($method->package_name ne $self->name) { + $method = $method->clone( + package_name => $self->name, + name => $method_name + ) if $method->can('clone'); + } + } + else { + $body = $method; + $method = $self->wrap_method_body( body => $body, name => $method_name ); + } + + $self->_method_map->{$method_name} = $method; +} + +sub get_method_list { + my $self = shift; + return keys %{ $self->_method_map }; +} + +sub _get_local_methods { + my $self = shift; + return values %{ $self->_method_map }; +} + +sub has_method { + my ($self, $method_name) = @_; + + return exists $self->_method_map->{$method_name}; +} + +sub get_method { + my ($self, $method_name) = @_; + + return $self->_method_map->{$method_name}; +} + +sub is_overloaded { + my ($self) = @_; + return keys %{ $self->_overload_map }; +} + +sub add_overloaded_operator { + my ( $self, $op_name, $overload ) = @_; + + unless ( defined $op_name && $op_name ) { + throw_exception( + 'MustDefineAnOverloadOperator', + instance => $self, + ); + } + + $self->_overload_map->{$op_name} = $overload; +} + +sub get_overload_fallback_value { + my ($self) = @_; + return $self->_overload_fallback; +} + +sub set_overload_fallback_value { + my $self = shift; + $self->_overload_fallback(shift); +} + +sub get_all_overloaded_operators { + my ( $self, $method_name ) = @_; + return values %{ $self->_overload_map }; +} + +sub apply_params { + my ($self, $role_params) = @_; + Moose::Util::_load_user_class($self->application_role_summation_class); + + $self->application_role_summation_class->new( + role_params => $role_params, + )->apply($self); + + return $self; +} + +sub reinitialize { + my ( $class, $old_meta, @args ) = @_; + + throw_exception( CannotInitializeMooseMetaRoleComposite => old_meta => $old_meta, + args => \@args, + role_composite => $class + ) + if !blessed $old_meta + || !$old_meta->isa('Moose::Meta::Role::Composite'); + + my %existing_classes = map { $_ => $old_meta->$_() } qw( + application_role_summation_class + ); + + return $old_meta->meta->clone_object( $old_meta, %existing_classes, @args ); +} + +1; + +# ABSTRACT: An object to represent the set of roles + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Moose::Meta::Role::Composite - An object to represent the set of roles + +=head1 VERSION + +version 2.1405 + +=head1 DESCRIPTION + +A composite is a role that consists of a set of two or more roles. + +The API of a composite role is almost identical to that of a regular +role. + +=head1 INHERITANCE + +C<Moose::Meta::Role::Composite> is a subclass of L<Moose::Meta::Role>. + +=head2 METHODS + +=over 4 + +=item B<< Moose::Meta::Role::Composite->new(%options) >> + +This returns a new composite role object. It accepts the same +options as its parent class, with a few changes: + +=over 8 + +=item * roles + +This option is an array reference containing a list of +L<Moose::Meta::Role> object. This is a required option. + +=item * name + +If a name is not given, one is generated from the roles provided. + +=item * apply_params(\%role_params) + +Creates a new RoleSummation role application with C<%role_params> and applies +the composite role to it. The RoleSummation role application class used is +determined by the composite role's C<application_role_summation_class> +attribute. + +=item * reinitialize($metaclass) + +Like C<< Class::MOP::Package->reinitialize >>, but doesn't allow passing a +string with the package name, as there is no real package for composite roles. + +=back + +=back + +=head1 BUGS + +See L<Moose/BUGS> for details on reporting bugs. + +=head1 AUTHORS + +=over 4 + +=item * + +Stevan Little <stevan.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=back + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2006 by Infinity Interactive, Inc.. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Moose/Meta/Role/Method.pm b/lib/Moose/Meta/Role/Method.pm new file mode 100644 index 0000000..5dff6f4 --- /dev/null +++ b/lib/Moose/Meta/Role/Method.pm @@ -0,0 +1,101 @@ +package Moose::Meta::Role::Method; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use parent 'Moose::Meta::Method'; + +sub _make_compatible_with { + my $self = shift; + my ($other) = @_; + + # XXX: this is pretty gross. the issue here is blah blah blah + # see the comments in CMOP::Method::Meta and CMOP::Method::Wrapped + return $self unless $other->_is_compatible_with($self->_real_ref_name); + + return $self->SUPER::_make_compatible_with(@_); +} + +1; + +# ABSTRACT: A Moose Method metaclass for Roles + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Moose::Meta::Role::Method - A Moose Method metaclass for Roles + +=head1 VERSION + +version 2.1405 + +=head1 DESCRIPTION + +This is primarily used to mark methods coming from a role +as being different. Right now it is nothing but a subclass +of L<Moose::Meta::Method>. + +=head1 BUGS + +See L<Moose/BUGS> for details on reporting bugs. + +=head1 AUTHORS + +=over 4 + +=item * + +Stevan Little <stevan.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=back + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2006 by Infinity Interactive, Inc.. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Moose/Meta/Role/Method/Conflicting.pm b/lib/Moose/Meta/Role/Method/Conflicting.pm new file mode 100644 index 0000000..9d810fc --- /dev/null +++ b/lib/Moose/Meta/Role/Method/Conflicting.pm @@ -0,0 +1,139 @@ +package Moose::Meta::Role::Method::Conflicting; +our $VERSION = '2.1405'; + +use strict; +use warnings; + +use Moose::Util; + +use parent 'Moose::Meta::Role::Method::Required'; + +__PACKAGE__->meta->add_attribute('roles' => ( + reader => 'roles', + required => 1, + Class::MOP::_definition_context(), +)); + +sub roles_as_english_list { + my $self = shift; + Moose::Util::english_list( map { q{'} . $_ . q{'} } @{ $self->roles } ); +} + +1; + +# ABSTRACT: A Moose metaclass for conflicting methods in Roles + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Moose::Meta::Role::Method::Conflicting - A Moose metaclass for conflicting methods in Roles + +=head1 VERSION + +version 2.1405 + +=head1 DESCRIPTION + +=head1 INHERITANCE + +C<Moose::Meta::Role::Method::Conflicting> is a subclass of +L<Moose::Meta::Role::Method::Required>. + +=head1 METHODS + +=over 4 + +=item B<< Moose::Meta::Role::Method::Conflicting->new(%options) >> + +This creates a new type constraint based on the provided C<%options>: + +=over 8 + +=item * name + +The method name. This is required. + +=item * roles + +The list of role names that generated the conflict. This is required. + +=back + +=item B<< $method->name >> + +Returns the conflicting method's name, as provided to the constructor. + +=item B<< $method->roles >> + +Returns the roles that generated this conflicting method, as provided to the +constructor. + +=item B<< $method->roles_as_english_list >> + +Returns the roles that generated this conflicting method as an English list. + +=back + +=head1 BUGS + +See L<Moose/BUGS> for details on reporting bugs. + +=head1 AUTHORS + +=over 4 + +=item * + +Stevan Little <stevan.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=back + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2006 by Infinity Interactive, Inc.. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Moose/Meta/Role/Method/Required.pm b/lib/Moose/Meta/Role/Method/Required.pm new file mode 100644 index 0000000..ebdd366 --- /dev/null +++ b/lib/Moose/Meta/Role/Method/Required.pm @@ -0,0 +1,129 @@ +package Moose::Meta::Role::Method::Required; +our $VERSION = '2.1405'; + +use strict; +use warnings; +use metaclass; + +use overload '""' => sub { shift->name }, # stringify to method name + fallback => 1; + +use parent 'Class::MOP::Object'; + +# This is not a Moose::Meta::Role::Method because it has no implementation, it +# is just a name + +__PACKAGE__->meta->add_attribute('name' => ( + reader => 'name', + required => 1, + Class::MOP::_definition_context(), +)); + +sub new { shift->_new(@_) } + +1; + +# ABSTRACT: A Moose metaclass for required methods in Roles + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Moose::Meta::Role::Method::Required - A Moose metaclass for required methods in Roles + +=head1 VERSION + +version 2.1405 + +=head1 DESCRIPTION + +=head1 INHERITANCE + +C<Moose::Meta::Role::Method::Required> is a subclass of L<Class::MOP::Object>. +It is B<not> a subclass of C<Moose::Meta::Role::Method> since it does not +provide an implementation of the method. + +=head1 METHODS + +=over 4 + +=item B<< Moose::Meta::Role::Method::Required->new(%options) >> + +This creates a new type constraint based on the provided C<%options>: + +=over 8 + +=item * name + +The method name. This is required. + +=back + +=item B<< $method->name >> + +Returns the required method's name, as provided to the constructor. + +=back + +=head1 BUGS + +See L<Moose/BUGS> for details on reporting bugs. + +=head1 AUTHORS + +=over 4 + +=item * + +Stevan Little <stevan.little@iinteractive.com> + +=item * + +Dave Rolsky <autarch@urth.org> + +=item * + +Jesse Luehrs <doy@tozt.net> + +=item * + +Shawn M Moore <code@sartak.org> + +=item * + +יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Florian Ragwitz <rafl@debian.org> + +=item * + +Hans Dieter Pearcey <hdp@weftsoar.net> + +=item * + +Chris Prather <chris@prather.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=back + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2006 by Infinity Interactive, Inc.. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut |