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 27e88d6cbe9948001090a2fc887880e877cddf79
Author: David Golden <dagol...@cpan.org>
Date: Tue Aug 20 17:32:39 2013 -0400
add attribute introspection
---
README.pod | 11 ++++++++++-
lib/Class/Tiny.pm | 32 ++++++++++++++++++++++----------
t/baker.t | 8 ++++++++
t/foxtrot.t | 8 ++++++++
4 files changed, 48 insertions(+), 11 deletions(-)
diff --git a/README.pod b/README.pod
index 8b41171..7c9b04e 100644
--- a/README.pod
+++ b/README.pod
@@ -104,7 +104,7 @@ I looked for something like it on CPAN, but after checking
a dozen class
creators I realized I could implement it exactly how I wanted faster than I
could search CPAN for something merely sufficient.
-=for Pod::Coverage new
+=for Pod::Coverage new get_all_attribute_for
=head1 USAGE
@@ -209,6 +209,15 @@ values and errors are ignored.
$self->cleanup();
}
+=head2 Introspection
+
+You can retrieve an unsorted list of valid attributes known to Class::Tiny
+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/
+
=for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants
kwalitee diff irc mailto metadata placeholders metacpan
=head1 SUPPORT
diff --git a/lib/Class/Tiny.pm b/lib/Class/Tiny.pm
index 8885ba3..cc53c05 100644
--- a/lib/Class/Tiny.pm
+++ b/lib/Class/Tiny.pm
@@ -8,6 +8,13 @@ package Class::Tiny;
use Carp ();
+if ( $] >= 5.010 ) {
+ require "mro.pm"; ## no critic: hack to hide from min version & prereq
scanners
+}
+else {
+ require MRO::Compat;
+}
+
my %CLASS_ATTRIBUTES;
# adapted from Object::Tiny and Object::Tiny::RW
@@ -32,19 +39,15 @@ sub import {
return 1;
}
+sub get_all_attributes_for {
+ my ($class, $pkg) = @_;
+ return map { keys %{ $CLASS_ATTRIBUTES{$_} || {} } } @{
mro::get_linear_isa($pkg) };
+}
+
package Class::Tiny::Object;
# ABSTRACT: Base class for classes built with Class::Tiny
# VERSION
-use Carp ();
-
-if ( $] >= 5.010 ) {
- require "mro.pm"; ## no critic: hack to hide from min version & prereq
scanners
-}
-else {
- require MRO::Compat;
-}
-
sub new {
my $class = shift;
@@ -118,7 +121,7 @@ sub DESTROY {
1;
-=for Pod::Coverage new
+=for Pod::Coverage new get_all_attribute_for
=head1 SYNOPSIS
@@ -288,6 +291,15 @@ values and errors are ignored.
$self->cleanup();
}
+=head2 Introspection
+
+You can retrieve an unsorted list of valid attributes known to Class::Tiny
+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/
+
=cut
# vim: ts=4 sts=4 sw=4 et:
diff --git a/t/baker.t b/t/baker.t
index 784e17b..fa5cca4 100644
--- a/t/baker.t
+++ b/t/baker.t
@@ -8,6 +8,14 @@ use TestUtils;
require_ok("Baker");
+subtest "attribute list" => sub {
+ is_deeply(
+ [ sort Class::Tiny->get_all_attributes_for("Baker") ],
+ [ sort qw/foo bar baz/ ],
+ "attribute list correct",
+ );
+};
+
subtest "empty list constructor" => sub {
my $obj = new_ok("Baker");
is( $obj->foo, undef, "foo is undef" );
diff --git a/t/foxtrot.t b/t/foxtrot.t
index 286cf5b..f6eb4f9 100644
--- a/t/foxtrot.t
+++ b/t/foxtrot.t
@@ -8,6 +8,14 @@ use TestUtils;
require_ok("Foxtrot");
+subtest "attribute list" => sub {
+ is_deeply(
+ [ sort Class::Tiny->get_all_attributes_for("Foxtrot") ],
+ [ sort qw/foo bar/ ],
+ "attribute list correct",
+ );
+};
+
subtest "attribute set as list" => sub {
my $obj = new_ok( "Foxtrot", [ foo => 42, bar => 23 ] );
is( $obj->foo, 42, "foo is set" );
--
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
