This is an automated email from the git hooks/post-receive script.
gregoa pushed a commit to annotated tag release-0.001
in repository libclass-tiny-perl.
commit dd16a6c22d2d86687ae973957d4f568e636200a9
Author: David Golden <dagol...@cpan.org>
Date: Fri Aug 16 07:15:34 2013 -0400
add support for BUILD methods
---
lib/Class/Tiny.pm | 18 ++++++++++++++++--
t/delta.t | 30 ++++++++++++++++++++++++++++++
t/echo.t | 31 +++++++++++++++++++++++++++++++
t/lib/Delta.pm | 19 +++++++++++++++++++
t/lib/Echo.pm | 15 +++++++++++++++
5 files changed, 111 insertions(+), 2 deletions(-)
diff --git a/lib/Class/Tiny.pm b/lib/Class/Tiny.pm
index d0c7262..9fd19ba 100644
--- a/lib/Class/Tiny.pm
+++ b/lib/Class/Tiny.pm
@@ -60,7 +60,13 @@ sub new {
if (@bad) {
Carp::croak("Invalid attributes for $class: @bad");
}
- return bless $args, $class;
+ my $self = bless $args, $class;
+ for my $s ( reverse @search ) {
+ no strict 'refs';
+ my $builder = *{ $s . "::BUILD" }{CODE};
+ $self->$builder if defined $builder;
+ }
+ return $self;
}
1;
@@ -197,7 +203,15 @@ hash or an exception is thrown. A shallow copy is made of
the reference provide
=head2 BUILD
-To be implemented...
+If the class or any superclass defines a C<BUILD> method, they will be called
+by the constructor from furthest parent to child after the object has been
+created. No arguments are provided and the return value is ignored. Use them
+for validation or setting default values.
+
+ sub BUILD {
+ my $self = shift;
+ $self->foo(42) unless defined $self->foo;
+ }
=head2 DEMOLISH
diff --git a/t/delta.t b/t/delta.t
new file mode 100644
index 0000000..26c75d8
--- /dev/null
+++ b/t/delta.t
@@ -0,0 +1,30 @@
+use 5.008001;
+use strict;
+use warnings;
+use Test::More 0.96;
+use Test::FailWarnings;
+use Test::Deep '!blessed';
+use Test::Fatal;
+
+use lib 't/lib';
+
+require_ok("Delta");
+
+subtest "attribute set as list" => sub {
+ my $obj = new_ok( "Delta", [ foo => 42, bar => 23 ] );
+ is( $obj->foo, 42, "foo is set" );
+ is( $obj->bar, 23, "bar is set" );
+};
+
+subtest "exceptions" => sub {
+ like(
+ exception { Delta->new( foo => 0 ) },
+ qr/foo must be positive/,
+ "BUILD validation throws error",
+ );
+
+};
+
+done_testing;
+# COPYRIGHT
+# vim: ts=4 sts=4 sw=4 et:
diff --git a/t/echo.t b/t/echo.t
new file mode 100644
index 0000000..d95169e
--- /dev/null
+++ b/t/echo.t
@@ -0,0 +1,31 @@
+use 5.008001;
+use strict;
+use warnings;
+use Test::More 0.96;
+use Test::FailWarnings;
+use Test::Deep '!blessed';
+use Test::Fatal;
+
+use lib 't/lib';
+
+require_ok("Echo");
+
+subtest "attribute set as list" => sub {
+ my $obj = new_ok( "Echo", [ foo => 42, bar => 23 ] );
+ is( $obj->foo, 42, "foo is set" );
+ is( $obj->bar, 23, "bar is set" );
+ is( $obj->baz, 24, "baz is set" );
+};
+
+subtest "exceptions" => sub {
+ like(
+ exception { Echo->new( foo => 0, bar => 23 ) },
+ qr/foo must be positive/,
+ "BUILD validation throws error",
+ );
+
+};
+
+done_testing;
+# COPYRIGHT
+# vim: ts=4 sts=4 sw=4 et:
diff --git a/t/lib/Delta.pm b/t/lib/Delta.pm
new file mode 100644
index 0000000..670c308
--- /dev/null
+++ b/t/lib/Delta.pm
@@ -0,0 +1,19 @@
+use 5.008001;
+use strict;
+use warnings;
+
+package Delta;
+
+use Carp ();
+
+use Class::Tiny qw/foo bar/;
+
+sub BUILD {
+ my $self = shift;
+ Carp::croak("foo must be positive")
+ unless defined $self->foo && $self->foo > 0;
+
+ $self->bar(42) unless defined $self->bar;
+}
+
+1;
diff --git a/t/lib/Echo.pm b/t/lib/Echo.pm
new file mode 100644
index 0000000..36d6727
--- /dev/null
+++ b/t/lib/Echo.pm
@@ -0,0 +1,15 @@
+use 5.008001;
+use strict;
+use warnings;
+
+package Echo;
+use base 'Delta';
+
+use Class::Tiny qw/baz/;
+
+sub BUILD {
+ my $self = shift;
+ $self->baz( $self->bar + 1 );
+}
+
+1;
--
Alioth's /usr/local/bin/git-commit-notice on
/srv/git.debian.org/git/pkg-perl/packages/libclass-tiny-perl.git
_______________________________________________
Pkg-perl-cvs-commits mailing list
Pkg-perl-cvs-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits
