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