coolio

diff --git a/Build.PL b/Build.PL
index 5679b16..230f48b 100644 (file)
--- a/Build.PL
+++ b/Build.PL
@@ -8,7 +8,7 @@ my $build = Module::Build->new(
     requires => {
         'Scalar::Util'       => '1.18',
         'Carp'               => '0',
-        'Class::MOP'         => '0.22',
+        'Class::MOP'         => '0.25',
         'Sub::Name'          => '0.02',
         'UNIVERSAL::require' => '0',
         'Sub::Exporter'      => '0', # update this when rjbs releases

diff --git a/Changes b/Changes
index f300916..278eadc 100644 (file)
--- a/Changes
+++ b/Changes
@@ -22,6 +22,14 @@ Revision history for Perl extension Moose
       - keywords are now exported with Sub::Exporter
         thanks chansen for this commit
 
+    * Moose::Meta::Class
+      - due to changes in Class::MOP, we had to change
+        construct_instance (for the better)
+        
+    * Moose::Meta::Attribute
+      - due to changes in Class::MOP, we had to add the 
+        initialize_instance_slot method (it's a good thing)
+
 0.04 Sun. April 16th, 2006
     * Moose::Role
       - Roles can now consume other roles

diff --git a/lib/Moose.pm b/lib/Moose.pm
index ac35d37..6d18e15 100644 (file)
--- a/lib/Moose.pm
+++ b/lib/Moose.pm
@@ -42,8 +42,6 @@ use Moose::Util::TypeConstraints;
             $meta = $class->meta();
             (blessed($meta) && $meta->isa('Moose::Meta::Class'))
                 || confess "Whoops, not møøsey enough";
-            ($meta->attribute_metaclass->isa('Moose::Meta::Attribute'))
-                || confess "Attribute metaclass must be a subclass of Moose::Meta::Attribute";
         }
         else {
             $meta = Moose::Meta::Class->initialize($class);
@@ -82,8 +80,6 @@ use Moose::Util::TypeConstraints;
                 my ($name, %options) = @_;
                 if ($options{metaclass}) {
                     _load_all_classes($options{metaclass});
-                    ($options{metaclass}->isa('Moose::Meta::Attribute'))
-                        || confess "Custom attribute metaclass must be a subclass of Moose::Meta::Attribute";
                     $meta->add_attribute($options{metaclass}->new($name, %options));
                 }
                 else {

diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index bcb588c..7f1d925 100644 (file)
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -110,6 +110,41 @@ sub new {
        $class->SUPER::new($name, %options);    
 }
 
+sub initialize_instance_slot {
+    my ($self, $class, $instance, $params) = @_;
+    my $init_arg = $self->init_arg();
+    # try to fetch the init arg from the %params ...
+    my $val;        
+    if (exists $params->{$init_arg}) {
+        $val = $params->{$init_arg};
+    }
+    else {
+        # skip it if it's lazy
+        return if $self->is_lazy;
+        # and die if it's required and doesn't have a default value
+        confess "Attribute (" . $self->name . ") is required" 
+            if $self->is_required && !$self->has_default;
+    }
+    # if nothing was in the %params, we can use the 
+    # attribute's default value (if it has one)
+    if (!defined $val && $self->has_default) {
+        $val = $self->default($instance); 
+    }
+       if (defined $val) {
+           if ($self->has_type_constraint) {
+                   if ($self->should_coerce && $self->type_constraint->has_coercion) {
+                       $val = $self->type_constraint->coercion->coerce($val);
+                   }   
+            (defined($self->type_constraint->check($val))) 
+                || confess "Attribute (" . $self->name . ") does not pass the type contraint with '$val'";                     
+        }
+       }
+    $instance->{$self->name} = $val;
+    if (defined $val && $self->is_weak_ref) {
+        weaken($instance->{$self->name});
+    }    
+}
+
 sub generate_accessor_method {
     my ($self, $attr_name) = @_;
     my $value_name = $self->should_coerce ? '$val' : '$_[1]';
@@ -220,6 +255,8 @@ will behave just as L<Class::MOP::Attribute> does.
 
 =item B<new>
 
+=item B<initialize_instance_slot>
+
 =item B<generate_accessor_method>
 
 =item B<generate_writer_method>

diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm
index 5c7647f..8a3cf27 100644 (file)
--- a/lib/Moose/Meta/Class.pm
+++ b/lib/Moose/Meta/Class.pm
@@ -47,7 +47,7 @@ sub new_object {
     my ($class, %params) = @_;
     my $self = $class->SUPER::new_object(%params);
     foreach my $attr ($class->compute_all_applicable_attributes()) {
-        next unless $params{$attr->name} && $attr->has_trigger;
+        next unless $params{$attr->name} && $attr->can('has_trigger') && $attr->has_trigger;
         $attr->trigger->($self, $params{$attr->name});
     }
     return $self;    
@@ -57,37 +57,7 @@ sub construct_instance {
     my ($class, %params) = @_;
     my $instance = $params{'__INSTANCE__'} || {};
     foreach my $attr ($class->compute_all_applicable_attributes()) {
-        my $init_arg = $attr->init_arg();
-        # try to fetch the init arg from the %params ...
-        my $val;        
-        if (exists $params{$init_arg}) {
-            $val = $params{$init_arg};
-        }
-        else {
-            # skip it if it's lazy
-            next if $attr->is_lazy;
-            # and die if it's required and doesn't have a default value
-            confess "Attribute (" . $attr->name . ") is required" 
-                if $attr->is_required && !$attr->has_default;
-        }
-        # if nothing was in the %params, we can use the 
-        # attribute's default value (if it has one)
-        if (!defined $val && $attr->has_default) {
-            $val = $attr->default($instance); 
-        }
-               if (defined $val) {
-                   if ($attr->has_type_constraint) {
-                   if ($attr->should_coerce && $attr->type_constraint->has_coercion) {
-                       $val = $attr->type_constraint->coercion->coerce($val);
-                   }   
-                (defined($attr->type_constraint->check($val))) 
-                    || confess "Attribute (" . $attr->name . ") does not pass the type contraint with '$val'";                 
-            }
-               }
-        $instance->{$attr->name} = $val;
-        if (defined $val && $attr->is_weak_ref) {
-            weaken($instance->{$attr->name});
-        }
+        $attr->initialize_instance_slot($class, $instance, \%params)
     }
     return $instance;
 }

diff --git a/t/036_custom_attribute_metaclass.t b/t/036_custom_attribute_metaclass.t
index eab082f..395741b 100644 (file)
--- a/t/036_custom_attribute_metaclass.t
+++ b/t/036_custom_attribute_metaclass.t
@@ -14,13 +14,16 @@ BEGIN {
     package Foo::Meta::Attribute;
     use strict;
     use warnings;
+    use Moose;
     
-    use base 'Moose::Meta::Attribute';
+    extends 'Moose::Meta::Attribute';
     
-    sub new {
-        my $class = shift;
-        $class->SUPER::new(@_, (is => 'rw', isa => 'Foo'));
-    }
+    around 'new' => sub {
+        my $next = shift;
+        my $self = shift;
+        my $name = shift;
+        $next->($self, $name, (is => 'rw', isa => 'Foo'), @_);
+    };
 
     package Foo;
     use strict;
@@ -52,16 +55,17 @@ is($foo_attr_type_constraint->parent->name, 'Object', '... got the right type co
     package Bar::Meta::Attribute;
     use strict;
     use warnings;
+    use Moose;
     
-    use base 'Class::MOP::Attribute';   
+    extends 'Class::MOP::Attribute';   
     
     package Bar;
     use strict;
     use warnings;
     use Moose;
     
-    ::dies_ok {
+    ::lives_ok {
         has 'bar' => (metaclass => 'Bar::Meta::Attribute');     
-    } '... the attribute metaclass must be a subclass of Moose::Meta::Attribute';
+    } '... the attribute metaclass need not be a Moose::Meta::Attribute as long as it behaves';
 }
 

diff --git a/t/060_moose_for_meta.t b/t/060_moose_for_meta.t
new file mode 100644 (file)
index 0000000..de4c1d7
--- /dev/null
+++ b/t/060_moose_for_meta.t
@@ -0,0 +1,64 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 16;
+use Test::Exception;
+
+BEGIN {
+    use_ok('Moose');           
+}
+
+{
+    package My::Meta::Class;
+    use strict;
+    use warnings;
+    use Moose;
+    
+    extends 'Moose::Meta::Class';
+}
+
+my $anon = My::Meta::Class->create_anon_class();
+isa_ok($anon, 'My::Meta::Class');
+isa_ok($anon, 'Moose::Meta::Class');
+isa_ok($anon, 'Class::MOP::Class');
+
+{
+    package My::Meta::Attribute::DefaultReadOnly;
+    use strict;
+    use warnings;
+    use Moose;
+    
+    extends 'Moose::Meta::Attribute';
+    
+    around 'new' => sub {
+        my $next = shift;
+        my $self = shift;
+        my $name = shift;
+        $next->($self, $name, (is => 'ro'), @_);
+    };    
+}
+
+{
+    my $attr = My::Meta::Attribute::DefaultReadOnly->new('foo');
+    isa_ok($attr, 'My::Meta::Attribute::DefaultReadOnly');
+    isa_ok($attr, 'Moose::Meta::Attribute');
+    isa_ok($attr, 'Class::MOP::Attribute');
+
+    ok($attr->has_reader, '... the attribute has a reader (as expected)');
+    ok(!$attr->has_writer, '... the attribute does not have a writer (as expected)');
+    ok(!$attr->has_accessor, '... the attribute does not have an accessor (as expected)');
+}
+
+{
+    my $attr = My::Meta::Attribute::DefaultReadOnly->new('foo', (is => 'rw'));
+    isa_ok($attr, 'My::Meta::Attribute::DefaultReadOnly');
+    isa_ok($attr, 'Moose::Meta::Attribute');
+    isa_ok($attr, 'Class::MOP::Attribute');
+
+    ok(!$attr->has_reader, '... the attribute does not have a reader (as expected)');
+    ok(!$attr->has_writer, '... the attribute does not have a writer (as expected)');
+    ok($attr->has_accessor, '... the attribute does have an accessor (as expected)');
+}
+