use Carp 'confess';
use overload ();
-our $VERSION = '0.55';
+our $VERSION = '0.57';
our $AUTHORITY = 'cpan:STEVAN';
use Moose::Meta::Method::Accessor;
}
if (exists $options->{trigger}) {
- my $trig = $options->{trigger};
- if ('HASH' eq ref $trig) {
- my $legal = qr{^(?:before|after|around)$};
- foreach my $key (keys %$trig) {
- ($key =~ $legal)
- || confess "$key is an illegal trigger specifier"
- . " on attribute ($name)";
- ('CODE' eq ref $trig->{$key})
- || confess "$key trigger must be CODE ref"
- . " on attribute ($name)";
- }
- }
- elsif ('CODE' ne ref $trig) {
- confess "Trigger must be a CODE or HASH ref on attribute ($name)";
- }
+ ('CODE' eq ref $options->{trigger})
+ || confess "Trigger must be a CODE ref on attribute ($name)";
}
if (exists $options->{auto_deref} && $options->{auto_deref}) {
}
-sub _with_inline_triggers {
- my ($self, $instance, $value, $attr, $gen_code) = @_;
- my @ga = ($instance, $value, $attr);
- return $gen_code->(@ga) unless $self->has_trigger;
-
- my $trigger_args = "$instance, $value, $attr";
-
- if ('CODE' eq ref $self->trigger) {
- return $gen_code->(@ga) . "$attr->trigger->($trigger_args);\n";
- }
-
- my $code = '';
- my ($before, $around, $after) = @{$self->trigger}{qw(before around after)};
-
- if ($before) {
- $code .= "$attr->trigger->{before}->($trigger_args);\n";
- }
-
- if ($around) {
- $code .= "$attr->trigger->{around}->(sub {\n"
- . 'my ($instance, $value, $attr) = @_;' . "\n"
- . $gen_code->('$instance', '$value', '$attr')
- . "}, $trigger_args);\n";
- }
- else {
- $code .= $gen_code->(@ga);
- }
-
- if ($after) {
- $code .= "$attr->trigger->{after}->($trigger_args);\n";
- }
-
- return $code;
-}
-
-sub _with_triggers {
- my ($self, $instance, $value, $fn) = @_;
- my @trigger_args = ($instance, $value, $self);
- my ($before, $around, $after);
-
- if ($self->has_trigger) {
- my $trig = $self->trigger;
-
- if ('HASH' eq ref $trig) {
- ($before, $around, $after) = @{$trig}{qw(before around after)}
- }
- else {
- $after = $trig;
- }
- }
-
- if ($before) {
- $before->(@trigger_args);
- }
-
- if ($around) {
- $around->($fn, @trigger_args);
- }
- else {
- $fn->(@trigger_args);
- }
-
- if ($after) {
- $after->(@trigger_args);
- }
-}
-
sub initialize_instance_slot {
my ($self, $meta_instance, $instance, $params) = @_;
my $init_arg = $self->init_arg();
$value_is_set = 1;
}
elsif ($self->has_builder) {
- if (my $builder = $instance->can($self->builder)){
- $val = $instance->$builder;
- $value_is_set = 1;
- }
- else {
- confess(blessed($instance)." does not support builder method '".$self->builder."' for attribute '" . $self->name . "'");
- }
+ $val = $self->_call_builder($instance);
+ $value_is_set = 1;
}
}
. $type_constraint->get_message($val);
}
- $self->_with_triggers($instance, $val, sub {
- my ($ins, $val, $attr) = @_;
- my $mi = Class::MOP::Class->initialize(blessed($ins))
- ->get_meta_instance;
- $attr->set_initial_value($ins, $val);
- $mi->weaken_slot_value($ins, $attr->name)
- if ref $val && $attr->is_weak_ref;
- });
+ $self->set_initial_value($instance, $val);
+ $meta_instance->weaken_slot_value($instance, $self->name)
+ if ref $val && $self->is_weak_ref;
+}
+
+sub _call_builder {
+ my ( $self, $instance ) = @_;
+
+ my $builder = $self->builder();
+
+ return $instance->$builder()
+ if $instance->can( $self->builder );
+
+ confess( blessed($instance)
+ . " does not support builder method '"
+ . $self->builder
+ . "' for attribute '"
+ . $self->name
+ . "'" );
}
## Slot management
. $type_constraint->get_message($value);
}
- $self->_with_triggers($instance, $value, sub {
- my ($ins, $val, $attr) = @_;
- my $mi = Class::MOP::Class->initialize(blessed($ins))
- ->get_meta_instance;
- $mi->set_slot_value($ins, $attr->name, $val);
- $mi->weaken_slot_value($ins, $attr->name)
- if (ref $val && $attr->is_weak_ref);
- });
+ my $meta_instance = Class::MOP::Class->initialize(blessed($instance))
+ ->get_meta_instance;
+
+ $meta_instance->set_slot_value($instance, $attr_name, $value);
+
+ if (ref $value && $self->is_weak_ref) {
+ $meta_instance->weaken_slot_value($instance, $attr_name);
+ }
+
+ if ($self->has_trigger) {
+ $self->trigger->($instance, $value, $self);
+ }
}
sub get_value {
if ($self->is_lazy) {
unless ($self->has_value($instance)) {
+ my $value;
if ($self->has_default) {
- my $default = $self->default($instance);
- $self->set_initial_value($instance, $default);
+ $value = $self->default($instance);
} elsif ( $self->has_builder ) {
- if (my $builder = $instance->can($self->builder)){
- $self->set_initial_value($instance, $instance->$builder);
- }
- else {
- confess(blessed($instance)
- . " does not support builder method '"
- . $self->builder
- . "' for attribute '"
- . $self->name
- . "'");
- }
- }
- else {
- $self->set_initial_value($instance, undef);
+ $value = $self->_call_builder($instance);
+ }
+ if ($self->has_type_constraint) {
+ my $type_constraint = $self->type_constraint;
+ $value = $type_constraint->coerce($value)
+ if ($self->should_coerce);
+ $type_constraint->check($value)
+ || confess "Attribute (" . $self->name
+ . ") does not pass the type constraint because: "
+ . $type_constraint->get_message($value);
}
+ $self->set_initial_value($instance, $value);
}
}
my $self = shift;
my $meta = $self->_find_delegate_metaclass;
if ($meta->isa('Class::MOP::Class')) {
- return map { $_->{name} } # NOTE: !never! delegate &meta
- grep { $_->{class} ne 'Moose::Object' && $_->{name} ne 'meta' }
- $meta->compute_all_applicable_methods;
+ return map { $_->name } # NOTE: !never! delegate &meta
+ grep { $_->package_name ne 'Moose::Object' && $_->name ne 'meta' }
+ $meta->get_all_methods;
}
elsif ($meta->isa('Moose::Meta::Role')) {
return $meta->get_method_list;
To check a value against a type constraint before setting it, fetch the
attribute instance using L<Class::MOP::Class/find_attribute_by_name>,
fetch the type_constraint from the attribute using L<Moose::Meta::Attribute/type_constraint>
-and call L<Moose::Meta::TypeConstraint/check>. See L<Moose::Cookbook::RecipeX>
+and call L<Moose::Meta::TypeConstraint/check>. See L<Moose::Cookbook::Basics::Recipe4>
for an example.
=back
#If your attribute name starts with an underscore:
has '_foo' => (lazy_build => 1);
#is the same as
- has '_foo' => (lazy => 1, required => 1, predicate => '_has_foo', clearer => '_clear_foo', builder => '_build__foo);
+ has '_foo' => (lazy => 1, required => 1, predicate => '_has_foo', clearer => '_clear_foo', builder => '_build__foo');
# or
has '_foo' => (lazy => 1, required => 1, predicate => '_has_foo', clearer => '_clear_foo', default => sub{shift->_build__foo});
#If your attribute name does not start with an underscore:
has 'foo' => (lazy_build => 1);
#is the same as
- has 'foo' => (lazy => 1, required => 1, predicate => 'has_foo', clearer => 'clear_foo', builder => '_build_foo);
+ has 'foo' => (lazy => 1, required => 1, predicate => 'has_foo', clearer => 'clear_foo', builder => '_build_foo');
# or
has 'foo' => (lazy => 1, required => 1, predicate => 'has_foo', clearer => 'clear_foo', default => sub{shift->_build_foo});
the invocant and the new value. This can be used to handle I<basic>
bi-directional relations.
-This can also be a HASH of CODE refs for before/around/after, much
-in the same vein as method modifiers. After and before work just
-like the plain CODE ref case. Around first gets a CODE ref that
-expects the rest of the args and will assign the value.
-
=item B<documentation>
This is a string which contains the documentation for this attribute.
projects / gitmo/Moose.git / blobdiff