diff options
Diffstat (limited to 'lib/Moose/Meta/Role/Attribute.pm')
| -rw-r--r-- | lib/Moose/Meta/Role/Attribute.pm | 263 |
1 files changed, 263 insertions, 0 deletions
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 |