From: Moritz Onken <onken@netcubed.de>
Date: Mon, 17 Jan 2011 00:52:35 +0000 (+0100)
Subject: simplification of code, fixes #45260 and makes behavior same as Moose attributes
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=567f5231a106cccb3a1604be8a52178fe3ce7f9a;p=gitmo%2FMooseX-ClassAttribute.git

simplification of code, fixes #45260 and makes behavior same as Moose attributes
---

diff --git a/lib/MooseX/ClassAttribute/Trait/Attribute.pm b/lib/MooseX/ClassAttribute/Trait/Attribute.pm
index 435842d..01b25da 100644
--- a/lib/MooseX/ClassAttribute/Trait/Attribute.pm
+++ b/lib/MooseX/ClassAttribute/Trait/Attribute.pm
@@ -22,75 +22,36 @@ around '_process_options' => sub {
     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 );
 };
@@ -127,7 +88,7 @@ override '_inline_instance_get' => sub {
 };
 
 
-override _inline_weaken_value => sub {
+override '_inline_weaken_value' => sub {
     my $self = shift;
     my ($instance, $value) = @_;
     return unless $self->is_weak_ref;
diff --git a/t/05-with-initializer.t b/t/05-with-initializer.t
new file mode 100644
index 0000000..a04b0f3
--- /dev/null
+++ b/t/05-with-initializer.t
@@ -0,0 +1,59 @@
+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