perltidy all the AttributeHelpers code
[gitmo/Moose.git] / lib / Moose / AttributeHelpers / Trait / Base.pm
CommitLineData
e3c07b19 1
2package Moose::AttributeHelpers::Trait::Base;
3use Moose::Role;
4use Moose::Util::TypeConstraints;
5
37b7c240 6our $VERSION = '0.84';
e3c07b19 7$VERSION = eval $VERSION;
8our $AUTHORITY = 'cpan:STEVAN';
9
10requires 'helper_type';
11
e3c07b19 12# these next two are the possible methods
d09498fb 13# you can use in the 'handles' map.
e3c07b19 14
15# provide a Class or Role which we can
16# collect the method providers from
17
18# requires_attr 'method_provider'
19
20# or you can provide a HASH ref of anon subs
21# yourself. This will also collect and store
22# the methods from a method_provider as well
23has 'method_constructors' => (
24 is => 'ro',
25 isa => 'HashRef',
26 lazy => 1,
27 default => sub {
28 my $self = shift;
29 return +{} unless $self->has_method_provider;
30 # or grab them from the role/class
31 my $method_provider = $self->method_provider->meta;
32 return +{
33 map {
34 $_ => $method_provider->get_method($_)
35 } $method_provider->get_method_list
36 };
37 },
38);
39
40# extend the parents stuff to make sure
41# certain bits are now required ...
046c8b5e 42has '+default' => ( required => 1 );
43has '+type_constraint' => ( required => 1 );
e3c07b19 44
45## Methods called prior to instantiation
46
d09498fb 47sub process_options_for_handles {
046c8b5e 48 my ( $self, $options ) = @_;
e3c07b19 49
046c8b5e 50 if ( my $type = $self->helper_type ) {
51 ( exists $options->{isa} )
e3c07b19 52 || confess "You must define a type with the $type metaclass";
53
54 my $isa = $options->{isa};
55
046c8b5e 56 unless ( blessed($isa) && $isa->isa('Moose::Meta::TypeConstraint') ) {
57 $isa
58 = Moose::Util::TypeConstraints::find_or_create_type_constraint(
59 $isa);
e3c07b19 60 }
61
046c8b5e 62 ( $isa->is_a_type_of($type) )
63 || confess
64 "The type constraint for a $type ($options->{isa}) must be a subtype of $type";
e3c07b19 65 }
66}
67
68before '_process_options' => sub {
046c8b5e 69 my ( $self, $name, $options ) = @_;
70 $self->process_options_for_handles( $options, $name );
e3c07b19 71};
72
5404f169 73around '_canonicalize_handles' => sub {
74 my $next = shift;
75 my $self = shift;
76 my $handles = $self->handles;
046c8b5e 77
5404f169 78 return unless $handles;
046c8b5e 79
80 unless ( 'HASH' eq ref $handles ) {
5404f169 81 $self->throw_error(
046c8b5e 82 "The 'handles' option must be a HASH reference, not $handles" );
5404f169 83 }
046c8b5e 84
5404f169 85 return map {
86 my $to = $handles->{$_};
046c8b5e 87 $to = [$to] unless ref $to;
5404f169 88 $_ => $to
89 } keys %$handles;
90};
91
e3c07b19 92## methods called after instantiation
93
40ef30a5 94before 'install_accessors' => sub { (shift)->check_handles_values };
5404f169 95
d09498fb 96sub check_handles_values {
e3c07b19 97 my $self = shift;
98
99 my $method_constructors = $self->method_constructors;
100
5404f169 101 my %handles = $self->_canonicalize_handles;
e3c07b19 102
046c8b5e 103 for my $original_method ( values %handles ) {
5404f169 104 my $name = $original_method->[0];
046c8b5e 105 ( exists $method_constructors->{$name} )
5404f169 106 || confess "$name is an unsupported method type";
e3c07b19 107 }
e3c07b19 108
5404f169 109}
e3c07b19 110
18281451 111around '_make_delegation_method' => sub {
112 my $next = shift;
046c8b5e 113 my ( $self, $handle_name, $method_to_call ) = @_;
18281451 114
046c8b5e 115 my ( $name, $curried_args ) = @$method_to_call;
18281451 116
117 $curried_args ||= [];
118
119 my $method_constructors = $self->method_constructors;
120
121 my $code = $method_constructors->{$name}->(
122 $self,
123 $self->get_read_method_ref,
124 $self->get_write_method_ref,
125 );
126
127 return $next->(
128 $self,
129 $handle_name,
130 sub {
131 my $instance = shift;
046c8b5e 132 return $code->( $instance, @$curried_args, @_ );
18281451 133 },
134 );
135};
136
e3c07b19 137no Moose::Role;
138no Moose::Util::TypeConstraints;
139
1401;
141
142__END__
143
144=head1 NAME
145
146Moose::AttributeHelpers::Trait::Base - base role for helpers
147
148=head1 METHODS
149
d09498fb 150=head2 check_handles_values
e3c07b19 151
d09498fb 152Confirms that handles has all valid possibilities in it.
e3c07b19 153
d09498fb 154=head2 process_options_for_handles
e3c07b19 155
156Ensures that the type constraint (C<isa>) matches the helper type.
157
158=head1 BUGS
159
160All complex software has bugs lurking in it, and this module is no
161exception. If you find a bug please either email me, or add the bug
162to cpan-RT.
163
164=head1 AUTHORS
165
166Yuval Kogman
167
168Shawn M Moore
169
170Jesse Luehrs
171
172=head1 COPYRIGHT AND LICENSE
173
174Copyright 2007-2009 by Infinity Interactive, Inc.
175
176L<http://www.iinteractive.com>
177
178This library is free software; you can redistribute it and/or modify
179it under the same terms as Perl itself.
180
181=cut