lib/Moose/Meta/Role/Attribute.pm

   1 package Moose::Meta::Role::Attribute;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Carp 'confess';
   7 use List::MoreUtils 'all';
   8 use Scalar::Util 'blessed', 'weaken';
   9
  10 use base 'Moose::Meta::Mixin::AttributeCore', 'Class::MOP::Object';
  11
  12 __PACKAGE__->meta->add_attribute(
  13     'metaclass' => (
  14         reader => 'metaclass',
  15         Class::MOP::_definition_context(),
  16     )
  17 );
  18
  19 __PACKAGE__->meta->add_attribute(
  20     'associated_role' => (
  21         reader => 'associated_role',
  22         Class::MOP::_definition_context(),
  23     )
  24 );
  25
  26 __PACKAGE__->meta->add_attribute(
  27     '_original_role' => (
  28         reader => '_original_role',
  29         Class::MOP::_definition_context(),
  30     )
  31 );
  32
  33 __PACKAGE__->meta->add_attribute(
  34     'is' => (
  35         reader => 'is',
  36         Class::MOP::_definition_context(),
  37     )
  38 );
  39
  40 __PACKAGE__->meta->add_attribute(
  41     'original_options' => (
  42         reader => 'original_options',
  43         Class::MOP::_definition_context(),
  44     )
  45 );
  46
  47 sub new {
  48     my ( $class, $name, %options ) = @_;
  49
  50     (defined $name)
  51         || confess "You must provide a name for the attribute";
  52
  53     my $role = delete $options{_original_role};
  54
  55     return bless {
  56         name             => $name,
  57         original_options => \%options,
  58         _original_role   => $role,
  59         %options,
  60     }, $class;
  61 }
  62
  63 sub attach_to_role {
  64     my ( $self, $role ) = @_;
  65
  66     ( blessed($role) && $role->isa('Moose::Meta::Role') )
  67         || confess
  68         "You must pass a Moose::Meta::Role instance (or a subclass)";
  69
  70     weaken( $self->{'associated_role'} = $role );
  71 }
  72
  73 sub original_role {
  74     my $self = shift;
  75
  76     return $self->_original_role || $self->associated_role;
  77 }
  78
  79 sub attribute_for_class {
  80     my $self = shift;
  81
  82     my $metaclass = $self->original_role->applied_attribute_metaclass;
  83
  84     return $metaclass->interpolate_class_and_new(
  85         $self->name => %{ $self->original_options } );
  86 }
  87
  88 sub clone {
  89     my $self = shift;
  90
  91     my $role = $self->original_role;
  92
  93     return ( ref $self )->new(
  94         $self->name,
  95         %{ $self->original_options },
  96         _original_role => $role,
  97     );
  98 }
  99
 100 sub is_same_as {
 101     my $self = shift;
 102     my $attr = shift;
 103
 104     my $self_options = $self->original_options;
 105     my $other_options = $attr->original_options;
 106
 107     return 0
 108         unless ( join q{|}, sort keys %{$self_options} ) eq ( join q{|}, sort keys %{$other_options} );
 109
 110     for my $key ( keys %{$self_options} ) {
 111         return 0 if defined $self_options->{$key} && ! defined $other_options->{$key};
 112         return 0 if ! defined $self_options->{$key} && defined $other_options->{$key};
 113
 114         next if all { ! defined } $self_options->{$key}, $other_options->{$key};
 115
 116         return 0 unless $self_options->{$key} eq $other_options->{$key};
 117     }
 118
 119     return 1;
 120 }
 121
 122 1;
 123
 124 # ABSTRACT: The Moose attribute metaclass for Roles
 125
 126 __END__
 127
 128 =pod
 129
 130 =head1 DESCRIPTION
 131
 132 This class implements the API for attributes in roles. Attributes in roles are
 133 more like attribute prototypes than full blown attributes. While they are
 134 introspectable, they have very little behavior.
 135
 136 =head1 METHODS
 137
 138 This class provides the following methods:
 139
 140 =over 4
 141
 142 =item B<< Moose::Meta::Role::Attribute->new(...) >>
 143
 144 This method accepts all the options that would be passed to the constructor
 145 for L<Moose::Meta::Attribute>.
 146
 147 =item B<< $attr->metaclass >>
 148
 149 =item B<< $attr->is >>
 150
 151 Returns the option as passed to the constructor.
 152
 153 =item B<< $attr->associated_role >>
 154
 155 Returns the L<Moose::Meta::Role> to which this attribute belongs, if any.
 156
 157 =item B<< $attr->original_role >>
 158
 159 Returns the L<Moose::Meta::Role> in which this attribute was first
 160 defined. This may not be the same as the value C<associated_role()> in the
 161 case of composite role, or the case where one role consumes other roles.
 162
 163 =item B<< $attr->original_options >>
 164
 165 Returns a hash reference of options passed to the constructor. This is used
 166 when creating a L<Moose::Meta::Attribute> object from this object.
 167
 168 =item B<< $attr->attach_to_role($role) >>
 169
 170 Attaches the attribute to the given L<Moose::Meta::Role>.
 171
 172 =item B<< $attr->attribute_for_class($metaclass) >>
 173
 174 Given an attribute metaclass name, this method calls C<<
 175 $metaclass->interpolate_class_and_new >> to construct an attribute object
 176 which can be added to a L<Moose::Meta::Class>.
 177
 178 =item B<< $attr->clone >>
 179
 180 Creates a new object identical to the object on which the method is called.
 181
 182 =item B<< $attr->is_same_as($other_attr) >>
 183
 184 Compares two role attributes and returns true if they are identical.
 185
 186 =back
 187
 188 In addition, this class implements all informational predicates implements by
 189 L<Moose::Meta::Attribute> (and L<Class::MOP::Attribute>).
 190
 191 =head1 BUGS
 192
 193 See L<Moose/BUGS> for details on reporting bugs.
 194
 195 =cut