Implement passing the old value to a trigger when appropriate

diff --git a/Changes b/Changes
index c2983e9..96f4f38 100644 (file)
--- a/Changes
+++ b/Changes
@@ -22,6 +22,11 @@ next version
       - Add functions meta_class_alias and meta_attribute_alias for creating
         aliases for class and attribute metaclasses and metatraits. (doy)
 
+    * Moose::Meta::Attribute
+    * Moose::Meta::Method::Accessor
+      - A trigger now receives the old value as a second argument, if
+        the attribute had one.
+
 0.88 Fri Jul 24, 2009
     * Moose::Manual::Contributing
       - Re-write the Moose::Manual::Contributing document to reflect

diff --git a/lib/Moose.pm b/lib/Moose.pm
index 44dc9e9..a7118c5 100644 (file)
--- a/lib/Moose.pm
+++ b/lib/Moose.pm
@@ -457,8 +457,10 @@ This is only legal if your C<isa> option is either C<ArrayRef> or C<HashRef>.
 
 The I<trigger> option is a CODE reference which will be called after
 the value of the attribute is set. The CODE ref will be passed the
-instance itself and the updated value. You B<can> have a trigger on
-a read-only attribute.
+instance itself and the updated value. If the attribute already had a
+value, this will be passed as the third value to the trigger.
+
+You B<can> have a trigger on a read-only attribute.
 
 B<NOTE:> Triggers will only fire when you B<assign> to the attribute,
 either in the constructor, or using the writer. Default and built values will

diff --git a/lib/Moose/Manual/Attributes.pod b/lib/Moose/Manual/Attributes.pod
index 0ff2b58..9c2aff9 100644 (file)
--- a/lib/Moose/Manual/Attributes.pod
+++ b/lib/Moose/Manual/Attributes.pod
@@ -458,11 +458,21 @@ set:
   sub _size_set {
       my ( $self, $size ) = @_;
 
-      warn $self->name, " size is now $size\n";
+      my $msg = $self->name;
+
+      if (@_) {
+          $msg .= " - old size was $_[0]";
+      }
+
+      $msg .= " - size is now $size";
+      warn $msg.
   }
 
-The trigger is called as a method, and receives the new value as its argument.
-The trigger is called I<after> the value is set.
+The trigger is called I<after> an attribute's value is set. It is
+called as a method on the object, and receives the new and values as
+its arguments. If the attribute had not previously been set at all,
+then only the new value is passed. This lets you distinguish between
+the case where the attribute had no value versus when it was C<undef>.
 
 This differs from an C<after> method modifier in two ways. First, a
 trigger is only called when the attribute is set, as opposed to

diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index 637335a..33ec298 100644 (file)
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -495,6 +495,11 @@ sub set_value {
     my $meta_instance = Class::MOP::Class->initialize(blessed($instance))
                                          ->get_meta_instance;
 
+    my @old;
+    if ( $self->has_trigger && $self->has_value($instance) ) {
+        @old = $self->get_value($instance, 'for trigger');
+    }
+
     $meta_instance->set_slot_value($instance, $attr_name, $value);
 
     if (ref $value && $self->is_weak_ref) {
@@ -502,12 +507,12 @@ sub set_value {
     }
 
     if ($self->has_trigger) {
-        $self->trigger->($instance, $value);
+        $self->trigger->($instance, $value, @old);
     }
 }
 
 sub get_value {
-    my ($self, $instance) = @_;
+    my ($self, $instance, $for_trigger) = @_;
 
     if ($self->is_lazy) {
         unless ($self->has_value($instance)) {
@@ -524,7 +529,7 @@ sub get_value {
         }
     }
 
-    if ($self->should_auto_deref) {
+    if ( $self->should_auto_deref && ! $for_trigger ) {
 
         my $type_constraint = $self->type_constraint;
 

diff --git a/lib/Moose/Meta/Method/Accessor.pm b/lib/Moose/Meta/Method/Accessor.pm
index 0cc5734..6b34973 100644 (file)
--- a/lib/Moose/Meta/Method/Accessor.pm
+++ b/lib/Moose/Meta/Method/Accessor.pm
@@ -34,7 +34,7 @@ sub _eval_code {
                                    : undef),
     };
 
-    #warn "code for $attr_name =>\n" . $source . "\n";
+    #warn "code for " . $attr->name . " =>\n" . $source . "\n";
     my ( $code, $e ) = $self->_compile_code( environment => $environment, code => $source );
 
     $self->throw_error(
@@ -59,8 +59,9 @@ sub _generate_accessor_method_inline {
         . $self->_inline_check_required . "\n"
         . $self->_inline_check_coercion($value_name) . "\n"
         . $self->_inline_check_constraint($value_name) . "\n"
+        . $self->_inline_get_old_value_for_trigger($inv, $value_name) . "\n"
         . $self->_inline_store($inv, $value_name) . "\n"
-        . $self->_inline_trigger($inv, $value_name) . "\n"
+        . $self->_inline_trigger($inv, $value_name, '@old') . "\n"
     . ' }' . "\n"
     . $self->_inline_check_lazy($inv) . "\n"
     . $self->_inline_post_body(@_) . "\n"
@@ -82,9 +83,10 @@ sub _generate_writer_method_inline {
     . $self->_inline_check_required
     . $self->_inline_check_coercion($value_name)
     . $self->_inline_check_constraint($value_name)
+    . $self->_inline_get_old_value_for_trigger($inv, $value_name) . "\n"
     . $self->_inline_store($inv, $value_name)
     . $self->_inline_post_body(@_)
-    . $self->_inline_trigger($inv, $value_name)
+    . $self->_inline_trigger($inv, $value_name, '@old')
     . ' }');
 }
 
@@ -226,11 +228,26 @@ sub _inline_store {
     return $code;
 }
 
+sub _inline_get_old_value_for_trigger {
+    my ( $self, $instance ) = @_;
+
+    my $attr = $self->associated_attribute;
+    return '' unless $attr->has_trigger;
+
+    my $mi = $attr->associated_class->get_meta_instance;
+    my $pred = $mi->inline_is_slot_initialized($instance, $attr->name);
+
+    return
+          'my @old = '
+        . $pred . q{ ? }
+        . $self->_inline_get($instance) . q{ : ()} . ";\n";
+}
+
 sub _inline_trigger {
-    my ($self, $instance, $value) = @_;
+    my ($self, $instance, $value, $old_value) = @_;
     my $attr = $self->associated_attribute;
     return '' unless $attr->has_trigger;
-    return sprintf('$attr->trigger->(%s, %s);', $instance, $value);
+    return sprintf('$attr->trigger->(%s, %s, %s);', $instance, $value, $old_value);
 }
 
 sub _inline_get {

diff --git a/t/020_attributes/004_attribute_triggers.t b/t/020_attributes/004_attribute_triggers.t
index e799399..baa2a2a 100644 (file)
--- a/t/020_attributes/004_attribute_triggers.t
+++ b/t/020_attributes/004_attribute_triggers.t
@@ -5,7 +5,7 @@ use warnings;
 
 use Scalar::Util 'isweak';
 
-use Test::More tests => 40;
+use Test::More tests => 42;
 use Test::Exception;
 
 
@@ -158,7 +158,8 @@ use Test::Exception;
     is_deeply(\%Blarg::trigger_vals, { map { $_ => "Yet another $_ value" } qw/foo bar baz/ }, 'All triggers given assigned values');
 }
 
-# Triggers do not receive the meta-attribute as an argument
+# Triggers do not receive the meta-attribute as an argument, but do
+# receive the old value
 
 {
     package Foo;
@@ -169,6 +170,28 @@ use Test::Exception;
 
 {
     my $attr = Foo->meta->get_attribute('foo');
+
+    my $foo = Foo->new;
+    $attr->set_value( $foo, 2 );
+
+    is_deeply(
+        \@Foo::calls,
+        [ [ $foo, 2 ] ],
+        'trigger called correctly on initial set via meta-API',
+    );
+    @Foo::calls = ();
+
+    $attr->set_value( $foo, 3 );
+
+    is_deeply(
+        \@Foo::calls,
+        [ [ $foo, 3, 2 ] ],
+        'trigger called correctly on second set via meta-API',
+    );
+    @Foo::calls = ();
+}
+
+{
     my $foo = Foo->new(foo => 2);
     is_deeply(
         \@Foo::calls,
@@ -180,8 +203,8 @@ use Test::Exception;
     $foo->foo(3);
     is_deeply(
         \@Foo::calls,
-        [ [ $foo, 3 ] ],
-        'trigger called correctly on set',
+        [ [ $foo, 3, 2 ] ],
+        'trigger called correctly on set (with old value)',
     );
     @Foo::calls = ();
     Foo->meta->make_immutable, redo if Foo->meta->is_mutable;