This is an automated email from the git hooks/post-receive script.
gregoa pushed a commit to annotated tag release-0.006
in repository libclass-tiny-perl.
commit efdb4afa20979ae14c1541c8eba2a80296c4f7f8
Author: David Golden <dagol...@cpan.org>
Date: Wed Sep 4 17:18:33 2013 -0400
add introspection for attribute defaults
---
Changes | 6 +++++-
README.pod | 16 ++++++++++++++--
lib/Class/Tiny.pm | 28 ++++++++++++++++++++++++++--
t/foxtrot.t | 11 ++++++++++-
t/lib/Foxtrot.pm | 2 +-
5 files changed, 56 insertions(+), 7 deletions(-)
diff --git a/Changes b/Changes
index cc8c6ec..ab1c4c2 100644
--- a/Changes
+++ b/Changes
@@ -2,6 +2,10 @@ Revision history for Class-Tiny
{{$NEXT}}
+ [ADDED]
+
+ - added introspection method: get_all_attribute_defaults_for($class)
+
[DOCUMENTED]
- Fixed TOBYINK email address for contributors list
@@ -32,7 +36,7 @@ Revision history for Class-Tiny
[ADDED]
- - added introspection method: get_all_attributes_for( $class)
+ - added introspection method: get_all_attributes_for($class)
[INTERNAL]
diff --git a/README.pod b/README.pod
index fdd9954..6389ad0 100644
--- a/README.pod
+++ b/README.pod
@@ -118,7 +118,8 @@ doesn't, which makes it great for core or fatpacking. That
said, Class::Tiny
tries to follow similar conventions for things like C<BUILD> and C<DEMOLISH>
for some minimal interoperability.
-=for Pod::Coverage new get_all_attributes_for prepare_class create_attributes
+=for Pod::Coverage new get_all_attributes_for get_all_attribute_defaults_for
+prepare_class create_attributes
=head1 USAGE
@@ -273,7 +274,18 @@ for a class and its superclasses with the
C<get_all_attributes_for> class
method.
my @attrs = Class::Tiny->get_all_attributes_for("Employee");
- # @attrs contains qw/name ssn/
+ # returns qw/name ssn timestamp/
+
+Likewise, a hash reference of all valid attributes and default values (or code
+references) may be retrieved with the C<get_all_attribute_defaults_for> class
+method. Any attributes without a default will be C<undef>.
+
+ my $def = Class::Tiny->get_all_attribute_defaults_for("Employee");
+ # returns {
+ # name => undef,
+ # ssn => undef
+ # timestamp => $coderef
+ # }
The C<import> method uses two class methods, C<prepare_class> and
C<create_attributes> to set up the C<@ISA> array and attributes. Anyone
diff --git a/lib/Class/Tiny.pm b/lib/Class/Tiny.pm
index 8d9289c..0dd0a53 100644
--- a/lib/Class/Tiny.pm
+++ b/lib/Class/Tiny.pm
@@ -64,6 +64,17 @@ sub get_all_attributes_for {
return map { keys %{ $CLASS_ATTRIBUTES{$_} || {} } } @{
mro::get_linear_isa($pkg) };
}
+sub get_all_attribute_defaults_for {
+ my ( $class, $pkg ) = @_;
+ my $defaults = {};
+ for my $p ( @{ mro::get_linear_isa($pkg) } ) {
+ while ( my ( $k, $v ) = each %{ $CLASS_ATTRIBUTES{$p} || {} } ) {
+ $defaults->{$k} = $v;
+ }
+ }
+ return $defaults;
+}
+
package Class::Tiny::Object;
# ABSTRACT: Base class for classes built with Class::Tiny
# VERSION
@@ -127,7 +138,9 @@ sub DESTROY {
1;
-=for Pod::Coverage new get_all_attributes_for prepare_class create_attributes
+=for Pod::Coverage
+new get_all_attributes_for get_all_attribute_defaults_for
+prepare_class create_attributes
=head1 SYNOPSIS
@@ -358,7 +371,18 @@ for a class and its superclasses with the
C<get_all_attributes_for> class
method.
my @attrs = Class::Tiny->get_all_attributes_for("Employee");
- # @attrs contains qw/name ssn/
+ # returns qw/name ssn timestamp/
+
+Likewise, a hash reference of all valid attributes and default values (or code
+references) may be retrieved with the C<get_all_attribute_defaults_for> class
+method. Any attributes without a default will be C<undef>.
+
+ my $def = Class::Tiny->get_all_attribute_defaults_for("Employee");
+ # returns {
+ # name => undef,
+ # ssn => undef
+ # timestamp => $coderef
+ # }
The C<import> method uses two class methods, C<prepare_class> and
C<create_attributes> to set up the C<@ISA> array and attributes. Anyone
diff --git a/t/foxtrot.t b/t/foxtrot.t
index f6eb4f9..55e565a 100644
--- a/t/foxtrot.t
+++ b/t/foxtrot.t
@@ -11,15 +11,24 @@ require_ok("Foxtrot");
subtest "attribute list" => sub {
is_deeply(
[ sort Class::Tiny->get_all_attributes_for("Foxtrot") ],
- [ sort qw/foo bar/ ],
+ [ sort qw/foo bar baz/ ],
"attribute list correct",
);
};
+subtest "attribute defaults" => sub {
+ my $def = Class::Tiny->get_all_attribute_defaults_for("Foxtrot");
+ is( keys %$def, 3, "defaults hashref size" );
+ is( $def->{foo}, undef, "foo default is undef" );
+ is( $def->{bar}, 42, "bar default is 42" );
+ is( ref $def->{baz}, 'CODE', "baz default is a coderef" );
+};
+
subtest "attribute set as list" => sub {
my $obj = new_ok( "Foxtrot", [ foo => 42, bar => 23 ] );
is( $obj->foo, 42, "foo is set" );
is( $obj->bar, 23, "bar is set" );
+ ok( $obj->baz, "baz is set" );
};
done_testing;
diff --git a/t/lib/Foxtrot.pm b/t/lib/Foxtrot.pm
index 4d79a8c..8dc5fe6 100644
--- a/t/lib/Foxtrot.pm
+++ b/t/lib/Foxtrot.pm
@@ -5,6 +5,6 @@ use warnings;
package Foxtrot;
use Class::Tiny 'foo';
-use Class::Tiny 'bar';
+use Class::Tiny { bar => 42, baz => sub { time } };
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
