-
package MooseX::AttributeHelpers::Base;
use Moose;
use Moose::Util::TypeConstraints;
+use MooseX::AttributeHelpers::MethodProvider;
+use MooseX::AttributeHelpers::Meta::Method::Provided;
-our $VERSION = '0.01';
+our $VERSION = '0.04';
our $AUTHORITY = 'cpan:STEVAN';
extends 'Moose::Meta::Attribute';
default => sub {{}}
);
-
-# these next two are the possible methods
-# you can use in the 'provides' map.
-
-# provide a Class or Role which we can
-# collect the method providers from
-has 'method_provider' => (
- is => 'ro',
- isa => 'ClassName',
- predicate => 'has_method_provider',
-);
-
-# or you can provide a HASH ref of anon subs
-# yourself. This will also collect and store
-# the methods from a method_provider as well
-has 'method_constructors' => (
- is => 'ro',
- isa => 'HashRef',
- lazy => 1,
- default => sub {
- my $self = shift;
- return +{} unless $self->has_method_provider;
- # or grab them from the role/class
- my $method_provider = $self->method_provider->meta;
- return +{
- map {
- $_ => $method_provider->get_method($_)
- } $method_provider->get_method_list
- };
- },
-);
-
-# extend the parents stuff to make sure
+# extend the parents stuff to make sure
# certain bits are now required ...
has '+$!default' => (required => 1);
has '+type_constraint' => (required => 1);
## Methods called prior to instantiation
-sub helper_type { () }
+# For overriding
+sub default_options {}
+sub auto_provide {0}
+
+# Do not override both of these things. You will be eaten.
+sub method_provider {}
+sub method_constructors {
+ get_provider_methods($_[0]->method_provider, ':all')
+}
sub process_options_for_provides {
my ($self, $options) = @_;
-
- if (my $type = $self->helper_type) {
- (exists $options->{isa})
- || confess "You must define a type with the $type metaclass";
-
- my $isa = $options->{isa};
- unless (blessed($isa) && $isa->isa('Moose::Meta::TypeConstraint')) {
- $isa = find_type_constraint($isa);
+ if (my $defaults = $self->default_options) {
+ foreach my $key (keys %$defaults) {
+ $options->{$key} = $defaults->{$key}
+ unless exists $options->{$key};
}
+ }
- ($isa->is_a_type_of($type))
- || confess "The type constraint for a $type ($options->{isa}) must be a subtype of $type";
+ return unless $self->method_provider;
+ my $type = get_provider_type($self->method_provider);
+ $options->{isa} = $type unless exists $options->{isa};
+ my $isa = $options->{isa};
+
+ unless (blessed($isa) && $isa->isa('Moose::Meta::TypeConstraint')) {
+ $isa = Moose::Util::TypeConstraints::find_or_create_type_constraint(
+ $isa
+ );
}
+
+ confess "The type constraint for a $type ($options->{isa}) "
+ . "must be a subtype of $type"
+ unless $isa->is_a_type_of($type);
}
before '_process_options' => sub {
my ($self, $name, $options) = @_;
- if (exists $options->{provides} ||
- exists $options->{isa} && $options->{isa} =~ /^.*?\[.*?\]$/) {
- $self->process_options_for_provides($options);
- }
+ $self->process_options_for_provides($options, $name);
};
## methods called after instantiation
-# this confirms that provides has
+# this confirms that provides has
# all valid possibilities in it
sub check_provides_values {
my $self = shift;
-
+
my $method_constructors = $self->method_constructors;
-
+
foreach my $key (keys %{$self->provides}) {
(exists $method_constructors->{$key})
|| confess "$key is an unsupported method type";
}
+
+ my $provides = $self->provides;
+ if (keys %$provides == 0 and $self->auto_provide) {
+ my $attr_name = $self->name;
+
+ foreach my $method (keys %$method_constructors) {
+ $provides->{$method} = "${method}_${attr_name}";
+ }
+ }
}
after 'install_accessors' => sub {
my $attr = shift;
my $class = $attr->associated_class;
+ # grab the reader and writer methods
+ # as well, this will be useful for
+ # our method provider constructors
+ my $attr_reader = $attr->get_read_method_ref;
+ my $attr_writer = $attr->get_write_method_ref;
+
+
# before we install them, lets
# make sure they are valid
- $attr->check_provides_values;
+ $attr->check_provides_values;
my $method_constructors = $attr->method_constructors;
-
+
foreach my $key (keys %{$attr->provides}) {
-
+
my $method_name = $attr->provides->{$key};
- my $method_body = $method_constructors->{$key}->($attr);
-
+
if ($class->has_method($method_name)) {
confess "The method ($method_name) already exists in class (" . $class->name . ")";
}
-
- $class->add_method($method_name =>
- MooseX::AttributeHelpers::Meta::Method::Provided->wrap(
- $method_body,
+
+ my $method = MooseX::AttributeHelpers::Meta::Method::Provided->wrap(
+ $method_constructors->{$key}->(
+ $attr,
+ $attr_reader,
+ $attr_writer,
)
);
+
+ $attr->associate_method($method);
+ $class->add_method($method_name => $method);
}
};
+after 'remove_accessors' => sub {
+ my $attr = shift;
+ my $class = $attr->associated_class;
+ foreach my $key (keys %{$attr->provides}) {
+ my $method_name = $attr->provides->{$key};
+ my $method = $class->get_method($method_name);
+ $class->remove_method($method_name)
+ if blessed($method) &&
+ $method->isa('MooseX::AttributeHelpers::Meta::Method::Provided');
+ }
+};
+
+sub sugar {
+ my ($class, %info) = @_;
+ my $meta = $class->meta;
+
+ $meta->add_method('default_options', sub {$info{default_options}});
+ $meta->add_method('auto_provide', sub {$info{auto_provide} || 0});
+
+ my $provider = $info{method_provider};
+ my $constructors = $info{method_constructors};
+
+ confess "Supply either method_provider or method_constructors"
+ if ($provider && $constructors) || !($provider || $constructors);
+
+ if(my $provider = $info{method_provider}) {
+ $meta->add_method('method_provider' => sub { $provider });
+ }
+ elsif (my $cons = $info{method_constructors}) {
+ $meta->add_method('method_constructors' => sub { $cons });
+ }
+
+ if (my $s = $info{shortcut}) {
+ $meta->create("Moose::Meta::Attribute::Custom::$s",
+ methods => {register_implementation => sub { $class }},
+ );
+ }
+}
+
no Moose;
no Moose::Util::TypeConstraints;
=head1 NAME
-MooseX::AttributeHelpers::Base
+MooseX::AttributeHelpers::Base - Base class for attribute helpers
+
+SYNOPSIS
+
+ package MooseX::AttributeHelpers::Counter;
+ use Moose;
+ use MooseX::AttributeHelpers::MethodProvider::Counter;
+
+ extends 'MooseX::AttributeHelpers::Base';
+
+ __PACKAGE__->sugar(
+ default_options => {
+ is => 'ro',
+ default => 0,
+ },
+
+ auto_provide => 1,
+ method_provider => 'Counter',
+ shortcut => 'Counter',
+ );
+
+ no Moose;
+
+ 1;
-=head1 SYNOPSIS
-
=head1 DESCRIPTION
-Base class for attribute helpers.
+This class is what you inherit from when you want to make a new
+AttributeHelper metaclass. Most of the work is done for you by the class
+method I<sugar> if you're doing something basic.
=head1 ATTRIBUTES
-=head2 provides
+=over 4
+
+=item B<provides>
-=head2 method_provider
+This is the map of metaclass methods to methods that will be installed in your
+class, e.g. add => 'add_to_number'.
-=head2 method_constructors
+=back
=head1 EXTENDED ATTRIBUTES
-=head2 $!default
+=over 4
+
+=item B<$!default>
C<$!default> is now required.
-=head2 type_constraint
+=item B<type_constraint>
C<type_constraint> is now required.
+=back
+
=head1 METHODS
-=head2 helper_type
+=over 4
+
+=item B<method_provider>
+
+The name of a method provider. Usually one L<use|perlfunc/use>s a package
+that defines a method provider in the registry first, but you can just as well
+define one in your own code. See L<MooseX::AttributeHelpers::MethodProvider>
+for details.
+
+=item B<method_constructors>
+
+You can optionally supply a hashref of names to subs instead of a class to be
+used as method constructors. In that case, your methods won't be available
+for use by L<Composite|MooseX::AttributeHelpers::Composite>.
+
+=item B<auto_provide>
+
+If this method returns a true value, all available method constructors will be
+provided in the format $method_$attribute_name e.g. inc_counter. This is
+intended to be overridden in subclasses.
+
+=item B<default_options>
+
+Returns a Maybe[Hashref] of attribution specifications to fill in if they are
+not overridden by the implementing attribute. This is intended to be
+overridden in subclasses.
+
+=item B<sugar>
+
+A convenience method for subclassing declaratively. See L<"SYNOPSIS"> for an
+example. The shortcut option creates a package under
+Moose::Meta::Attribute::Custom to make it easier for users to find your
+metaclass, but you can do this manually if you desire.
+
+=item B<check_provides_values>
+
+=item B<install_accessors>
+
+=item B<remove_accessors>
+
+=item B<process_options_for_provides>
+
+These are hooks you can use to change the behavior of the metaclass; read the
+source for inspiration.
+
+=back
=head1 BUGS
-All complex software has bugs lurking in it, and this module is no
+All complex software has bugs lurking in it, and this module is no
exception. If you find a bug please either email me, or add the bug
to cpan-RT.
=head1 COPYRIGHT AND LICENSE
-Copyright 2007 by Infinity Interactive, Inc.
+Copyright 2007-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
projects / gitmo/MooseX-AttributeHelpers.git / blobdiff