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