This commit is contained in:
225
CPAN/Moose/Meta/Role/Application.pm
Normal file
225
CPAN/Moose/Meta/Role/Application.pm
Normal file
@@ -0,0 +1,225 @@
|
||||
package Moose::Meta::Role::Application;
|
||||
our $VERSION = '2.2207';
|
||||
|
||||
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.2207
|
||||
|
||||
=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@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Dave Rolsky <autarch@urth.org>
|
||||
|
||||
=item *
|
||||
|
||||
Jesse Luehrs <doy@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Shawn M Moore <sartak@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
|
||||
|
||||
=item *
|
||||
|
||||
Karen Etheridge <ether@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=item *
|
||||
|
||||
Hans Dieter Pearcey <hdp@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Chris Prather <chris@prather.org>
|
||||
|
||||
=item *
|
||||
|
||||
Matt S Trout <mstrout@cpan.org>
|
||||
|
||||
=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
|
||||
440
CPAN/Moose/Meta/Role/Application/RoleSummation.pm
Normal file
440
CPAN/Moose/Meta/Role/Application/RoleSummation.pm
Normal file
@@ -0,0 +1,440 @@
|
||||
package Moose::Meta::Role::Application::RoleSummation;
|
||||
our $VERSION = '2.2207';
|
||||
|
||||
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.2207
|
||||
|
||||
=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@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Dave Rolsky <autarch@urth.org>
|
||||
|
||||
=item *
|
||||
|
||||
Jesse Luehrs <doy@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Shawn M Moore <sartak@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
|
||||
|
||||
=item *
|
||||
|
||||
Karen Etheridge <ether@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=item *
|
||||
|
||||
Hans Dieter Pearcey <hdp@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Chris Prather <chris@prather.org>
|
||||
|
||||
=item *
|
||||
|
||||
Matt S Trout <mstrout@cpan.org>
|
||||
|
||||
=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
|
||||
314
CPAN/Moose/Meta/Role/Application/ToClass.pm
Normal file
314
CPAN/Moose/Meta/Role/Application/ToClass.pm
Normal file
@@ -0,0 +1,314 @@
|
||||
package Moose::Meta::Role::Application::ToClass;
|
||||
our $VERSION = '2.2207';
|
||||
|
||||
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.2207
|
||||
|
||||
=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@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Dave Rolsky <autarch@urth.org>
|
||||
|
||||
=item *
|
||||
|
||||
Jesse Luehrs <doy@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Shawn M Moore <sartak@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
|
||||
|
||||
=item *
|
||||
|
||||
Karen Etheridge <ether@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=item *
|
||||
|
||||
Hans Dieter Pearcey <hdp@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Chris Prather <chris@prather.org>
|
||||
|
||||
=item *
|
||||
|
||||
Matt S Trout <mstrout@cpan.org>
|
||||
|
||||
=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
|
||||
142
CPAN/Moose/Meta/Role/Application/ToInstance.pm
Normal file
142
CPAN/Moose/Meta/Role/Application/ToInstance.pm
Normal file
@@ -0,0 +1,142 @@
|
||||
package Moose::Meta::Role::Application::ToInstance;
|
||||
our $VERSION = '2.2207';
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use metaclass;
|
||||
|
||||
use Scalar::Util 'blessed';
|
||||
use List::Util 1.33 'all';
|
||||
use Devel::OverloadInfo 0.004 'is_overloaded';
|
||||
|
||||
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
|
||||
&& is_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.2207
|
||||
|
||||
=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@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Dave Rolsky <autarch@urth.org>
|
||||
|
||||
=item *
|
||||
|
||||
Jesse Luehrs <doy@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Shawn M Moore <sartak@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
|
||||
|
||||
=item *
|
||||
|
||||
Karen Etheridge <ether@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=item *
|
||||
|
||||
Hans Dieter Pearcey <hdp@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Chris Prather <chris@prather.org>
|
||||
|
||||
=item *
|
||||
|
||||
Matt S Trout <mstrout@cpan.org>
|
||||
|
||||
=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
|
||||
283
CPAN/Moose/Meta/Role/Application/ToRole.pm
Normal file
283
CPAN/Moose/Meta/Role/Application/ToRole.pm
Normal file
@@ -0,0 +1,283 @@
|
||||
package Moose::Meta::Role::Application::ToRole;
|
||||
our $VERSION = '2.2207';
|
||||
|
||||
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.2207
|
||||
|
||||
=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@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Dave Rolsky <autarch@urth.org>
|
||||
|
||||
=item *
|
||||
|
||||
Jesse Luehrs <doy@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Shawn M Moore <sartak@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
|
||||
|
||||
=item *
|
||||
|
||||
Karen Etheridge <ether@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=item *
|
||||
|
||||
Hans Dieter Pearcey <hdp@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Chris Prather <chris@prather.org>
|
||||
|
||||
=item *
|
||||
|
||||
Matt S Trout <mstrout@cpan.org>
|
||||
|
||||
=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
|
||||
259
CPAN/Moose/Meta/Role/Attribute.pm
Normal file
259
CPAN/Moose/Meta/Role/Attribute.pm
Normal file
@@ -0,0 +1,259 @@
|
||||
package Moose::Meta::Role::Attribute;
|
||||
our $VERSION = '2.2207';
|
||||
|
||||
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 },
|
||||
role_attribute => $self,
|
||||
);
|
||||
}
|
||||
|
||||
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.2207
|
||||
|
||||
=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
|
||||
|
||||
=head2 Moose::Meta::Role::Attribute->new(...)
|
||||
|
||||
This method accepts all the options that would be passed to the constructor
|
||||
for L<Moose::Meta::Attribute>.
|
||||
|
||||
=head2 $attr->metaclass
|
||||
|
||||
=head2 $attr->is
|
||||
|
||||
Returns the option as passed to the constructor.
|
||||
|
||||
=head2 $attr->associated_role
|
||||
|
||||
Returns the L<Moose::Meta::Role> to which this attribute belongs, if any.
|
||||
|
||||
=head2 $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.
|
||||
|
||||
=head2 $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.
|
||||
|
||||
=head2 $attr->attach_to_role($role)
|
||||
|
||||
Attaches the attribute to the given L<Moose::Meta::Role>.
|
||||
|
||||
=head2 $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>.
|
||||
|
||||
=head2 $attr->clone
|
||||
|
||||
Creates a new object identical to the object on which the method is called.
|
||||
|
||||
=head2 $attr->is_same_as($other_attr)
|
||||
|
||||
Compares two role attributes and returns true if they are identical.
|
||||
|
||||
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@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Dave Rolsky <autarch@urth.org>
|
||||
|
||||
=item *
|
||||
|
||||
Jesse Luehrs <doy@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Shawn M Moore <sartak@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
|
||||
|
||||
=item *
|
||||
|
||||
Karen Etheridge <ether@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=item *
|
||||
|
||||
Hans Dieter Pearcey <hdp@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Chris Prather <chris@prather.org>
|
||||
|
||||
=item *
|
||||
|
||||
Matt S Trout <mstrout@cpan.org>
|
||||
|
||||
=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
|
||||
320
CPAN/Moose/Meta/Role/Composite.pm
Normal file
320
CPAN/Moose/Meta/Role/Composite.pm
Normal file
@@ -0,0 +1,320 @@
|
||||
package Moose::Meta::Role::Composite;
|
||||
our $VERSION = '2.2207';
|
||||
|
||||
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.2207
|
||||
|
||||
=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>.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 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 4
|
||||
|
||||
=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
|
||||
|
||||
=head1 BUGS
|
||||
|
||||
See L<Moose/BUGS> for details on reporting bugs.
|
||||
|
||||
=head1 AUTHORS
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
Stevan Little <stevan@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Dave Rolsky <autarch@urth.org>
|
||||
|
||||
=item *
|
||||
|
||||
Jesse Luehrs <doy@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Shawn M Moore <sartak@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
|
||||
|
||||
=item *
|
||||
|
||||
Karen Etheridge <ether@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=item *
|
||||
|
||||
Hans Dieter Pearcey <hdp@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Chris Prather <chris@prather.org>
|
||||
|
||||
=item *
|
||||
|
||||
Matt S Trout <mstrout@cpan.org>
|
||||
|
||||
=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
|
||||
101
CPAN/Moose/Meta/Role/Method.pm
Normal file
101
CPAN/Moose/Meta/Role/Method.pm
Normal file
@@ -0,0 +1,101 @@
|
||||
package Moose::Meta::Role::Method;
|
||||
our $VERSION = '2.2207';
|
||||
|
||||
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.2207
|
||||
|
||||
=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@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Dave Rolsky <autarch@urth.org>
|
||||
|
||||
=item *
|
||||
|
||||
Jesse Luehrs <doy@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Shawn M Moore <sartak@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
|
||||
|
||||
=item *
|
||||
|
||||
Karen Etheridge <ether@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=item *
|
||||
|
||||
Hans Dieter Pearcey <hdp@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Chris Prather <chris@prather.org>
|
||||
|
||||
=item *
|
||||
|
||||
Matt S Trout <mstrout@cpan.org>
|
||||
|
||||
=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
|
||||
135
CPAN/Moose/Meta/Role/Method/Conflicting.pm
Normal file
135
CPAN/Moose/Meta/Role/Method/Conflicting.pm
Normal file
@@ -0,0 +1,135 @@
|
||||
package Moose::Meta::Role::Method::Conflicting;
|
||||
our $VERSION = '2.2207';
|
||||
|
||||
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.2207
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
=head1 INHERITANCE
|
||||
|
||||
C<Moose::Meta::Role::Method::Conflicting> is a subclass of
|
||||
L<Moose::Meta::Role::Method::Required>.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=head2 Moose::Meta::Role::Method::Conflicting->new(%options)
|
||||
|
||||
This creates a new type constraint based on the provided C<%options>:
|
||||
|
||||
=over 4
|
||||
|
||||
=item * name
|
||||
|
||||
The method name. This is required.
|
||||
|
||||
=item * roles
|
||||
|
||||
The list of role names that generated the conflict. This is required.
|
||||
|
||||
=back
|
||||
|
||||
=head2 $method->name
|
||||
|
||||
Returns the conflicting method's name, as provided to the constructor.
|
||||
|
||||
=head2 $method->roles
|
||||
|
||||
Returns the roles that generated this conflicting method, as provided to the
|
||||
constructor.
|
||||
|
||||
=head2 $method->roles_as_english_list
|
||||
|
||||
Returns the roles that generated this conflicting method as an English list.
|
||||
|
||||
=head1 BUGS
|
||||
|
||||
See L<Moose/BUGS> for details on reporting bugs.
|
||||
|
||||
=head1 AUTHORS
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
Stevan Little <stevan@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Dave Rolsky <autarch@urth.org>
|
||||
|
||||
=item *
|
||||
|
||||
Jesse Luehrs <doy@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Shawn M Moore <sartak@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
|
||||
|
||||
=item *
|
||||
|
||||
Karen Etheridge <ether@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=item *
|
||||
|
||||
Hans Dieter Pearcey <hdp@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Chris Prather <chris@prather.org>
|
||||
|
||||
=item *
|
||||
|
||||
Matt S Trout <mstrout@cpan.org>
|
||||
|
||||
=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
|
||||
127
CPAN/Moose/Meta/Role/Method/Required.pm
Normal file
127
CPAN/Moose/Meta/Role/Method/Required.pm
Normal file
@@ -0,0 +1,127 @@
|
||||
package Moose::Meta::Role::Method::Required;
|
||||
our $VERSION = '2.2207';
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use metaclass;
|
||||
|
||||
use overload
|
||||
'""' => sub { shift->name }, # stringify to method name
|
||||
'bool' => sub { 1 },
|
||||
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.2207
|
||||
|
||||
=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
|
||||
|
||||
=head2 Moose::Meta::Role::Method::Required->new(%options)
|
||||
|
||||
This creates a new type constraint based on the provided C<%options>:
|
||||
|
||||
=over 4
|
||||
|
||||
=item * name
|
||||
|
||||
The method name. This is required.
|
||||
|
||||
=back
|
||||
|
||||
=head2 $method->name
|
||||
|
||||
Returns the required method's name, as provided to the constructor.
|
||||
|
||||
=head1 BUGS
|
||||
|
||||
See L<Moose/BUGS> for details on reporting bugs.
|
||||
|
||||
=head1 AUTHORS
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
Stevan Little <stevan@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Dave Rolsky <autarch@urth.org>
|
||||
|
||||
=item *
|
||||
|
||||
Jesse Luehrs <doy@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Shawn M Moore <sartak@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
|
||||
|
||||
=item *
|
||||
|
||||
Karen Etheridge <ether@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=item *
|
||||
|
||||
Hans Dieter Pearcey <hdp@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Chris Prather <chris@prather.org>
|
||||
|
||||
=item *
|
||||
|
||||
Matt S Trout <mstrout@cpan.org>
|
||||
|
||||
=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
|
||||
Reference in New Issue
Block a user