Commit | Line | Data |
1b45ecc4 |
1 | package MooseX::AttributeHelpers::MethodProvider; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
17dcc9c9 |
6 | our $VERSION = '0.01'; |
7 | our $AUTHORITY = 'cpan:STEVAN'; |
8 | |
1b45ecc4 |
9 | use Carp qw(confess); |
10 | use Exporter qw(import); |
11 | our @EXPORT = qw(get_provider_methods add_method_provider get_provider_type); |
12 | |
13 | our $VERSION = '0.01'; |
14 | our $AUTHORITY = 'cpan:STEVAN'; |
15 | |
16 | my %REGISTRY; |
17 | |
18 | sub get_provider_type { |
19 | my $name = shift; |
20 | return $REGISTRY{$name}->{type} || confess "No provider named $name"; |
21 | } |
22 | |
23 | sub get_provider_methods { |
24 | my ($name, $how) = @_; |
25 | $how ||= q(); |
26 | |
27 | my $methods = $REGISTRY{$name}->{provides} |
28 | || confess "No provider named $name"; |
29 | |
30 | if ($how eq ':all') { |
31 | return $methods; |
32 | } |
33 | |
34 | if (ref $how eq 'ARRAY') { |
35 | return { |
36 | map { |
37 | $_ => $methods->{$_} || confess "No factory named $_" |
38 | } (@$how) |
39 | }; |
40 | } |
41 | |
42 | if (ref $how eq 'HASH') { |
43 | return { |
44 | map { |
45 | my ($old, $new) = ($_, $how->{$_}); |
46 | $new => $methods->{$old} || confess "No factory named $old" |
47 | } (keys %$how) |
48 | }; |
49 | } |
50 | |
51 | confess "Don't know to get provider methods by $how"; |
52 | } |
53 | |
54 | sub add_method_provider ($;%) { |
55 | my ($name, %options) = @_; |
56 | |
57 | confess "Already a method provider named $name" |
58 | if exists $REGISTRY{$name}; |
59 | |
60 | my $method_map = $options{provides} or confess "No factories provided"; |
61 | |
62 | my $consumes = $options{consumes}; |
63 | foreach my $provider (keys %$consumes) { |
64 | my $methods = get_provider_methods($provider, $consumes->{$provider}); |
65 | foreach (keys %$methods) { |
66 | confess "Method $_ already provided" if exists $method_map->{$_}; |
67 | $method_map->{$_} = $methods->{$_}; |
68 | }; |
69 | } |
70 | |
71 | $REGISTRY{$name} = { |
72 | type => $options{type} || 'Any', |
73 | provides => $method_map, |
74 | }; |
75 | } |
76 | |
77 | 1; |
f2b3b8f9 |
78 | |
79 | __END__ |
80 | |
81 | =pod |
82 | |
83 | =head1 NAME |
84 | |
85 | MooseX::AttributeHelpers::MethodProvider |
86 | |
87 | =head1 SYNOPSIS |
88 | |
89 | package MooseX::AttributeHelpers::MethodProvider::Counter; |
90 | use MooseX::AttributeHelpers::MethodProvider; |
91 | |
92 | add_method_provider 'Counter' => ( |
93 | type => 'Int', |
94 | provides => { |
95 | reset => sub { |
96 | my ($attr, $reader, $writer) = @_; |
97 | return sub { $writer->($_[0], $attr->default($_[0])) }; |
98 | }, |
99 | |
100 | inc => sub { |
101 | my ($attr, $reader, $writer) = @_; |
102 | return sub { $writer->($_[0], $reader->($_[0]) + 1) }; |
103 | }, |
104 | |
105 | dec => sub { |
106 | my ($attr, $reader, $writer) = @_; |
107 | return sub { $writer->($_[0], $reader->($_[0]) - 1) }; |
108 | }, |
109 | }, |
110 | ); |
111 | |
112 | 1; |
113 | |
114 | =head1 DESCRIPTION |
115 | |
116 | MethodProvider is the interface for new functionality to be added to |
117 | L<MooseX::AttributeHelpers>. The provided metaclasses get their method |
118 | factories from the repository defined by this package. Composite's methods |
119 | are also drawn from here. The package by itself provides no methods, but |
120 | rather functions for creating new entries in the repository - clients are |
121 | encouraged to define new method providers in individual modules (such as |
122 | L<MooseX::AttributeHelpers::MethodProvider::String>) and L<use|perlfunc/use> |
123 | them as desired. |
124 | |
125 | =head1 METHOD SPECIFICATIONS |
126 | |
127 | In add_method_provider as well as get_provider_methods, you can specify a set |
128 | of providers to extract. This can be one of the following: |
129 | |
130 | =over 4 |
131 | |
132 | =item ':all' |
133 | |
134 | Causes all methods to be extracted. |
135 | |
136 | =item ArrayRef |
137 | |
138 | Causes the methods named in the ArrayRef to be extracted. |
139 | |
140 | =item HashRef |
141 | |
142 | Causes the methods named by the keys of the hashref to be extracted with the |
143 | names specified by their corresponding value, e.g. C<{inc => 'my_inc'}> |
144 | |
145 | =back |
146 | |
147 | =head1 EXPORTED FUNCTIONS |
148 | |
149 | =over 4 |
150 | |
151 | =item add_method_provider |
152 | |
153 | This is how to define a new method provider. It takes one positional argument |
154 | (the name of the MethodProvider) and three keyword arguments: |
155 | |
156 | =over 4 |
157 | |
158 | =item type |
159 | |
160 | A Moose type (such as Maybe[Str]). Validation will be done when applying to |
161 | an attribute to make sure it is this type or a subtype. |
162 | |
163 | =item consumes |
164 | |
165 | A hashref of other method providers (which must be defined, so |
166 | L<use|perlfunc/use> the modules that define them first), of the form |
167 | C<{ProviderName => Specification}>. |
168 | |
169 | =item provides |
170 | |
171 | A hashref of method names to provide to subrefs. The subs take three |
172 | arguments (an attribute, the attribute's reader, and the attribute's writer) |
173 | and return a new sub that does some action to the attribute. |
174 | |
175 | =back |
176 | |
177 | =item get_provider_methods I<provide_name, specification> |
178 | |
179 | Returns the methods for $provider_name as indicated by $specification. |
180 | |
181 | =item get_provider_type |
182 | |
183 | Returns the type of a method provider. |
184 | |
185 | =back |
186 | |
187 | =head1 BUGS |
188 | |
189 | All complex software has bugs lurking in it, and this module is no |
190 | exception. If you find a bug please either email me, or add the bug |
191 | to cpan-RT. |
192 | |
193 | =head1 AUTHOR |
194 | |
195 | Paul Driver E<lt>frodwith@cpan.orgE<gt> |
196 | |
197 | =cut |