Added version and authority info to a couple of files.
[gitmo/MooseX-AttributeHelpers.git] / lib / MooseX / AttributeHelpers / MethodProvider.pm
CommitLineData
1b45ecc4 1package MooseX::AttributeHelpers::MethodProvider;
2
3use strict;
4use warnings;
5
17dcc9c9 6our $VERSION = '0.01';
7our $AUTHORITY = 'cpan:STEVAN';
8
1b45ecc4 9use Carp qw(confess);
10use Exporter qw(import);
11our @EXPORT = qw(get_provider_methods add_method_provider get_provider_type);
12
13our $VERSION = '0.01';
14our $AUTHORITY = 'cpan:STEVAN';
15
16my %REGISTRY;
17
18sub get_provider_type {
19 my $name = shift;
20 return $REGISTRY{$name}->{type} || confess "No provider named $name";
21}
22
23sub 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
54sub 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
771;
f2b3b8f9 78
79__END__
80
81=pod
82
83=head1 NAME
84
85MooseX::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
116MethodProvider is the interface for new functionality to be added to
117L<MooseX::AttributeHelpers>. The provided metaclasses get their method
118factories from the repository defined by this package. Composite's methods
119are also drawn from here. The package by itself provides no methods, but
120rather functions for creating new entries in the repository - clients are
121encouraged to define new method providers in individual modules (such as
122L<MooseX::AttributeHelpers::MethodProvider::String>) and L<use|perlfunc/use>
123them as desired.
124
125=head1 METHOD SPECIFICATIONS
126
127In add_method_provider as well as get_provider_methods, you can specify a set
128of providers to extract. This can be one of the following:
129
130=over 4
131
132=item ':all'
133
134Causes all methods to be extracted.
135
136=item ArrayRef
137
138Causes the methods named in the ArrayRef to be extracted.
139
140=item HashRef
141
142Causes the methods named by the keys of the hashref to be extracted with the
143names specified by their corresponding value, e.g. C<{inc =&gt; 'my_inc'}>
144
145=back
146
147=head1 EXPORTED FUNCTIONS
148
149=over 4
150
151=item add_method_provider
152
153This 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
160A Moose type (such as Maybe[Str]). Validation will be done when applying to
161an attribute to make sure it is this type or a subtype.
162
163=item consumes
164
165A hashref of other method providers (which must be defined, so
166L<use|perlfunc/use> the modules that define them first), of the form
167C<{ProviderName =&gt; Specification}>.
168
169=item provides
170
171A hashref of method names to provide to subrefs. The subs take three
172arguments (an attribute, the attribute's reader, and the attribute's writer)
173and 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
179Returns the methods for $provider_name as indicated by $specification.
180
181=item get_provider_type
182
183Returns the type of a method provider.
184
185=back
186
187=head1 BUGS
188
189All complex software has bugs lurking in it, and this module is no
190exception. If you find a bug please either email me, or add the bug
191to cpan-RT.
192
193=head1 AUTHOR
194
195Paul Driver E<lt>frodwith@cpan.orgE<gt>
196
197=cut