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
|
||||
Reference in New Issue
Block a user