From: Dave Rolsky <autarch@urth.org>
Date: Thu, 15 Nov 2007 20:46:49 +0000 (+0000)
Subject: Made it work with immutable classes.
X-Git-Tag: 0.02~2
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c001451a92b1a0e8f33e4854d1694140cde35d53;p=gitmo%2FMooseX-StrictConstructor.git

Made it work with immutable classes.

Added require 5.00601 to Build.PL
---

diff --git a/Build.PL b/Build.PL
index 87bb208..a4bfcc7 100644
--- a/Build.PL
+++ b/Build.PL
@@ -1,6 +1,8 @@
 use strict;
 use warnings;
 
+require 5.00601;
+
 use Module::Build;
 
 my $builder = Module::Build->new
diff --git a/Changes b/Changes
index 11f7ba3..292fe47 100644
--- a/Changes
+++ b/Changes
@@ -2,6 +2,8 @@
 
 - Moose was missing from the prereq list. Reported by Slaven Rezic.
 
+- Version 0.01 did not work after a class was made immutable.
+
 
 0.01   2007-11-14
 
diff --git a/MANIFEST b/MANIFEST
index 6d80566..d58fa20 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -2,6 +2,8 @@ Build.PL
 Changes
 lib/MooseX/Object/StrictConstructor.pm
 lib/MooseX/StrictConstructor.pm
+lib/MooseX/StrictConstructor/Meta/Class.pm
+lib/MooseX/StrictConstructor/Meta/Method/Constructor.pm
 Makefile.PL
 MANIFEST			This list of files
 META.yml
diff --git a/lib/MooseX/Object/StrictConstructor.pm b/lib/MooseX/Object/StrictConstructor.pm
index 0d3821d..1862290 100644
--- a/lib/MooseX/Object/StrictConstructor.pm
+++ b/lib/MooseX/Object/StrictConstructor.pm
@@ -7,6 +7,9 @@ use Moose;
 
 use Carp 'confess';
 
+use metaclass 'MooseX::StrictConstructor::Meta::Class';
+
+
 extends 'Moose::Object';
 
 after 'BUILDALL' => sub
diff --git a/lib/MooseX/StrictConstructor.pm b/lib/MooseX/StrictConstructor.pm
index 69d671c..8f905ba 100644
--- a/lib/MooseX/StrictConstructor.pm
+++ b/lib/MooseX/StrictConstructor.pm
@@ -3,7 +3,7 @@ package MooseX::StrictConstructor;
 use strict;
 use warnings;
 
-our $VERSION = '0.01';
+our $VERSION = '0.02';
 
 use Moose;
 use MooseX::Object::StrictConstructor;
@@ -15,7 +15,10 @@ sub import
 
     return if $caller eq 'main';
 
-    Moose::init_meta( $caller, 'MooseX::Object::StrictConstructor', 'Moose::Meta::Class' );
+    Moose::init_meta( $caller,
+                      'MooseX::Object::StrictConstructor',
+                      'MooseX::StrictConstructor::Meta::Class',
+                    );
 
     Moose->import( { into => $caller } );
 
@@ -75,6 +78,13 @@ seen when this class does its checking.
       }
   }
 
+=head2 Caveats
+
+Using this class replaces the default Moose meta class,
+C<Moose::Meta::Class>, with its own,
+C<MooseX::StrictConstructor::Meta::Class>. If you have your own meta
+class, this distro will probably not work for you.
+
 =head1 AUTHOR
 
 Dave Rolsky, C<< <autarch@urth.org> >>
diff --git a/lib/MooseX/StrictConstructor/Meta/Class.pm b/lib/MooseX/StrictConstructor/Meta/Class.pm
new file mode 100644
index 0000000..d420465
--- /dev/null
+++ b/lib/MooseX/StrictConstructor/Meta/Class.pm
@@ -0,0 +1,22 @@
+package MooseX::StrictConstructor::Meta::Class;
+
+use strict;
+use warnings;
+
+use base 'Moose::Meta::Class';
+
+use MooseX::StrictConstructor::Meta::Method::Constructor;
+
+
+sub make_immutable { ## no critic RequireArgUnpacking
+    my $self = shift;
+
+    return
+        $self->SUPER::make_immutable
+            ( constructor_class => 'MooseX::StrictConstructor::Meta::Method::Constructor',
+              @_
+            );
+}
+
+
+1;
diff --git a/lib/MooseX/StrictConstructor/Meta/Method/Constructor.pm b/lib/MooseX/StrictConstructor/Meta/Method/Constructor.pm
new file mode 100644
index 0000000..7d2017c
--- /dev/null
+++ b/lib/MooseX/StrictConstructor/Meta/Method/Constructor.pm
@@ -0,0 +1,31 @@
+package MooseX::StrictConstructor::Meta::Method::Constructor;
+
+use strict;
+use warnings;
+
+use Moose;
+
+extends 'Moose::Meta::Method::Constructor';
+
+sub _generate_BUILDALL ## no critic RequireArgUnpacking
+{
+    my $self = shift;
+
+    my $calls = $self->SUPER::_generate_BUILDALL(@_);
+
+    $calls .= <<'EOF';
+    my %attrs = map { $_->name() => 1 } $self->meta()->compute_all_applicable_attributes();
+
+    my @bad = sort grep { ! $attrs{$_} }  keys %params;
+
+    if (@bad)
+    {
+        confess "Found unknown attribute(s) passed to the constructor: @bad";
+    }
+EOF
+
+    return $calls;
+};
+
+
+1;
diff --git a/t/basic.t b/t/basic.t
index e65d3f2..cb0fec7 100644
--- a/t/basic.t
+++ b/t/basic.t
@@ -1,7 +1,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 7;
+use Test::More tests => 9;
 
 
 {
@@ -57,6 +57,22 @@ use Test::More tests => 7;
     __PACKAGE__->meta()->make_immutable();
 }
 
+{
+    package ImmutableTricky;
+
+    use MooseX::StrictConstructor;
+
+    has 'thing' => ( is => 'rw' );
+
+    sub BUILD
+    {
+        my $self   = shift;
+        my $params = shift;
+
+        delete $params->{spy};
+    }
+}
+
 
 eval { Standard->new( thing => 1, bad => 99 ) };
 is( $@, '', 'standard Moose class ignores unknown params' );
@@ -79,3 +95,11 @@ is( $@, '', 'subclass constructor handles known attributes correctly' );
 eval { Immutable->new( thing => 1, bad => 99 ) };
 like( $@, qr/unknown attribute.+: bad/,
       'strict constructor in immutable class blows up on unknown params' );
+
+eval { ImmutableTricky->new( thing => 1, spy => 99 ) };
+is( $@, '',
+    'immutable class can work around strict constructor by deleting params in BUILD()' );
+
+eval { ImmutableTricky->new( thing => 1, agent => 99 ) };
+like( $@, qr/unknown attribute.+: agent/,
+      'ImmutableTricky still blows up on unknown params other than spy' );