lib/Moose/Meta/Role/Attribute.pm

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