use Moose::Role;
use Moose::Util::TypeConstraints;
-our $VERSION = '0.19';
+our $VERSION = '0.84';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
# extend the parents stuff to make sure
# certain bits are now required ...
-has '+default' => (required => 1);
-has '+type_constraint' => (required => 1);
+has '+default' => ( required => 1 );
+has '+type_constraint' => ( required => 1 );
## Methods called prior to instantiation
sub process_options_for_handles {
- my ($self, $options) = @_;
+ my ( $self, $options ) = @_;
- if (my $type = $self->helper_type) {
- (exists $options->{isa})
+ 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 = Moose::Util::TypeConstraints::find_or_create_type_constraint($isa);
+ unless ( blessed($isa) && $isa->isa('Moose::Meta::TypeConstraint') ) {
+ $isa
+ = Moose::Util::TypeConstraints::find_or_create_type_constraint(
+ $isa);
}
- ($isa->is_a_type_of($type))
- || confess "The type constraint for a $type ($options->{isa}) must be a subtype of $type";
+ ( $isa->is_a_type_of($type) )
+ || confess
+ "The type constraint for a $type ($options->{isa}) must be a subtype of $type";
}
}
before '_process_options' => sub {
- my ($self, $name, $options) = @_;
- $self->process_options_for_handles($options, $name);
+ my ( $self, $name, $options ) = @_;
+ $self->process_options_for_handles( $options, $name );
+};
+
+around '_canonicalize_handles' => sub {
+ my $next = shift;
+ my $self = shift;
+ my $handles = $self->handles;
+
+ return unless $handles;
+
+ unless ( 'HASH' eq ref $handles ) {
+ $self->throw_error(
+ "The 'handles' option must be a HASH reference, not $handles" );
+ }
+
+ return map {
+ my $to = $handles->{$_};
+ $to = [$to] unless ref $to;
+ $_ => $to
+ } keys %$handles;
};
## methods called after instantiation
+before 'install_accessors' => sub { (shift)->check_handles_values };
+
sub check_handles_values {
my $self = shift;
my $method_constructors = $self->method_constructors;
- foreach my $key (keys %{$self->handles}) {
- (exists $method_constructors->{$key})
- || confess "$key is an unsupported method type";
+ my %handles = $self->_canonicalize_handles;
+
+ for my $original_method ( values %handles ) {
+ my $name = $original_method->[0];
+ ( exists $method_constructors->{$name} )
+ || confess "$name is an unsupported method type";
}
}
-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;
+around '_make_delegation_method' => sub {
+ my $next = shift;
+ my ( $self, $handle_name, $method_to_call ) = @_;
- # before we install them, lets
- # make sure they are valid
- $attr->check_handles_values;
+ my ( $name, $curried_args ) = @$method_to_call;
- my $method_constructors = $attr->method_constructors;
+ $curried_args ||= [];
- my $class_name = $class->name;
-
- foreach my $key (keys %{$attr->handles}) {
-
- my $method_name = $attr->handles->{$key};
-
- if ($class->has_method($method_name)) {
- confess "The method ($method_name) already exists in class (" . $class->name . ")";
- }
-
- my $method = Moose::AttributeHelpers::Meta::Method::Provided->wrap(
- $method_constructors->{$key}->(
- $attr,
- $attr_reader,
- $attr_writer,
- ),
- package_name => $class_name,
- name => $method_name,
- );
-
- $attr->associate_method($method);
- $class->add_method($method_name => $method);
- }
-};
+ my $method_constructors = $self->method_constructors;
-after 'remove_accessors' => sub {
- my $attr = shift;
- my $class = $attr->associated_class;
-
- # provides accessors
- foreach my $key (keys %{$attr->handles}) {
- my $method_name = $attr->handles->{$key};
- my $method = $class->get_method($method_name);
- $class->remove_method($method_name)
- if blessed($method) &&
- $method->isa('Moose::AttributeHelpers::Meta::Method::Provided');
- }
+ my $code = $method_constructors->{$name}->(
+ $self,
+ $self->get_read_method_ref,
+ $self->get_write_method_ref,
+ );
+
+ return $next->(
+ $self,
+ $handle_name,
+ sub {
+ my $instance = shift;
+ return $code->( $instance, @$curried_args, @_ );
+ },
+ );
};
no Moose::Role;