r26713 - in /trunk/libmouse-perl: Changes SIGNATURE debian/changelog lib/Mouse.pm lib/Mouse/Meta/Attribute.pm
ghostbar-guest at users.alioth.debian.org
ghostbar-guest at users.alioth.debian.org
Sat Nov 8 01:15:42 UTC 2008
Author: ghostbar-guest
Date: Sat Nov 8 01:15:39 2008
New Revision: 26713
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=26713
Log:
new upstream release
Modified:
trunk/libmouse-perl/Changes
trunk/libmouse-perl/SIGNATURE
trunk/libmouse-perl/debian/changelog
trunk/libmouse-perl/lib/Mouse.pm
trunk/libmouse-perl/lib/Mouse/Meta/Attribute.pm
Modified: trunk/libmouse-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmouse-perl/Changes?rev=26713&op=diff
==============================================================================
--- trunk/libmouse-perl/Changes (original)
+++ trunk/libmouse-perl/Changes Sat Nov 8 01:15:39 2008
@@ -1,4 +1,9 @@
Revision history for Mouse
+
+0.11 Sun Nov 2 11:35:04 2008
+ * Throw an error if accessor/predicate/clearer/handles code eval fails
+
+ * Optimizations for generated methods, they should now be on par with Moose
0.10 Tue Oct 28 19:23:07 2008
* Require a recent Moose (which has the bugfix) for
Modified: trunk/libmouse-perl/SIGNATURE
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmouse-perl/SIGNATURE?rev=26713&op=diff
==============================================================================
--- trunk/libmouse-perl/SIGNATURE (original)
+++ trunk/libmouse-perl/SIGNATURE Sat Nov 8 01:15:39 2008
@@ -14,7 +14,7 @@
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1
-SHA1 fdf000e147c658e0c71d4a67b53823a02d232948 Changes
+SHA1 254275c2c70622b878f16f372538ea115fec9896 Changes
SHA1 a5e2f3617d68e03ef1cabecbfb2d7d056392e80e MANIFEST
SHA1 335359d8f94217d2bb2bb920142e2bb69f405cb4 META.yml
SHA1 8e9075a2329b302caa9794f77a3405cfb5dbae1f Makefile.PL
@@ -27,8 +27,8 @@
SHA1 ba005818ee9f97146bfa4e14e53c684e9e446902 inc/Module/Install/Metadata.pm
SHA1 85e6b1cf5b7ca81bfb469a99389fa947d4b8a08e inc/Module/Install/Win32.pm
SHA1 d32dff9f0d2f02023ca6d79a48d62fd855916351 inc/Module/Install/WriteAll.pm
-SHA1 741b0cfbaed069bd164f84ec28dae8b34a37debb lib/Mouse.pm
-SHA1 705e4fcc639495b4c5a647636d2f4f7198150914 lib/Mouse/Meta/Attribute.pm
+SHA1 f1d0ac1fbe33219835398da07e75dbb2d2bb8842 lib/Mouse.pm
+SHA1 577d0256db9a0c6efee6776aee5f0ee42b6ea398 lib/Mouse/Meta/Attribute.pm
SHA1 a19e7efdb27e298daca58fe71b06c4d8e3f9eeae lib/Mouse/Meta/Class.pm
SHA1 0236f03d46d8f3161c92114616e0b9928e724ef0 lib/Mouse/Meta/Role.pm
SHA1 c9a9f91760837221bd9096b7ed91e089d8e4a4cc lib/Mouse/Object.pm
@@ -91,7 +91,7 @@
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.7 (Darwin)
-iD8DBQFJB59EsxfQtHhyRPoRAlhiAJ0bD9V+nSVr+YJuJJThMaUnvgkuHACfQ/VT
-hZrrWxhol051+MU79b5H3Ug=
-=AO3E
+iD8DBQFJDdjBsxfQtHhyRPoRAlgLAJwKNNCmOgIx2HupvOyxSr7xUr0Q7wCdEQ0d
+bUgSJlQqd25RVCuXCkwBapY=
+=7/Kp
-----END PGP SIGNATURE-----
Modified: trunk/libmouse-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmouse-perl/debian/changelog?rev=26713&op=diff
==============================================================================
--- trunk/libmouse-perl/debian/changelog (original)
+++ trunk/libmouse-perl/debian/changelog Sat Nov 8 01:15:39 2008
@@ -1,3 +1,9 @@
+libmouse-perl (0.11-1) UNRELEASED; urgency=low
+
+ * (NOT RELEASED YET) New upstream release
+
+ -- Jose Luis Rivas <ghostbar38 at gmail.com> Fri, 07 Nov 2008 20:44:41 -0430
+
libmouse-perl (0.10-1) unstable; urgency=low
* New upstream release.
Modified: trunk/libmouse-perl/lib/Mouse.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmouse-perl/lib/Mouse.pm?rev=26713&op=diff
==============================================================================
--- trunk/libmouse-perl/lib/Mouse.pm (original)
+++ trunk/libmouse-perl/lib/Mouse.pm Sat Nov 8 01:15:39 2008
@@ -4,7 +4,7 @@
use warnings;
use base 'Exporter';
-our $VERSION = '0.10';
+our $VERSION = '0.11';
use 5.006;
use Carp 'confess';
Modified: trunk/libmouse-perl/lib/Mouse/Meta/Attribute.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libmouse-perl/lib/Mouse/Meta/Attribute.pm?rev=26713&op=diff
==============================================================================
--- trunk/libmouse-perl/lib/Mouse/Meta/Attribute.pm (original)
+++ trunk/libmouse-perl/lib/Mouse/Meta/Attribute.pm Sat Nov 8 01:15:39 2008
@@ -50,94 +50,114 @@
$_[0]->{_create_args}
}
+sub inlined_name {
+ my $self = shift;
+ my $name = $self->name;
+ my $key = "'" . $name . "'";
+ return $key;
+}
+
sub generate_accessor {
my $attribute = shift;
- my $name = $attribute->name;
- my $key = $name;
- my $default = $attribute->default;
- my $type = $attribute->type_constraint;
- my $constraint = $attribute->find_type_constraint;
- my $builder = $attribute->builder;
- my $trigger = $attribute->trigger;
-
- my $accessor = 'sub {
- my $self = shift;';
-
+ my $name = $attribute->name;
+ my $default = $attribute->default;
+ my $type = $attribute->type_constraint;
+ my $constraint = $attribute->find_type_constraint;
+ my $builder = $attribute->builder;
+ my $trigger = $attribute->trigger;
+ my $is_weak = $attribute->is_weak_ref;
+ my $should_deref = $attribute->should_auto_deref;
+
+ my $self = '$_[0]';
+ my $key = $attribute->inlined_name;
+
+ my $accessor = "sub {\n";
if ($attribute->_is_metadata eq 'rw') {
- $accessor .= 'if (@_) {
- local $_ = $_[0];';
+ $accessor .= 'if (scalar(@_) >= 2) {' . "\n";
+
+ my $value = '$_[1]';
if ($constraint) {
- $accessor .= 'unless ($constraint->()) {
+ $accessor .= 'local $_ = '.$value.';
+ unless ($constraint->()) {
my $display = defined($_) ? overload::StrVal($_) : "undef";
Carp::confess("Attribute ($name) does not pass the type constraint because: Validation failed for \'$type\' failed with value $display");
- }'
- }
-
- $accessor .= '$self->{$key} = $_;';
-
- if ($attribute->is_weak_ref) {
- $accessor .= 'weaken($self->{$key}) if ref($self->{$key});';
+ }' . "\n"
+ }
+
+ # if there's nothing left to do for the attribute we can return during
+ # this setter
+ $accessor .= 'return ' if !$is_weak && !$trigger && !$should_deref;
+
+ $accessor .= $self.'->{'.$key.'} = '.$value.';' . "\n";
+
+ if ($is_weak) {
+ $accessor .= 'weaken('.$self.'->{'.$key.'}) if ref('.$self.'->{'.$key.'});' . "\n";
}
if ($trigger) {
- $accessor .= '$trigger->($self, $_, $attribute);';
- }
-
- $accessor .= '}';
+ $accessor .= '$trigger->('.$self.', '.$value.', $attribute);' . "\n";
+ }
+
+ $accessor .= "}\n";
}
else {
- $accessor .= 'confess "Cannot assign a value to a read-only accessor" if @_;';
+ $accessor .= 'confess "Cannot assign a value to a read-only accessor" if scalar(@_) >= 2;' . "\n";
}
if ($attribute->is_lazy) {
- $accessor .= '$self->{$key} = ';
+ $accessor .= $self.'->{'.$key.'} = ';
$accessor .= $attribute->has_builder
- ? '$self->$builder'
- : ref($default) eq 'CODE'
- ? '$default->($self)'
- : '$default';
-
- $accessor .= ' if !exists($self->{$key});';
- }
-
- if ($attribute->should_auto_deref) {
+ ? $self.'->$builder'
+ : ref($default) eq 'CODE'
+ ? '$default->('.$self.')'
+ : '$default';
+ $accessor .= ' if !exists '.$self.'->{'.$key.'};' . "\n";
+ }
+
+ if ($should_deref) {
if ($attribute->type_constraint eq 'ArrayRef') {
$accessor .= 'if (wantarray) {
- return @{ $self->{$key} || [] };
+ return @{ '.$self.'->{'.$key.'} || [] };
}';
}
else {
$accessor .= 'if (wantarray) {
- return %{ $self->{$key} || {} };
+ return %{ '.$self.'->{'.$key.'} || {} };
}';
}
}
- $accessor .= 'return $self->{$key};
+ $accessor .= 'return '.$self.'->{'.$key.'};
}';
- return eval $accessor;
+ my $sub = eval $accessor;
+ confess $@ if $@;
+ return $sub;
}
sub generate_predicate {
my $attribute = shift;
- my $key = $attribute->name;
-
- my $predicate = 'sub { exists($_[0]->{$key}) }';
-
- return eval $predicate;
+ my $key = $attribute->inlined_name;
+
+ my $predicate = 'sub { exists($_[0]->{'.$key.'}) }';
+
+ my $sub = eval $predicate;
+ confess $@ if $@;
+ return $sub;
}
sub generate_clearer {
my $attribute = shift;
- my $key = $attribute->name;
-
- my $predicate = 'sub { delete($_[0]->{$key}) }';
-
- return eval $predicate;
+ my $key = $attribute->inlined_name;
+
+ my $clearer = 'sub { delete($_[0]->{'.$key.'}) }';
+
+ my $sub = eval $clearer;
+ confess $@ if $@;
+ return $sub;
}
sub generate_handles {
@@ -156,6 +176,7 @@
}';
$method_map{$local_method} = eval $method;
+ confess $@ if $@;
}
return \%method_map;
More information about the Pkg-perl-cvs-commits
mailing list