[libclass-tiny-perl] 10/19: relax argument validation and use heuristic instead

[gregor herrmann]

This is an automated email from the git hooks/post-receive script.

gregoa pushed a commit to annotated tag release-0.004
in repository libclass-tiny-perl.

commit 32d8460758c3f1171abbb51d6075501e326b8237
Author: David Golden <dagolden at cpan.org>
Date:   Tue Aug 20 22:17:48 2013 -0400

    relax argument validation and use heuristic instead
---
 README.pod        |  9 ++++++---
 lib/Class/Tiny.pm | 14 +++++++++-----
 t/echo.t          |  7 +++++++
 t/lib/Echo.pm     |  2 ++
 4 files changed, 24 insertions(+), 8 deletions(-)

diff --git a/README.pod b/README.pod
index 8047edb..97a6ac5 100644
--- a/README.pod
+++ b/README.pod
@@ -68,7 +68,7 @@ C<new> takes a hash reference or list of key/value pairs
 
 =item *
 
-C<new> throws an error for unknown attributes
+C<new> has heuristics to catch constructor attribute typos
 
 =item *
 
@@ -181,8 +181,11 @@ If a reference is passed as a single argument, it must be able to be
 dereferenced as a hash or an exception is thrown.  A shallow copy is made of
 the reference provided.
 
-Unknown arguments will result in a fatal exception, but see L</BUILD> for how
-to avoid this if desired.
+In order to help catch typos in constructor arguments, any argument that it is
+not also a valid method (e.g. an accessor or other method) will result in a
+fatal exception.  This is not perfect, but should catch typical transposition
+typos. Also see L</BUILD> for how to explictly hide non-attribute, non-method
+arguments if desired.
 
 =head2 BUILD
 
diff --git a/lib/Class/Tiny.pm b/lib/Class/Tiny.pm
index 4ddfb3b..4ac6f9f 100644
--- a/lib/Class/Tiny.pm
+++ b/lib/Class/Tiny.pm
@@ -39,6 +39,8 @@ sub import {
     return 1;
 }
 
+# XXX do we need to track attributes at all anymore now that we use the
+# heuristic for validation?  Or is it still useful for introspection?
 sub get_all_attributes_for {
     my ( $class, $pkg ) = @_;
     return map { keys %{ $CLASS_ATTRIBUTES{$_} || {} } } @{ mro::get_linear_isa($pkg) };
@@ -79,8 +81,7 @@ sub new {
     # unknown attributes still in $args are fatal
     my @bad;
     for my $k ( keys %$args ) {
-        push @bad, $k
-          unless grep { exists $CLASS_ATTRIBUTES{$_}{$k} } @search;
+        push( @bad, $k ) unless $self->can($k); # a heuristic to catch typos
     }
     if (@bad) {
         Carp::croak("Invalid attributes for $class: @bad");
@@ -162,7 +163,7 @@ code.  Here is a list of features:
 * supports custom accessors
 * superclass provides a standard C<new> constructor
 * C<new> takes a hash reference or list of key/value pairs
-* C<new> throws an error for unknown attributes
+* C<new> has heuristics to catch constructor attribute typos
 * C<new> calls C<BUILD> for each class from parent to child
 * superclass provides a C<DESTROY> method
 * C<DESTROY> calls C<DEMOLISH> for each class from child to parent
@@ -262,8 +263,11 @@ If a reference is passed as a single argument, it must be able to be
 dereferenced as a hash or an exception is thrown.  A shallow copy is made of
 the reference provided.
 
-Unknown arguments will result in a fatal exception, but see L</BUILD> for how
-to avoid this if desired.
+In order to help catch typos in constructor arguments, any argument that it is
+not also a valid method (e.g. an accessor or other method) will result in a
+fatal exception.  This is not perfect, but should catch typical transposition
+typos. Also see L</BUILD> for how to explictly hide non-attribute, non-method
+arguments if desired.
 
 =head2 BUILD
 
diff --git a/t/echo.t b/t/echo.t
index cab7c8f..962df92 100644
--- a/t/echo.t
+++ b/t/echo.t
@@ -24,6 +24,13 @@ subtest "destructor" => sub {
     is( $Delta::exception, 0, "cleanup worked in correct order" );
 };
 
+subtest "constructor argument heuristic hiding" => sub {
+    my $obj = new_ok( "Echo", [ foo => 42, bar => 23, a_method => 1 ] );
+    is( $obj->foo, 42, "foo is set" );
+    is( $obj->bar, 23, "bar is set" );
+    is( $obj->{a_method}, 1, "hidden constructor argument still in object" );
+};
+
 subtest "exceptions" => sub {
     like(
         exception { Echo->new( foo => 0, bar => 23 ) },
diff --git a/t/lib/Echo.pm b/t/lib/Echo.pm
index 5b3c793..1f3fdcb 100644
--- a/t/lib/Echo.pm
+++ b/t/lib/Echo.pm
@@ -17,4 +17,6 @@ sub DEMOLISH {
     delete $self->{baz}; # or else Delta::DEMOLISH dies
 }
 
+sub a_method { 1 }
+
 1;

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libclass-tiny-perl.git