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 aeb05851b93e4146ea594119f19b856c6b600aa9 Author: David Golden <dagol...@cpan.org> Date: Fri Aug 16 06:54:21 2013 -0400 allow custom accessors without 'redefined' warnings --- lib/Class/Tiny.pm | 21 +++++++++++++++++---- t/charlie.t | 26 ++++++++++++++++++++++++++ t/lib/Charlie.pm | 18 ++++++++++++++++++ 3 files changed, 61 insertions(+), 4 deletions(-) diff --git a/lib/Class/Tiny.pm b/lib/Class/Tiny.pm index 9b6dbcd..d0c7262 100644 --- a/lib/Class/Tiny.pm +++ b/lib/Class/Tiny.pm @@ -30,8 +30,8 @@ sub import { defined and !ref and /^[^\W\d]\w*$/s or Carp::croak "Invalid accessor name '$_'"; "sub $_ { if (\@_ > 1) { \$_[0]->{$_} = \$_[1] } ; return \$_[0]->{$_} }\n" - } @attr; - Carp::croak( "Failed to generate $pkg" ) if $@; + } grep { !$pkg->can($_) } @attr; + Carp::croak("Failed to generate $pkg") if $@; return 1; } @@ -102,7 +102,8 @@ code. Here is a list of features: =for :list * defines attributes via import arguments -* generates accessors for all attributes +* generates read-write accessors for attributes +* supports custom accessors * superclass provides a standard C<new> constructor * C<new> takes a hash reference or list of key/value pairs * C<new> throws an error for unknown attributes @@ -139,13 +140,25 @@ Define attributes as a list of import arguments: weight ); -For each item, a read-write accessor is created: +For each item, a read-write accessor is created unless a subroutine of that +name already exists: $obj->name( "John Doe" ); Attribute names must be valid subroutine identifiers or an exception will be thrown. +To make your own custom accessors, just pre-declare the method name before +loading Class::Tiny: + + package Foo::Bar; + + use subs 'id'; + + use Class::Tiny qw( name id ); + + sub id { ... } + =head2 Subclassing Define subclasses as normal. It's best to define them with L<base>, L<parent> diff --git a/t/charlie.t b/t/charlie.t new file mode 100644 index 0000000..7ba5754 --- /dev/null +++ b/t/charlie.t @@ -0,0 +1,26 @@ +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("Charlie"); + +subtest "all attributes set as list" => sub { + my $obj = new_ok( "Charlie", [ foo => 13, bar => [42] ] ); + is( $obj->foo, 13, "foo is set" ); + is_deeply( $obj->bar, [42], "bar is set" ); +}; + +subtest "custom accessor" => sub { + my $obj = new_ok( "Charlie", [ foo => 13, bar => [42] ] ); + is_deeply( $obj->bar( qw/1 1 2 3 5/ ), [ qw/1 1 2 3 5/ ], "bar is set" ); +}; + +done_testing; +# COPYRIGHT +# vim: ts=4 sts=4 sw=4 et: diff --git a/t/lib/Charlie.pm b/t/lib/Charlie.pm new file mode 100644 index 0000000..9144eaa --- /dev/null +++ b/t/lib/Charlie.pm @@ -0,0 +1,18 @@ +use 5.008001; +use strict; +use warnings; +package Charlie; + +use subs qw/bar/; + +use Class::Tiny qw/foo bar/; + +sub bar { + my $self = shift; + if ( @_ ) { + $self->{bar} = [ @_ ]; + } + return $self->{bar}; +} + +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