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