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