lib/MooseX/AttributeHelpers/MethodProvider.pm

   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;
  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 =&gt; '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 =&gt; 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