fixing the trigger/constructor bug
Stevan Little [Tue, 13 May 2008 13:42:28 +0000 (13:42 +0000)]
Changes
lib/Moose.pm
lib/Moose/Cookbook/Snack/BUILD.pod
lib/Moose/Meta/Method/Constructor.pm
lib/Moose/Meta/Role/Application/ToInstance.pm
t/300_immutable/007_immutable_trigger_from_constructor.t [new file with mode: 0644]

diff --git a/Changes b/Changes
index 747f927..2e77a67 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,28 @@
 Revision history for Perl extension Moose
 
+0.45
+    * Moose::Meta::Method::Constructor
+      - fixed bug where trigger was not being 
+        called by the inlined immutable 
+        constructors 
+        - added test for this (thanks to Caelum)
+    
+    * Moose::Meta::Role::Application::ToInstance
+      - now uses the metaclass of the instance
+        (if possible) to create the anon-class
+        (thanks Jonathan Rockway)
+    
+    * Moose::Cookbook::Snack::ArrayRef
+      Moose::Cookbook::Snack::HashRef
+      Moose::Cookbook::Snack::Perl5ObjsVsMooseObjs
+      Moose::Cookbook::Snack::BUILD      
+      - several new Snacks added to the cookbook
+        (thanks to spicyjack)
+    
+    * t/
+      - fixed hash-ordering test bug that was 
+        causing occasional cpantester failures 
+
 0.44 Sat. May 10, 2008
     * Moose
       - made make_immutable warning cluck to 
index 9d97667..9eb8c1c 100644 (file)
@@ -4,7 +4,7 @@ package Moose;
 use strict;
 use warnings;
 
-our $VERSION   = '0.44';
+our $VERSION   = '0.45';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use Scalar::Util 'blessed', 'reftype';
index 7f7dbf8..a56ddf1 100644 (file)
@@ -23,7 +23,7 @@ Moose::Cookbook::Snack::BUILD - Custom initialization methods for Moose objects
         else {
             die('ERROR: file _' . $self->example_file . '_ does not exist');
         } 
-    } # sub BUILD 
+    }
 
     package main;
     use Moose;
@@ -82,8 +82,8 @@ run it.
 =head2 What is 'BUILDALL'?
 
 (Taken from L<Moose::Object>)  The C<BUILDALL> method will call every BUILD
-method in the inheritance hierarchy, and pass it a hash-ref of the the %params
-passed to the C<new()> method.
+method in the inheritance hierarchy, and pass it a hash-ref of the the 
+C<%params> passed to the C<new()> method.
 
 =head1 SEE ALSO
 
@@ -91,11 +91,14 @@ passed to the C<new()> method.
 
 =item L<Moose::Object> - The base object for Moose (BUILDALL) 
 
-=item L<Moose::Cookbook::FAQ> - Frequently asked questions about Moose (How do I write custom constructors with Moose?)
+=item L<Moose::Cookbook::FAQ> - Frequently asked questions about Moose 
+(How do I write custom constructors with Moose?)
 
-=item L<Moose::Cookbook::Recipe4> - Subtypes, and modeling a simple Company class heirarchy (Example usage of BUILD in action)
+=item L<Moose::Cookbook::Recipe4> - Subtypes, and modeling a simple 
+Company class heirarchy (Example usage of BUILD in action)
 
-=item L<Moose::Cookbook::WTF> - For when things go wrong with Moose ('Roles' section describes BUILD/BUILDALL)
+=item L<Moose::Cookbook::WTF> - For when things go wrong with Moose 
+('Roles' section describes BUILD/BUILDALL)
 
 =back
 
@@ -105,9 +108,11 @@ Brian Manning <elspicyjack at gmail dot com>
 
 =head1 COPYRIGHT AND LICENSE
 
-Copyright (c)2008 by Infinity Interactive, Inc.
+Copyright 2006-2008 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
 
-This documentation is free software; you can redistribute it and/or modify
+This library is free software; you can redistribute it and/or modify
 it under the same terms as Perl itself.
 
 =cut
index c6a7b37..04f335b 100644 (file)
@@ -7,7 +7,7 @@ use warnings;
 use Carp         'confess';
 use Scalar::Util 'blessed', 'weaken', 'looks_like_number';
 
-our $VERSION   = '0.09';
+our $VERSION   = '0.10';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use base 'Moose::Meta::Method',
@@ -74,6 +74,7 @@ sub initialize_body {
         $self->_generate_slot_initializer($_)
     } 0 .. (@{$self->attributes} - 1));
 
+    $source .= ";\n" . $self->_generate_triggers();    
     $source .= ";\n" . $self->_generate_BUILDALL();
 
     $source .= ";\n" . 'return $instance';
@@ -119,6 +120,32 @@ sub _generate_BUILDALL {
     return join ";\n" => @BUILD_calls;
 }
 
+sub _generate_triggers {
+    my $self = shift;
+    my @trigger_calls;
+    foreach my $i (0 .. $#{ $self->attributes }) {
+        my $attr = $self->attributes->[$i];
+        if ($attr->can('has_trigger') && $attr->has_trigger) {
+            if (defined(my $init_arg = $attr->init_arg)) {
+                push @trigger_calls => (
+                    '(exists $params{\'' . $init_arg . '\'}) && do {' . "\n    "
+                    .   '$attrs->[' . $i . ']->trigger->('
+                    .       '$instance, ' 
+                    .        $self->meta_instance->inline_get_slot_value(
+                                 '$instance',
+                                 ("'" . $attr->name . "'")
+                             ) 
+                             . ', '
+                    .        '$attrs->[' . $i . ']'
+                    .   ');'
+                    ."\n}"
+                );
+            } 
+        }
+    }
+    return join ";\n" => @trigger_calls;    
+}
+
 sub _generate_slot_initializer {
     my $self  = shift;
     my $index = shift;
index fe23910..85cd435 100644 (file)
@@ -7,7 +7,7 @@ use metaclass;
 use Carp         'confess';
 use Scalar::Util 'blessed';
 
-our $VERSION   = '0.02';
+our $VERSION   = '0.03';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use base 'Moose::Meta::Role::Application::ToClass';
diff --git a/t/300_immutable/007_immutable_trigger_from_constructor.t b/t/300_immutable/007_immutable_trigger_from_constructor.t
new file mode 100644 (file)
index 0000000..6a42b73
--- /dev/null
@@ -0,0 +1,42 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 4;
+use Test::Exception;
+
+BEGIN {
+    use_ok('Moose');
+}
+
+{
+    package AClass;
+
+    use Moose;
+
+    has 'foo' => (is => 'rw', isa => 'Maybe[Str]', trigger => sub {
+        die "Pulling the Foo trigger\n"
+    });
+    
+    has 'bar' => (is => 'rw', isa => 'Maybe[Str]');    
+    
+    has 'baz' => (is => 'rw', isa => 'Maybe[Str]', trigger => sub {
+        die "Pulling the Baz trigger\n"
+    });    
+
+    __PACKAGE__->meta->make_immutable; #(debug => 1);
+
+    no Moose;
+}
+
+eval { AClass->new(foo => 'bar') };
+like ($@, qr/^Pulling the Foo trigger/, "trigger from immutable constructor");
+
+eval { AClass->new(baz => 'bar') };
+like ($@, qr/^Pulling the Baz trigger/, "trigger from immutable constructor");
+
+lives_ok { AClass->new(bar => 'bar') } '... no triggers called';
+
+
+