This is an automated email from the git hooks/post-receive script.
gregoa pushed a commit to annotated tag release-0.007
in repository libclass-tiny-perl.
commit 13bd5c3b2776e4943739227fe16d0b2d4f4b29be
Author: David Golden <dagol...@cpan.org>
Date: Sat Sep 7 13:17:07 2013 -0400
optimize accessors without defaults
---
Changes | 5 +++++
lib/Class/Tiny.pm | 39 ++++++++++++++++++---------------------
2 files changed, 23 insertions(+), 21 deletions(-)
diff --git a/Changes b/Changes
index 8d1e1c4..3b75625 100644
--- a/Changes
+++ b/Changes
@@ -2,6 +2,11 @@ Revision history for Class-Tiny
{{$NEXT}}
+ [OPTIMIZED]
+
+ - accessors without defaults are now much faster (comparable
+ to Class::Accessor::Fast)
+
0.006 2013-09-05 11:56:48 America/New_York
[ADDED]
diff --git a/lib/Class/Tiny.pm b/lib/Class/Tiny.pm
index 5f5e5e5..2a98f5a 100644
--- a/lib/Class/Tiny.pm
+++ b/lib/Class/Tiny.pm
@@ -35,27 +35,24 @@ sub create_attributes {
or Carp::croak "Invalid accessor name '$_'"
} keys %defaults;
$CLASS_ATTRIBUTES{$pkg}{$_} = $defaults{$_} for @attr;
- #<<< No perltidy
- eval join "\n", ## no critic: intentionally eval'ing subs here
- "package $pkg;\n",
- map {
- <<CODE
- sub $_ {
- if ( \@_ == 1 ) {
- if ( !exists \$_[0]{$_} && defined
\$CLASS_ATTRIBUTES{'$pkg'}{$_} ) {
- \$_[0]{$_} = ref \$CLASS_ATTRIBUTES{'$pkg'}{$_} eq 'CODE'
- ? \$CLASS_ATTRIBUTES{'$pkg'}{$_}->(\$_[0])
- : \$CLASS_ATTRIBUTES{'$pkg'}{$_};
- }
- return \$_[0]{$_};
- }
- else {
- return \$_[0]{$_} = \$_[1];
- }
- }
-CODE
- } grep { ! *{"$pkg\::$_"}{CODE} } @attr;
- #>>>
+ _gen_accessor( $pkg, $_ ) for grep { !*{"$pkg\::$_"}{CODE} } @attr;
+ Carp::croak("Failed to generate attributes for $pkg: $@\n") if $@;
+}
+
+sub _gen_accessor {
+ my ( $pkg, $name ) = @_;
+ my $default = $CLASS_ATTRIBUTES{$pkg}{$name};
+
+ my $sub = "sub $name { if (\@_ == 1) {";
+ if ( defined $default && ref $default eq 'CODE' ) {
+ $sub .= "if ( !exists \$_[0]{$name} ) { \$_[0]{$name} =
\$default->(\$_[0]) }";
+ }
+ elsif ( defined $default ) {
+ $sub .= "if ( !exists \$_[0]{$name} ) { \$_[0]{$name} = \$default }";
+ }
+ $sub .= "return \$_[0]{$name} } else { return \$_[0]{$name}=\$_[1] } }";
+
+ eval "package $pkg; $sub";
Carp::croak("Failed to generate attributes for $pkg: $@\n") if $@;
}
--
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
