[libclass-tiny-perl] 19/22: only avoid accessor generation if sub is defined in class, not superclass

[gregor herrmann]

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 21852f6b2a8a3983441090ad1217f45894c0a9fa
Author: David Golden <dagolden at cpan.org>
Date:   Fri Aug 16 09:45:57 2013 -0400

    only avoid accessor generation if sub is defined in class, not superclass
---
 lib/Class/Tiny.pm | 17 +++++++++++------
 1 file changed, 11 insertions(+), 6 deletions(-)

diff --git a/lib/Class/Tiny.pm b/lib/Class/Tiny.pm
index ab81973..fa4249f 100644
--- a/lib/Class/Tiny.pm
+++ b/lib/Class/Tiny.pm
@@ -22,16 +22,21 @@ sub import {
     no strict 'refs';
     my $class = shift;
     return unless $class eq __PACKAGE__; # NOP for subclasses
-    my $pkg   = caller;
-    my @attr  = @_;
+    my $pkg  = caller;
+    my @attr = grep {
+        defined and !ref and /^[^\W\d]\w*$/s
+          or Carp::croak "Invalid accessor name '$_'"
+    } @_;
     $CLASS_ATTRIBUTES{$pkg} = { map { $_ => 1 } @attr };
     my $child = !!@{"${pkg}::ISA"};
+    #<<< No perltidy
     eval join "\n", ## no critic: intentionally eval'ing subs here
-      "package $pkg;", ( $child ? () : "\@${pkg}::ISA = 'Class::Tiny';" ), map {
-        defined and !ref and /^[^\W\d]\w*$/s
-          or Carp::croak "Invalid accessor name '$_'";
+      "package $pkg;",
+      ( $child ? () : "\@${pkg}::ISA = 'Class::Tiny';" ),
+      map {
         "sub $_ { if (\@_ > 1) { \$_[0]->{$_} = \$_[1] } ; return \$_[0]->{$_} }\n"
-      } grep { !$pkg->can($_) } @attr;
+      } grep { ! *{"$pkg\::$_"}{CODE} } @attr;
+    #>>>
     Carp::croak("Failed to generate $pkg") if $@;
     return 1;
 }

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libclass-tiny-perl.git