Comment out alias/excludes warnings for 1.12 release
[gitmo/Moose.git] / lib / Moose / Meta / Attribute / Native / Trait.pm
CommitLineData
e3c07b19 1
c466e58f 2package Moose::Meta::Attribute::Native::Trait;
e3c07b19 3use Moose::Role;
4use Moose::Util::TypeConstraints;
5
6b2f825e 6our $VERSION = '1.11';
e3c07b19 7$VERSION = eval $VERSION;
8our $AUTHORITY = 'cpan:STEVAN';
9
2e069f5a 10requires '_helper_type';
e3c07b19 11
a65d8455 12# these next two are the possible methods you can use in the 'handles'
13# map.
e3c07b19 14
a65d8455 15# provide a Class or Role which we can collect the method providers
16# from
e3c07b19 17
a65d8455 18# or you can provide a HASH ref of anon subs yourself. This will also
19# collect and store the methods from a method_provider as well
e3c07b19 20has 'method_constructors' => (
21 is => 'ro',
22 isa => 'HashRef',
23 lazy => 1,
24 default => sub {
25 my $self = shift;
26 return +{} unless $self->has_method_provider;
27 # or grab them from the role/class
28 my $method_provider = $self->method_provider->meta;
29 return +{
30 map {
01839bb8 31 $_->name => $_
32 } $method_provider->_get_local_methods
e3c07b19 33 };
34 },
35);
36
a65d8455 37# methods called prior to instantiation
e3c07b19 38
2edb73d9 39before '_process_options' => sub {
40 my ( $self, $name, $options ) = @_;
e3c07b19 41
2edb73d9 42 $self->_check_helper_type( $options, $name );
e3c07b19 43
2edb73d9 44 $options->{is} = $self->_default_is
45 if ! exists $options->{is} && $self->can('_default_is');
e3c07b19 46
2edb73d9 47 $options->{default} = $self->_default_default
48 if ! exists $options->{default} && $self->can('_default_default');
49};
e3c07b19 50
2edb73d9 51sub _check_helper_type {
52 my ( $self, $options, $name ) = @_;
e3c07b19 53
2e069f5a 54 my $type = $self->_helper_type;
2edb73d9 55
2e069f5a 56 $options->{isa} = $type
2edb73d9 57 unless exists $options->{isa};
58
59 my $isa = Moose::Util::TypeConstraints::find_or_create_type_constraint(
60 $options->{isa} );
61
62 ( $isa->is_a_type_of($type) )
63 || confess
64 "The type constraint for $name must be a subtype of $type but it's a $isa";
65}
e3c07b19 66
5404f169 67around '_canonicalize_handles' => sub {
68 my $next = shift;
69 my $self = shift;
70 my $handles = $self->handles;
046c8b5e 71
5404f169 72 return unless $handles;
046c8b5e 73
74 unless ( 'HASH' eq ref $handles ) {
5404f169 75 $self->throw_error(
046c8b5e 76 "The 'handles' option must be a HASH reference, not $handles" );
5404f169 77 }
046c8b5e 78
5404f169 79 return map {
80 my $to = $handles->{$_};
046c8b5e 81 $to = [$to] unless ref $to;
5404f169 82 $_ => $to
83 } keys %$handles;
84};
85
a65d8455 86# methods called after instantiation
e3c07b19 87
2edb73d9 88before 'install_accessors' => sub { (shift)->_check_handles_values };
5404f169 89
2edb73d9 90sub _check_handles_values {
e3c07b19 91 my $self = shift;
92
93 my $method_constructors = $self->method_constructors;
94
5404f169 95 my %handles = $self->_canonicalize_handles;
e3c07b19 96
046c8b5e 97 for my $original_method ( values %handles ) {
5404f169 98 my $name = $original_method->[0];
046c8b5e 99 ( exists $method_constructors->{$name} )
5404f169 100 || confess "$name is an unsupported method type";
e3c07b19 101 }
e3c07b19 102
5404f169 103}
e3c07b19 104
18281451 105around '_make_delegation_method' => sub {
106 my $next = shift;
046c8b5e 107 my ( $self, $handle_name, $method_to_call ) = @_;
18281451 108
3c573ca4 109 my ( $name, @curried_args ) = @$method_to_call;
18281451 110
111 my $method_constructors = $self->method_constructors;
112
113 my $code = $method_constructors->{$name}->(
114 $self,
115 $self->get_read_method_ref,
116 $self->get_write_method_ref,
117 );
118
119 return $next->(
120 $self,
121 $handle_name,
122 sub {
123 my $instance = shift;
3c573ca4 124 return $code->( $instance, @curried_args, @_ );
18281451 125 },
126 );
127};
128
e3c07b19 129no Moose::Role;
130no Moose::Util::TypeConstraints;
131
1321;
133
134__END__
135
136=head1 NAME
137
2420461c 138Moose::Meta::Attribute::Native::Trait - Base role for helpers
e3c07b19 139
e3c07b19 140=head1 BUGS
141
d4048ef3 142See L<Moose/BUGS> for details on reporting bugs.
e3c07b19 143
1af5d116 144=head1 SEE ALSO
145
146Documentation for Moose native traits starts at L<Moose::Meta::Attribute Native>
147
e3c07b19 148=head1 AUTHORS
149
150Yuval Kogman
151
152Shawn M Moore
153
154Jesse Luehrs
155
156=head1 COPYRIGHT AND LICENSE
157
158Copyright 2007-2009 by Infinity Interactive, Inc.
159
160L<http://www.iinteractive.com>
161
162This library is free software; you can redistribute it and/or modify
163it under the same terms as Perl itself.
164
165=cut