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