X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FAttribute.pm;h=d7347d071960a86f681f02d9b2529f2a5bf8c625;hb=cbeacd38c90812d602c262cb67dec8f128061be9;hp=21765b30957fbf9ee79dc300c0b324de64aac1ae;hpb=953e657e0aaf23b2ae9bdfad42f57409eaa47a0f;p=gitmo%2FMoose.git

diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index 21765b3..d7347d0 100644
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -8,7 +8,7 @@ use Scalar::Util 'blessed', 'weaken';
 use Carp         'confess';
 use overload     ();
 
-our $VERSION   = '0.55';
+our $VERSION   = '0.57';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use Moose::Meta::Method::Accessor;
@@ -312,21 +312,8 @@ sub _process_options {
     }
 
     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}) {
@@ -364,73 +351,6 @@ sub _process_options {
 
 }
 
-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();
@@ -456,13 +376,8 @@ sub initialize_instance_slot {
             $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;
         }
     }
 
@@ -480,14 +395,25 @@ sub initialize_instance_slot {
                      . $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
@@ -555,14 +481,18 @@ sub set_value {
                      . $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 {
@@ -570,25 +500,22 @@ 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);
         }
     }
 
@@ -763,9 +690,9 @@ sub _get_delegate_method_list {
     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;
@@ -842,7 +769,7 @@ Any coercion to convert values is done before checking the type constraint.
 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
@@ -914,14 +841,14 @@ and predicate options for you using the following convention.
    #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});
 
@@ -955,11 +882,6 @@ value of an attribute is assigned. The CODE ref will get two values,
 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.