2 package Moose::Meta::Attribute;
7 use Scalar::Util 'weaken', 'reftype';
10 use Moose::Util::TypeConstraints ':no_export';
12 our $VERSION = '0.01';
14 use base 'Class::MOP::Attribute';
16 Moose::Meta::Attribute->meta->add_attribute(
17 Class::MOP::Attribute->new('weak_ref' => (
20 'has_weak_ref' => sub { $_[0]->weak_ref() ? 1 : 0 }
25 Moose::Meta::Attribute->meta->add_attribute(
26 Class::MOP::Attribute->new('type_constraint' => (
27 reader => 'type_constraint',
28 predicate => 'has_type_constraint',
32 Moose::Meta::Attribute->meta->add_before_method_modifier('new' => sub {
33 my (undef, undef, %options) = @_;
34 (reftype($options{type_constraint}) && reftype($options{type_constraint}) eq 'CODE')
35 || confess "Type cosntraint parameter must be a code-ref, not " . $options{type_constraint}
36 if exists $options{type_constraint};
39 sub generate_accessor_method {
40 my ($self, $attr_name) = @_;
41 if ($self->has_type_constraint) {
42 if ($self->has_weak_ref) {
44 if (scalar(@_) == 2) {
45 (defined $self->type_constraint->($_[1]))
46 || confess "Attribute ($attr_name) does not pass the type contraint"
48 $_[0]->{$attr_name} = $_[1];
49 weaken($_[0]->{$attr_name});
56 if (scalar(@_) == 2) {
57 (defined $self->type_constraint->($_[1]))
58 || confess "Attribute ($attr_name) does not pass the type contraint"
60 $_[0]->{$attr_name} = $_[1];
67 if ($self->has_weak_ref) {
69 if (scalar(@_) == 2) {
70 $_[0]->{$attr_name} = $_[1];
71 weaken($_[0]->{$attr_name});
78 $_[0]->{$attr_name} = $_[1] if scalar(@_) == 2;
85 sub generate_writer_method {
86 my ($self, $attr_name) = @_;
87 if ($self->has_type_constraint) {
88 if ($self->has_weak_ref) {
90 (defined $self->type_constraint->($_[1]))
91 || confess "Attribute ($attr_name) does not pass the type contraint"
93 $_[0]->{$attr_name} = $_[1];
94 weaken($_[0]->{$attr_name});
99 (defined $self->type_constraint->($_[1]))
100 || confess "Attribute ($attr_name) does not pass the type contraint"
102 $_[0]->{$attr_name} = $_[1];
107 if ($self->has_weak_ref) {
109 $_[0]->{$attr_name} = $_[1];
110 weaken($_[0]->{$attr_name});
114 return sub { $_[0]->{$attr_name} = $_[1] };
127 Moose::Meta::Attribute -
139 =item B<generate_accessor_method>
141 =item B<generate_writer_method>
147 =item B<has_type_constraint>
149 =item B<type_constraint>
151 =item B<has_weak_ref>
159 All complex software has bugs lurking in it, and this module is no
160 exception. If you find a bug please either email me, or add the bug
165 I use L<Devel::Cover> to test the code coverage of my tests, below is the
166 L<Devel::Cover> report on this module's test suite.
168 =head1 ACKNOWLEDGEMENTS
172 Stevan Little E<lt>stevan@iinteractive.comE<gt>
174 =head1 COPYRIGHT AND LICENSE
176 Copyright 2006 by Infinity Interactive, Inc.
178 L<http://www.iinteractive.com>
180 This library is free software; you can redistribute it and/or modify
181 it under the same terms as Perl itself.