1 package MooseX::AttributeHelpers::Base;
3 use Moose::Util::TypeConstraints;
4 use MooseX::AttributeHelpers::MethodProvider;
5 use MooseX::AttributeHelpers::Meta::Method::Provided;
8 our $AUTHORITY = 'cpan:STEVAN';
10 extends 'Moose::Meta::Attribute';
12 # this is the method map you define ...
19 # extend the parents stuff to make sure
20 # certain bits are now required ...
21 has '+$!default' => (required => 1);
22 has '+type_constraint' => (required => 1);
24 ## Methods called prior to instantiation
27 sub default_options {}
30 # Do not override both of these things. You will be eaten.
31 sub method_provider {}
32 sub method_constructors {
33 get_provider_methods($_[0]->method_provider, ':all')
36 sub process_options_for_provides {
37 my ($self, $options) = @_;
39 if (my $defaults = $self->default_options) {
40 foreach my $key (keys %$defaults) {
41 $options->{$key} = $defaults->{$key}
42 unless exists $options->{$key};
46 return unless $self->method_provider;
47 my $type = get_provider_type($self->method_provider);
48 $options->{isa} = $type unless exists $options->{isa};
49 my $isa = $options->{isa};
51 unless (blessed($isa) && $isa->isa('Moose::Meta::TypeConstraint')) {
52 $isa = Moose::Util::TypeConstraints::find_or_create_type_constraint(
57 confess "The type constraint for a $type ($options->{isa}) "
58 . "must be a subtype of $type"
59 unless $isa->is_a_type_of($type);
62 before '_process_options' => sub {
63 my ($self, $name, $options) = @_;
64 $self->process_options_for_provides($options, $name);
67 ## methods called after instantiation
69 # this confirms that provides has
70 # all valid possibilities in it
71 sub check_provides_values {
74 my $method_constructors = $self->method_constructors;
76 foreach my $key (keys %{$self->provides}) {
77 (exists $method_constructors->{$key})
78 || confess "$key is an unsupported method type";
81 my $provides = $self->provides;
82 if (keys %$provides == 0 and $self->auto_provide) {
83 my $attr_name = $self->name;
85 foreach my $method (keys %$method_constructors) {
86 $provides->{$method} = "${method}_${attr_name}";
91 after 'install_accessors' => sub {
93 my $class = $attr->associated_class;
95 # grab the reader and writer methods
96 # as well, this will be useful for
97 # our method provider constructors
98 my $attr_reader = $attr->get_read_method_ref;
99 my $attr_writer = $attr->get_write_method_ref;
102 # before we install them, lets
103 # make sure they are valid
104 $attr->check_provides_values;
106 my $method_constructors = $attr->method_constructors;
108 foreach my $key (keys %{$attr->provides}) {
110 my $method_name = $attr->provides->{$key};
112 if ($class->has_method($method_name)) {
113 confess "The method ($method_name) already exists in class (" . $class->name . ")";
116 my $method = MooseX::AttributeHelpers::Meta::Method::Provided->wrap(
117 $method_constructors->{$key}->(
124 $attr->associate_method($method);
125 $class->add_method($method_name => $method);
129 after 'remove_accessors' => sub {
131 my $class = $attr->associated_class;
132 foreach my $key (keys %{$attr->provides}) {
133 my $method_name = $attr->provides->{$key};
134 my $method = $class->get_method($method_name);
135 $class->remove_method($method_name)
136 if blessed($method) &&
137 $method->isa('MooseX::AttributeHelpers::Meta::Method::Provided');
142 my ($class, %info) = @_;
143 my $meta = $class->meta;
145 $meta->add_method('default_options', sub {$info{default_options}});
146 $meta->add_method('auto_provide', sub {$info{auto_provide} || 0});
148 my $provider = $info{method_provider};
149 my $constructors = $info{method_constructors};
151 confess "Supply either method_provider or method_constructors"
152 if ($provider && $constructors) || !($provider || $constructors);
154 if(my $provider = $info{method_provider}) {
155 $meta->add_method('method_provider' => sub { $provider });
157 elsif (my $cons = $info{method_constructors}) {
158 $meta->add_method('method_constructors' => sub { $cons });
161 if (my $s = $info{shortcut}) {
162 $meta->create("Moose::Meta::Attribute::Custom::$s",
163 methods => {register_implementation => sub { $class }},
169 no Moose::Util::TypeConstraints;
179 MooseX::AttributeHelpers::Base - Base class for attribute helpers
183 package MooseX::AttributeHelpers::Counter;
185 use MooseX::AttributeHelpers::MethodProvider::Counter;
187 extends 'MooseX::AttributeHelpers::Base';
196 method_provider => 'Counter',
197 shortcut => 'Counter',
206 This class is what you inherit from when you want to make a new
207 AttributeHelper metaclass. Most of the work is done for you by the class
208 method I<sugar> if you're doing something basic.
216 This is the map of metaclass methods to methods that will be installed in your
217 class, e.g. add => 'add_to_number'.
221 =head1 EXTENDED ATTRIBUTES
227 C<$!default> is now required.
229 =item B<type_constraint>
231 C<type_constraint> is now required.
239 =item B<method_provider>
241 The name of a method provider. Usually one L<use|perlfunc/use>s a package
242 that defines a method provider in the registry first, but you can just as well
243 define one in your own code. See L<MooseX::AttributeHelpers::MethodProvider>
246 =item B<method_constructors>
248 You can optionally supply a hashref of names to subs instead of a class to be
249 used as method constructors. In that case, your methods won't be available
250 for use by L<Composite|MooseX::AttributeHelpers::Composite>.
252 =item B<auto_provide>
254 If this method returns a true value, all available method constructors will be
255 provided in the format $method_$attribute_name e.g. inc_counter. This is
256 intended to be overridden in subclasses.
258 =item B<default_options>
260 Returns a Maybe[Hashref] of attribution specifications to fill in if they are
261 not overridden by the implementing attribute. This is intended to be
262 overridden in subclasses.
266 A convenience method for subclassing declaratively. See L<"SYNOPSIS"> for an
267 example. The shortcut option creates a package under
268 Moose::Meta::Attribute::Custom to make it easier for users to find your
269 metaclass, but you can do this manually if you desire.
271 =item B<check_provides_values>
273 =item B<install_accessors>
275 =item B<remove_accessors>
277 =item B<process_options_for_provides>
279 These are hooks you can use to change the behavior of the metaclass; read the
280 source for inspiration.
286 All complex software has bugs lurking in it, and this module is no
287 exception. If you find a bug please either email me, or add the bug
292 Stevan Little E<lt>stevan@iinteractive.comE<gt>
294 =head1 COPYRIGHT AND LICENSE
296 Copyright 2007-2008 by Infinity Interactive, Inc.
298 L<http://www.iinteractive.com>
300 This library is free software; you can redistribute it and/or modify
301 it under the same terms as Perl itself.