[libclass-tiny-perl] 09/19: validate args after BUILD; allow BUILD to hide args

[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 0b54c231597dd40b06ee243544b56fce696b8bcc
Author: David Golden <dagolden at cpan.org>
Date:   Tue Aug 20 22:01:57 2013 -0400

    validate args after BUILD; allow BUILD to hide args
---
 README.pod        | 26 ++++++++++++++++++++++++++
 lib/Class/Tiny.pm | 47 ++++++++++++++++++++++++++++++++++++-----------
 t/delta.t         |  7 +++++++
 t/lib/Delta.pm    |  3 +++
 4 files changed, 72 insertions(+), 11 deletions(-)

diff --git a/README.pod b/README.pod
index 95df30c..8047edb 100644
--- a/README.pod
+++ b/README.pod
@@ -181,6 +181,9 @@ 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.
+
 =head2 BUILD
 
 If your class or any superclass defines a C<BUILD> method, it will be called
@@ -196,6 +199,29 @@ is ignored.  Use C<BUILD> for validation or setting default values.
         croak "Foo must be non-negative" if $self->foo < 0;
     }
 
+If you want to hide a non-attribute constructor argument from validation,
+delete it from the passed-in argument hash reference.
+
+    sub BUILD {
+        my ($self, $args) = @_;
+
+        if ( delete $args->{do_something_special} ) {
+            ...
+        }
+    }
+
+The argument reference is a copy, so deleting elements won't affect data in the
+object. You have to delete it from both if that's what you want.
+
+    sub BUILD {
+        my ($self, $args) = @_;
+
+        if ( delete $args->{do_something_special} ) {
+            delete $self->{do_something_special};
+            ...
+        }
+    }
+
 =head2 DEMOLISH
 
 Class::Tiny provides a C<DESTROY> method.  If your class or any superclass
diff --git a/lib/Class/Tiny.pm b/lib/Class/Tiny.pm
index e59e578..4ddfb3b 100644
--- a/lib/Class/Tiny.pm
+++ b/lib/Class/Tiny.pm
@@ -67,9 +67,17 @@ sub new {
         Carp::croak("$class->new() got an odd number of elements");
     }
 
-    # unknown attributes are fatal
-    my @bad;
+    # create object and invoke BUILD
+    my $self = bless {%$args}, $class;
     my @search = @{ mro::get_linear_isa($class) };
+    for my $s ( reverse @search ) {
+        no strict 'refs';
+        my $builder = *{ $s . "::BUILD" }{CODE};
+        $self->$builder($args) if defined $builder;
+    }
+
+    # unknown attributes still in $args are fatal
+    my @bad;
     for my $k ( keys %$args ) {
         push @bad, $k
           unless grep { exists $CLASS_ATTRIBUTES{$_}{$k} } @search;
@@ -78,14 +86,6 @@ sub new {
         Carp::croak("Invalid attributes for $class: @bad");
     }
 
-    # create object and invoke BUILD
-    my $self = bless {%$args}, $class;
-    for my $s ( reverse @search ) {
-        no strict 'refs';
-        my $builder = *{ $s . "::BUILD" }{CODE};
-        $self->$builder($args) if defined $builder;
-    }
-
     return $self;
 }
 
@@ -262,6 +262,9 @@ 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.
+
 =head2 BUILD
 
 If your class or any superclass defines a C<BUILD> method, it will be called
@@ -277,6 +280,29 @@ is ignored.  Use C<BUILD> for validation or setting default values.
         croak "Foo must be non-negative" if $self->foo < 0;
     }
 
+If you want to hide a non-attribute constructor argument from validation,
+delete it from the passed-in argument hash reference.
+
+    sub BUILD {
+        my ($self, $args) = @_;
+
+        if ( delete $args->{do_something_special} ) {
+            ...
+        }
+    }
+
+The argument reference is a copy, so deleting elements won't affect data in the
+object. You have to delete it from both if that's what you want.
+
+    sub BUILD {
+        my ($self, $args) = @_;
+
+        if ( delete $args->{do_something_special} ) {
+            delete $self->{do_something_special};
+            ...
+        }
+    }
+
 =head2 DEMOLISH
 
 Class::Tiny provides a C<DESTROY> method.  If your class or any superclass
@@ -301,5 +327,4 @@ method.
 
 =cut
 
-
 # vim: ts=4 sts=4 sw=4 et:
diff --git a/t/delta.t b/t/delta.t
index 4ec60c0..042f82b 100644
--- a/t/delta.t
+++ b/t/delta.t
@@ -14,6 +14,13 @@ subtest "attribute set as list" => sub {
     is( $obj->bar, 23, "bar is set" );
 };
 
+subtest "hiding constructor argument" => sub {
+    my $obj = new_ok( "Delta", [ foo => 42, bar => 23, hide_me => 1 ] );
+    is( $obj->foo, 42, "foo is set" );
+    is( $obj->bar, 23, "bar is set" );
+    is( $obj->{hide_me}, 1, "hidden constructor argument still in object" );
+};
+
 subtest "destructor" => sub {
     my @objs = map { new_ok( "Delta", [ foo => 42, bar => 23 ] ) } 1 .. 3;
     is( $Delta::counter, 3, "BUILD incremented counter" );
diff --git a/t/lib/Delta.pm b/t/lib/Delta.pm
index bde1cd5..23e81aa 100644
--- a/t/lib/Delta.pm
+++ b/t/lib/Delta.pm
@@ -13,11 +13,14 @@ use Class::Tiny qw/foo bar/;
 
 sub BUILD {
     my $self = shift;
+    my $args = shift;
     Carp::croak("foo must be positive")
       unless defined $self->foo && $self->foo > 0;
 
     $self->bar(42) unless defined $self->bar;
     $counter++;
+
+    delete $args->{hide_me};
 }
 
 sub DEMOLISH {

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