2 package MooseX::AttributeHelpers::Base;
4 use Moose::Util::TypeConstraints;
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 # these next two are the possible methods
20 # you can use in the 'provides' map.
22 # provide a Class or Role which we can
23 # collect the method providers from
24 has 'method_provider' => (
27 predicate => 'has_method_provider',
30 # or you can provide a HASH ref of anon subs
31 # yourself. This will also collect and store
32 # the methods from a method_provider as well
33 has 'method_constructors' => (
39 return +{} unless $self->has_method_provider;
40 # or grab them from the role/class
41 my $method_provider = $self->method_provider->meta;
44 $_ => $method_provider->get_method($_)
45 } $method_provider->get_method_list
50 # extend the parents stuff to make sure
51 # certain bits are now required ...
52 has '+$!default' => (required => 1);
53 has '+type_constraint' => (required => 1);
55 ## Methods called prior to instantiation
57 # (overridden by Sugar or plain subclasses)
59 sub default_options {}
62 sub process_options_for_provides {
63 my ($self, $options) = @_;
65 if (my $defaults = $self->default_options) {
66 foreach my $key (keys %$defaults) {
67 $options->{$key} = $defaults->{$key}
68 unless exists $options->{$key};
72 if (my $type = $self->helper_type) {
73 $options->{isa} = $type unless exists $options->{isa};
75 my $isa = $options->{isa};
77 unless (blessed($isa) && $isa->isa('Moose::Meta::TypeConstraint')) {
78 $isa = Moose::Util::TypeConstraints::find_or_create_type_constraint($isa);
81 ($isa->is_a_type_of($type))
82 || confess "The type constraint for a $type ($options->{isa}) must be a subtype of $type";
86 before '_process_options' => sub {
87 my ($self, $name, $options) = @_;
88 $self->process_options_for_provides($options, $name);
91 ## methods called after instantiation
93 # this confirms that provides has
94 # all valid possibilities in it
95 sub check_provides_values {
98 my $method_constructors = $self->method_constructors;
100 foreach my $key (keys %{$self->provides}) {
101 (exists $method_constructors->{$key})
102 || confess "$key is an unsupported method type";
105 my $provides = $self->provides;
106 if (keys %$provides == 0 and $self->auto_provide) {
107 my $attr_name = $self->name;
109 foreach my $method (keys %$method_constructors) {
110 $provides->{$method} = "${method}_${attr_name}";
115 after 'install_accessors' => sub {
117 my $class = $attr->associated_class;
119 # grab the reader and writer methods
120 # as well, this will be useful for
121 # our method provider constructors
122 my $attr_reader = $attr->get_read_method_ref;
123 my $attr_writer = $attr->get_write_method_ref;
126 # before we install them, lets
127 # make sure they are valid
128 $attr->check_provides_values;
130 my $method_constructors = $attr->method_constructors;
132 foreach my $key (keys %{$attr->provides}) {
134 my $method_name = $attr->provides->{$key};
136 if ($class->has_method($method_name)) {
137 confess "The method ($method_name) already exists in class (" . $class->name . ")";
140 my $method = MooseX::AttributeHelpers::Meta::Method::Provided->wrap(
141 $method_constructors->{$key}->(
148 $attr->associate_method($method);
149 $class->add_method($method_name => $method);
153 after 'remove_accessors' => sub {
155 my $class = $attr->associated_class;
156 foreach my $key (keys %{$attr->provides}) {
157 my $method_name = $attr->provides->{$key};
158 my $method = $class->get_method($method_name);
159 $class->remove_method($method_name)
160 if blessed($method) &&
161 $method->isa('MooseX::AttributeHelpers::Meta::Method::Provided');
166 no Moose::Util::TypeConstraints;
176 MooseX::AttributeHelpers::Base - Base class for attribute helpers
180 This class is what you inherit from when you want to make a new
181 AttributeHelper. Unless you are doing something quite fancy, your needs
182 should be met by L<MooseX::AttributeHelpers::Sugar>, which has a nice, terse
183 syntax and some convenience, but you should still subclass this class.
191 This is the map of metaclass methods to methods that will be installed in your
192 class, e.g. add => 'add_to_number'.
194 =item B<method_provider>
196 The name of a class or role to be used as source material for the above map.
197 In the above example, the method provider's "add" method would be used to
198 construct a method to install into the attribute holder's class.
200 =item B<method_constructors>
202 You can optionally supply a hashref of names to subs instead of a class to be
203 used as method constructors, but by default this is pulled from
208 =head1 EXTENDED ATTRIBUTES
214 C<$!default> is now required.
216 =item B<type_constraint>
218 C<type_constraint> is now required.
228 =item B<auto_provide>
230 If this method returns a true value, all available method constructors will be
231 provided in the format $method_$attribute_name e.g. inc_counter. This is
232 intended to be overridden in subclasses.
234 =item B<default_options>
236 Returns a Maybe[Hashref] of attribution specifications to fill in if they are
237 not overridden by the implementing attribute. This is intended to be
238 overridden in subclasses.
242 This forces all attributes using this metaclass to be a subtype of
243 helper_type. This is intended to be overridden in subclasses.
245 =item B<check_provides_values>
247 =item B<has_method_provider>
249 =item B<install_accessors>
251 =item B<remove_accessors>
253 =item B<process_options_for_provides>
259 All complex software has bugs lurking in it, and this module is no
260 exception. If you find a bug please either email me, or add the bug
265 Stevan Little E<lt>stevan@iinteractive.comE<gt>
267 =head1 COPYRIGHT AND LICENSE
269 Copyright 2007-2008 by Infinity Interactive, Inc.
271 L<http://www.iinteractive.com>
273 This library is free software; you can redistribute it and/or modify
274 it under the same terms as Perl itself.