use Scalar::Util 'blessed', 'weaken';
use overload ();
-our $VERSION = '0.60';
+our $VERSION = '0.66';
our $AUTHORITY = 'cpan:STEVAN';
use Moose::Meta::Method::Accessor;
my @traits;
if (my $traits = $options{traits}) {
- if ( @traits = grep { not $class->does($_) } map {
- Moose::Util::resolve_metatrait_alias( Attribute => $_ )
- or
- $_
- } @$traits ) {
+ my $i = 0;
+ while ($i < @$traits) {
+ my $trait = $traits->[$i++];
+ next if ref($trait); # options to a trait we discarded
+
+ $trait = Moose::Util::resolve_metatrait_alias(Attribute => $trait)
+ || $trait;
+
+ next if $class->does($trait);
+
+ push @traits, $trait;
+
+ # are there options?
+ push @traits, $traits->[$i++]
+ if $traits->[$i] && ref($traits->[$i]);
+ }
+
+ if (@traits) {
my $anon_class = Moose::Meta::Class->create_anon_class(
superclasses => [ $class ],
roles => [ @traits ],
default coerce required
documentation lazy handles
builder type_constraint
+ definition_context
);
sub legal_options_for_inheritance { @legal_options_for_inheritance }
if ($self->should_coerce && $type_constraint->has_coercion) {
$val = $type_constraint->coerce($val);
}
- $type_constraint->check($val)
- || $self->throw_error("Attribute ("
- . $self->name
- . ") does not pass the type constraint because: "
- . $type_constraint->get_message($val), data => $val, object => $instance);
+ $self->verify_against_type_constraint($val, instance => $instance);
}
$self->set_initial_value($instance, $val);
if ($type_constraint) {
$val = $type_constraint->coerce($val)
if $can_coerce;
- $type_constraint->check($val)
- || $self->throw_error("Attribute ("
- . $slot_name
- . ") does not pass the type constraint because: "
- . $type_constraint->get_message($val), data => $val, object => $instance);
+ $self->verify_against_type_constraint($val, object => $instance);
}
$meta_instance->set_slot_value($instance, $slot_name, $val);
};
my $type_constraint = $self->type_constraint;
$value = $type_constraint->coerce($value)
if ($self->should_coerce);
- $type_constraint->check($value)
- || $self->throw_error("Attribute (" . $self->name
- . ") does not pass the type constraint because: "
- . $type_constraint->get_message($value), type_constraint => $type_constraint, data => $value);
+ $self->verify_against_type_constraint($value);
}
$self->set_initial_value($instance, $value);
}
return;
}
+sub remove_accessors {
+ my $self = shift;
+ $self->SUPER::remove_accessors(@_);
+ $self->remove_delegation if $self->has_handles;
+ return;
+}
+
sub install_delegation {
my $self = shift;
}
}
+sub remove_delegation {
+ my $self = shift;
+ my %handles = $self->_canonicalize_handles;
+ my $associated_class = $self->associated_class;
+ foreach my $handle (keys %handles) {
+ $self->associated_class->remove_method($handle);
+ }
+}
+
# private methods to help delegation ...
sub _canonicalize_handles {
}
elsif ($handle_type eq 'Regexp') {
($self->has_type_constraint)
- || $self->throw_error("Cannot delegate methods based on a RegExpr without a type constraint (isa)", data => $handles);
+ || $self->throw_error("Cannot delegate methods based on a Regexp without a type constraint (isa)", data => $handles);
return map { ($_ => $_) }
grep { /$handles/ } $self->_get_delegate_method_list;
}
}
}
+sub delegation_metaclass { 'Moose::Meta::Method::Delegation' }
+
sub _make_delegation_method {
my ( $self, $handle_name, $method_to_call ) = @_;
$method_body = $method_to_call
if 'CODE' eq ref($method_to_call);
- return Moose::Meta::Method::Delegation->new(
+ return $self->delegation_metaclass->new(
name => $handle_name,
package_name => $self->associated_class->name,
attribute => $self,
);
}
+sub verify_against_type_constraint {
+ my $self = shift;
+ my $val = shift;
+
+ return 1 if !$self->has_type_constraint;
+
+ my $type_constraint = $self->type_constraint;
+
+ $type_constraint->check($val)
+ || $self->throw_error("Attribute ("
+ . $self->name
+ . ") does not pass the type constraint because: "
+ . $type_constraint->get_message($val), data => $val, @_);
+}
+
package Moose::Meta::Attribute::Custom::Moose;
sub register_implementation { 'Moose::Meta::Attribute' }
=item B<install_accessors>
+=item B<remove_accessors>
+
=item B<install_delegation>
+=item B<remove_delegation>
+
=item B<accessor_metaclass>
+=item B<delegation_metaclass>
+
=item B<get_value>
=item B<set_value>
more information on what you can do with this, see the documentation
for L<Moose::Meta::TypeConstraint>.
+=item B<verify_against_type_constraint>
+
+Verifies that the given value is valid under this attribute's type
+constraint, otherwise throws an error.
+
=item B<has_handles>
Returns true if this meta-attribute performs delegation.
=head1 COPYRIGHT AND LICENSE
-Copyright 2006-2008 by Infinity Interactive, Inc.
+Copyright 2006-2009 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>