return $class->$orig( $name, $options );
};
-around attach_to_class => sub {
+around 'attach_to_class' => sub {
my $orig = shift;
my $self = shift;
my $meta = shift;
$self->$orig($meta);
-
- $self->_initialize($meta)
- unless $self->is_lazy();
+ $self->initialize_instance_slot($meta, $meta->name);
};
-around 'detach_from_class' => sub {
- my $orig = shift;
- my $self = shift;
- my $meta = shift;
-
- $self->clear_value($meta);
-
- $self->$orig($meta);
+override set_initial_value => sub {
+ my ($self, $instance, $value) = @_;
+ $self->_set_initial_slot_value(
+ $self,
+ $instance,
+ $value
+ );
};
-sub _initialize {
- my $self = shift;
- my $metaclass = shift;
-
- if ( $self->has_default() ) {
- $self->set_value( undef, $self->default() );
- }
- elsif ( $self->has_builder() ) {
- $self->set_value( undef, $self->_call_builder( $metaclass->name() ) );
- }
-}
-around 'default' => sub {
- my $orig = shift;
- my $self = shift;
-
- my $default = $self->$orig();
-
- if ( $self->is_default_a_coderef() ) {
- return $default->( $self->associated_class() );
- }
-
- return $default;
+before 'detach_from_class' => sub {
+ shift->clear_value(shift);
};
-around '_call_builder' => sub {
- shift;
- my $self = shift;
- my $class = shift;
-
- my $builder = $self->builder();
-
- return $class->$builder()
- if $class->can( $self->builder );
-
- confess( "$class does not support builder method '"
- . $self->builder
- . "' for attribute '"
- . $self->name
- . "'" );
-};
+sub set_slot_value { $_[0]->set_value($_[0], $_[3]) }
around 'set_value' => sub {
shift;
my $self = shift;
shift; # ignoring instance or class name
my $value = shift;
-
$self->associated_class()
->set_class_attribute_value( $self->name() => $value );
};
};
-override _inline_weaken_value => sub {
+override '_inline_weaken_value' => sub {
my $self = shift;
my ($instance, $value) = @_;
return unless $self->is_weak_ref;
--- /dev/null
+use strict;
+use warnings;
+
+package ClassFoo;
+use Moose;
+use MooseX::ClassAttribute;
+
+class_has 'chas' => (
+ isa => 'Int',
+ is => 'ro',
+ default => 1,
+ initializer => sub { $_[2]->($_[1] + 1) }
+);
+
+package ClassBar;
+use Moose;
+
+has 'chas' => (
+ isa => 'Int',
+ is => 'ro',
+ default => 1,
+ initializer => sub { $_[2]->($_[1] + 1) }
+);
+
+package ClassBaz;
+use Moose;
+use MooseX::ClassAttribute;
+
+class_has 'chas' => (
+ isa => 'Str',
+ is => 'rw',
+ default => 'Foobar',
+ trigger => sub { die __PACKAGE__ }
+);
+
+package ClassQuz;
+use Moose;
+
+has 'chas' => (
+ isa => 'Str',
+ is => 'rw',
+ default => 'Foobar',
+ trigger => sub { die __PACKAGE__ }
+);
+
+
+
+package main;
+use Test::More tests => 4;
+
+is ( ClassFoo->chas, 2, "ClassFoo's class_has (ClassAttribute) initializer fires" );
+
+is ( ClassBar->new->chas, 2, "ClassBar's has (non-ClassAttribute) initializer fires" );
+
+eval { ClassBaz->new->chas('foobar') };
+like ( $@, qr/ClassBaz/, "ClassBaz's class_has (ClassAttribute) trigger fires" );
+
+eval { ClassQuz->new->chas('foobar') };
+like ( $@, qr/ClassQuz/, "ClassQuz's has (non-ClassAttribute) trigger fires" );
\ No newline at end of file