# attribute's default value (if it has one)
if(defined $init_arg and exists $params->{$init_arg}){
$self->_set_initial_slot_value(
- $meta_instance,
+ $meta_instance,
$instance,
$params->{$init_arg},
);
- }
+ }
elsif (exists $self->{'default'}) {
$self->_set_initial_slot_value(
- $meta_instance,
+ $meta_instance,
$instance,
$self->default($instance),
);
- }
+ }
elsif (defined( my $builder = $self->{'builder'})) {
if ($builder = $instance->can($builder)) {
$self->_set_initial_slot_value(
- $meta_instance,
+ $meta_instance,
$instance,
$instance->$builder,
);
- }
+ }
else {
confess(ref($instance)." does not support builder method '". $self->{'builder'} ."' for attribute '" . $self->name . "'");
}
};
}
-sub get_read_method {
- my $self = shift;
+sub get_read_method {
+ my $self = shift;
my $reader = $self->reader || $self->accessor;
# normal case ...
return $reader unless ref $reader;
return $name;
}
-sub get_write_method {
+sub get_write_method {
my $self = shift;
- my $writer = $self->writer || $self->accessor;
+ my $writer = $self->writer || $self->accessor;
# normal case ...
return $writer unless ref $writer;
# the HASH ref case
my ($name) = %$writer;
- return $name;
+ return $name;
}
sub get_read_method_ref {
my $self = shift;
- if ((my $reader = $self->get_read_method) && $self->associated_class) {
+ if ((my $reader = $self->get_read_method) && $self->associated_class) {
return $self->associated_class->get_method($reader);
}
else {
}
sub get_write_method_ref {
- my $self = shift;
- if ((my $writer = $self->get_write_method) && $self->associated_class) {
+ my $self = shift;
+ if ((my $writer = $self->get_write_method) && $self->associated_class) {
return $self->associated_class->get_method($writer);
}
else {
sub _process_accessors {
my ($self, $type, $accessor, $generate_as_inline_methods) = @_;
- my $method_ctx;
-
- if ( my $ctx = $self->definition_context ) {
- $method_ctx = { %$ctx };
- }
+ my $method_ctx = { %{ $self->definition_context || {} } };
if (ref($accessor)) {
(ref($accessor) eq 'HASH')
|| confess "bad accessor/reader/writer/predicate/clearer format, must be a HASH ref";
my ($name, $method) = %{$accessor};
+
+ $method_ctx->{description} = $self->_accessor_description($name, $type);
+
$method = $self->accessor_metaclass->wrap(
$method,
+ attribute => $self,
package_name => $self->associated_class->name,
name => $name,
+ associated_metaclass => $self->associated_class,
definition_context => $method_ctx,
);
$self->associate_method($method);
my $inline_me = ($generate_as_inline_methods && $self->associated_class->instance_metaclass->is_inlinable);
my $method;
try {
- if ( $method_ctx ) {
- my $desc = "accessor $accessor";
- if ( $accessor ne $self->name ) {
- $desc .= " of attribute " . $self->name;
- }
-
- $method_ctx->{description} = $desc;
- }
+ $method_ctx->{description} = $self->_accessor_description($accessor, $type);
$method = $self->accessor_metaclass->new(
attribute => $self,
accessor_type => $type,
package_name => $self->associated_class->name,
name => $accessor,
+ associated_metaclass => $self->associated_class,
definition_context => $method_ctx,
);
}
}
}
+sub _accessor_description {
+ my $self = shift;
+ my ($name, $type) = @_;
+
+ my $desc = "$type " . $self->associated_class->name . "::$name";
+ if ( $name ne $self->name ) {
+ $desc .= " of attribute " . $self->name;
+ }
+
+ return $desc;
+}
+
sub install_accessors {
my $self = shift;
my $inline = shift;