2 package Moose::Meta::Attribute;
7 use Scalar::Util 'weaken', 'reftype';
10 use Moose::Util::TypeConstraints ':no_export';
12 our $VERSION = '0.02';
14 use base 'Class::MOP::Attribute';
16 Moose::Meta::Attribute->meta->add_attribute(
17 Class::MOP::Attribute->new('coerce' => (
19 predicate => 'has_coercion'
23 Moose::Meta::Attribute->meta->add_attribute(
24 Class::MOP::Attribute->new('weak_ref' => (
27 'has_weak_ref' => sub { $_[0]->weak_ref() ? 1 : 0 }
32 Moose::Meta::Attribute->meta->add_attribute(
33 Class::MOP::Attribute->new('type_constraint' => (
34 reader => 'type_constraint',
35 predicate => 'has_type_constraint',
39 Moose::Meta::Attribute->meta->add_before_method_modifier('new' => sub {
40 my (undef, undef, %options) = @_;
41 if (exists $options{coerce} && $options{coerce}) {
42 (exists $options{type_constraint})
43 || confess "You cannot have coercion without specifying a type constraint";
44 confess "You cannot have a weak reference to a coerced value"
45 if $options{weak_ref};
47 (reftype($options{type_constraint}) && reftype($options{type_constraint}) eq 'CODE')
48 || confess "Type cosntraint parameter must be a code-ref, not " . $options{type_constraint}
49 if exists $options{type_constraint};
52 sub generate_accessor_method {
53 my ($self, $attr_name) = @_;
54 if ($self->has_type_constraint) {
55 if ($self->has_weak_ref) {
57 if (scalar(@_) == 2) {
58 (defined $self->type_constraint->($_[1]))
59 || confess "Attribute ($attr_name) does not pass the type contraint with '$_[1]'"
61 $_[0]->{$attr_name} = $_[1];
62 weaken($_[0]->{$attr_name});
68 if ($self->has_coercion) {
70 if (scalar(@_) == 2) {
71 my $val = $self->coerce->($_[1]);
72 (defined $self->type_constraint->($val))
73 || confess "Attribute ($attr_name) does not pass the type contraint with '$val'"
75 $_[0]->{$attr_name} = $val;
82 if (scalar(@_) == 2) {
83 (defined $self->type_constraint->($_[1]))
84 || confess "Attribute ($attr_name) does not pass the type contraint with '$_[1]'"
86 $_[0]->{$attr_name} = $_[1];
94 if ($self->has_weak_ref) {
96 if (scalar(@_) == 2) {
97 $_[0]->{$attr_name} = $_[1];
98 weaken($_[0]->{$attr_name});
105 $_[0]->{$attr_name} = $_[1] if scalar(@_) == 2;
112 sub generate_writer_method {
113 my ($self, $attr_name) = @_;
114 if ($self->has_type_constraint) {
115 if ($self->has_weak_ref) {
117 (defined $self->type_constraint->($_[1]))
118 || confess "Attribute ($attr_name) does not pass the type contraint with '$_[1]'"
120 $_[0]->{$attr_name} = $_[1];
121 weaken($_[0]->{$attr_name});
126 (defined $self->type_constraint->($_[1]))
127 || confess "Attribute ($attr_name) does not pass the type contraint with '$_[1]'"
129 $_[0]->{$attr_name} = $_[1];
134 if ($self->has_weak_ref) {
136 $_[0]->{$attr_name} = $_[1];
137 weaken($_[0]->{$attr_name});
141 return sub { $_[0]->{$attr_name} = $_[1] };
154 Moose::Meta::Attribute - The Moose attribute metaobject
160 This is a subclass of L<Class::MOP::Attribute> with Moose specific
169 =item B<generate_accessor_method>
171 =item B<generate_writer_method>
177 =item B<has_type_constraint>
179 =item B<type_constraint>
181 =item B<has_weak_ref>
187 =item B<has_coercion>
193 All complex software has bugs lurking in it, and this module is no
194 exception. If you find a bug please either email me, or add the bug
199 Stevan Little E<lt>stevan@iinteractive.comE<gt>
201 =head1 COPYRIGHT AND LICENSE
203 Copyright 2006 by Infinity Interactive, Inc.
205 L<http://www.iinteractive.com>
207 This library is free software; you can redistribute it and/or modify
208 it under the same terms as Perl itself.