lib/MooseX/AttributeHelpers/MethodProvider.pm

   1 package MooseX::AttributeHelpers::MethodProvider;
   2
   3 use strict;
   4 use warnings;
   5
   6 our $VERSION   = '0.01';
   7 our $AUTHORITY = 'cpan:STEVAN';
   8
   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;
  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 =&gt; '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 =&gt; 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