r26740 - in /trunk/libclass-mop-perl: ./ debian/ lib/ lib/Class/ lib/Class/MOP/ lib/Class/MOP/Method/ t/
eloy at users.alioth.debian.org
eloy at users.alioth.debian.org
Mon Nov 10 09:50:15 UTC 2008
Author: eloy
Date: Mon Nov 10 09:50:11 2008
New Revision: 26740
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=26740
Log:
new upstream version
Modified:
trunk/libclass-mop-perl/Changes
trunk/libclass-mop-perl/META.yml
trunk/libclass-mop-perl/README
trunk/libclass-mop-perl/debian/changelog
trunk/libclass-mop-perl/lib/Class/MOP.pm
trunk/libclass-mop-perl/lib/Class/MOP/Attribute.pm
trunk/libclass-mop-perl/lib/Class/MOP/Class.pm
trunk/libclass-mop-perl/lib/Class/MOP/Immutable.pm
trunk/libclass-mop-perl/lib/Class/MOP/Instance.pm
trunk/libclass-mop-perl/lib/Class/MOP/Method.pm
trunk/libclass-mop-perl/lib/Class/MOP/Method/Accessor.pm
trunk/libclass-mop-perl/lib/Class/MOP/Method/Constructor.pm
trunk/libclass-mop-perl/lib/Class/MOP/Method/Generated.pm
trunk/libclass-mop-perl/lib/Class/MOP/Method/Wrapped.pm
trunk/libclass-mop-perl/lib/Class/MOP/Module.pm
trunk/libclass-mop-perl/lib/Class/MOP/Object.pm
trunk/libclass-mop-perl/lib/Class/MOP/Package.pm
trunk/libclass-mop-perl/lib/metaclass.pm
trunk/libclass-mop-perl/t/031_method_modifiers.t
Modified: trunk/libclass-mop-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/Changes?rev=26740&op=diff
==============================================================================
--- trunk/libclass-mop-perl/Changes (original)
+++ trunk/libclass-mop-perl/Changes Mon Nov 10 09:50:11 2008
@@ -1,6 +1,11 @@
Revision history for Perl extension Class-MOP.
-0.68 Fri October 25, 2008
+0.69 Fri, November 7, 2008
+ * Class::MOP::Method::Wrapped
+ - Added introspection methods for method modifiers (Dave Rolsky)
+
+
+0.68 Fri October 24, 2008
* Class::MOP
- Make load_class require by file name instead of module name.
This stops confusing error messages when loading '__PACKAGE__'.
Modified: trunk/libclass-mop-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/META.yml?rev=26740&op=diff
==============================================================================
--- trunk/libclass-mop-perl/META.yml (original)
+++ trunk/libclass-mop-perl/META.yml Mon Nov 10 09:50:11 2008
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Class-MOP
-version: 0.68
+version: 0.69
abstract: A Meta Object Protocol for Perl 5
author:
- Stevan Little <stevan at iinteractive.com>
@@ -22,7 +22,7 @@
directory:
- t
- inc
-generated_by: ExtUtils::MakeMaker version 6.46
+generated_by: ExtUtils::MakeMaker version 6.48
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
Modified: trunk/libclass-mop-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/README?rev=26740&op=diff
==============================================================================
--- trunk/libclass-mop-perl/README (original)
+++ trunk/libclass-mop-perl/README Mon Nov 10 09:50:11 2008
@@ -1,4 +1,4 @@
-Class::MOP version 0.68
+Class::MOP version 0.69
===========================
See the individual module documentation for more information
Modified: trunk/libclass-mop-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/debian/changelog?rev=26740&op=diff
==============================================================================
--- trunk/libclass-mop-perl/debian/changelog (original)
+++ trunk/libclass-mop-perl/debian/changelog Mon Nov 10 09:50:11 2008
@@ -1,3 +1,9 @@
+libclass-mop-perl (0.69-1) UNRELEASED; urgency=low
+
+ * (NOT RELEASED YET) New upstream release
+
+ -- Krzysztof Krzyżaniak (eloy) <eloy at debian.org> Mon, 10 Nov 2008 10:49:35 +0100
+
libclass-mop-perl (0.68-1) unstable; urgency=low
* New upstream release
Modified: trunk/libclass-mop-perl/lib/Class/MOP.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/lib/Class/MOP.pm?rev=26740&op=diff
==============================================================================
--- trunk/libclass-mop-perl/lib/Class/MOP.pm (original)
+++ trunk/libclass-mop-perl/lib/Class/MOP.pm Mon Nov 10 09:50:11 2008
@@ -31,7 +31,7 @@
*check_package_cache_flag = \&mro::get_pkg_gen;
}
-our $VERSION = '0.68';
+our $VERSION = '0.69';
our $XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
Modified: trunk/libclass-mop-perl/lib/Class/MOP/Attribute.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/lib/Class/MOP/Attribute.pm?rev=26740&op=diff
==============================================================================
--- trunk/libclass-mop-perl/lib/Class/MOP/Attribute.pm (original)
+++ trunk/libclass-mop-perl/lib/Class/MOP/Attribute.pm Mon Nov 10 09:50:11 2008
@@ -9,7 +9,7 @@
use Carp 'confess';
use Scalar::Util 'blessed', 'weaken';
-our $VERSION = '0.68';
+our $VERSION = '0.69';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
@@ -241,7 +241,7 @@
}
sub is_default_a_coderef {
- ('CODE' eq ref($_[0]->{'default'} || $_[0]->{default}))
+ ('CODE' eq ref($_[0]->{'default'}))
}
sub default {
Modified: trunk/libclass-mop-perl/lib/Class/MOP/Class.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/lib/Class/MOP/Class.pm?rev=26740&op=diff
==============================================================================
--- trunk/libclass-mop-perl/lib/Class/MOP/Class.pm (original)
+++ trunk/libclass-mop-perl/lib/Class/MOP/Class.pm Mon Nov 10 09:50:11 2008
@@ -11,7 +11,7 @@
use Carp 'confess';
use Scalar::Util 'blessed', 'weaken';
-our $VERSION = '0.68';
+our $VERSION = '0.69';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
@@ -1477,7 +1477,7 @@
Wrap a code ref (C<$attrs{body>) with C<method_metaclass>.
-=item B<add_method ($method_name, $method, %attrs)>
+=item B<add_method ($method_name, $method)>
This will take a C<$method_name> and CODE reference or meta method
objectand install it into the class's package.
Modified: trunk/libclass-mop-perl/lib/Class/MOP/Immutable.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/lib/Class/MOP/Immutable.pm?rev=26740&op=diff
==============================================================================
--- trunk/libclass-mop-perl/lib/Class/MOP/Immutable.pm (original)
+++ trunk/libclass-mop-perl/lib/Class/MOP/Immutable.pm Mon Nov 10 09:50:11 2008
@@ -9,7 +9,7 @@
use Carp 'confess';
use Scalar::Util 'blessed';
-our $VERSION = '0.68';
+our $VERSION = '0.69';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
Modified: trunk/libclass-mop-perl/lib/Class/MOP/Instance.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/lib/Class/MOP/Instance.pm?rev=26740&op=diff
==============================================================================
--- trunk/libclass-mop-perl/lib/Class/MOP/Instance.pm (original)
+++ trunk/libclass-mop-perl/lib/Class/MOP/Instance.pm Mon Nov 10 09:50:11 2008
@@ -6,7 +6,7 @@
use Scalar::Util 'weaken', 'blessed';
-our $VERSION = '0.68';
+our $VERSION = '0.69';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
Modified: trunk/libclass-mop-perl/lib/Class/MOP/Method.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/lib/Class/MOP/Method.pm?rev=26740&op=diff
==============================================================================
--- trunk/libclass-mop-perl/lib/Class/MOP/Method.pm (original)
+++ trunk/libclass-mop-perl/lib/Class/MOP/Method.pm Mon Nov 10 09:50:11 2008
@@ -7,7 +7,7 @@
use Carp 'confess';
use Scalar::Util 'weaken';
-our $VERSION = '0.68';
+our $VERSION = '0.69';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
Modified: trunk/libclass-mop-perl/lib/Class/MOP/Method/Accessor.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/lib/Class/MOP/Method/Accessor.pm?rev=26740&op=diff
==============================================================================
--- trunk/libclass-mop-perl/lib/Class/MOP/Method/Accessor.pm (original)
+++ trunk/libclass-mop-perl/lib/Class/MOP/Method/Accessor.pm Mon Nov 10 09:50:11 2008
@@ -7,7 +7,7 @@
use Carp 'confess';
use Scalar::Util 'blessed', 'weaken';
-our $VERSION = '0.68';
+our $VERSION = '0.69';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
Modified: trunk/libclass-mop-perl/lib/Class/MOP/Method/Constructor.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/lib/Class/MOP/Method/Constructor.pm?rev=26740&op=diff
==============================================================================
--- trunk/libclass-mop-perl/lib/Class/MOP/Method/Constructor.pm (original)
+++ trunk/libclass-mop-perl/lib/Class/MOP/Method/Constructor.pm Mon Nov 10 09:50:11 2008
@@ -7,7 +7,7 @@
use Carp 'confess';
use Scalar::Util 'blessed', 'weaken', 'looks_like_number';
-our $VERSION = '0.68';
+our $VERSION = '0.69';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
Modified: trunk/libclass-mop-perl/lib/Class/MOP/Method/Generated.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/lib/Class/MOP/Method/Generated.pm?rev=26740&op=diff
==============================================================================
--- trunk/libclass-mop-perl/lib/Class/MOP/Method/Generated.pm (original)
+++ trunk/libclass-mop-perl/lib/Class/MOP/Method/Generated.pm Mon Nov 10 09:50:11 2008
@@ -6,7 +6,7 @@
use Carp 'confess';
-our $VERSION = '0.68';
+our $VERSION = '0.69';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
Modified: trunk/libclass-mop-perl/lib/Class/MOP/Method/Wrapped.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/lib/Class/MOP/Method/Wrapped.pm?rev=26740&op=diff
==============================================================================
--- trunk/libclass-mop-perl/lib/Class/MOP/Method/Wrapped.pm (original)
+++ trunk/libclass-mop-perl/lib/Class/MOP/Method/Wrapped.pm Mon Nov 10 09:50:11 2008
@@ -7,7 +7,7 @@
use Carp 'confess';
use Scalar::Util 'blessed';
-our $VERSION = '0.68';
+our $VERSION = '0.69';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
@@ -108,11 +108,21 @@
$_build_wrapped_method->($code->{'modifier_table'});
}
+sub before_modifiers {
+ my $code = shift;
+ return @{$code->{'modifier_table'}->{before}};
+}
+
sub add_after_modifier {
my $code = shift;
my $modifier = shift;
push @{$code->{'modifier_table'}->{after}} => $modifier;
$_build_wrapped_method->($code->{'modifier_table'});
+}
+
+sub after_modifiers {
+ my $code = shift;
+ return @{$code->{'modifier_table'}->{after}};
}
{
@@ -142,6 +152,11 @@
}
}
+sub around_modifiers {
+ my $code = shift;
+ return @{$code->{'modifier_table'}->{around}->{methods}};
+}
+
1;
__END__
@@ -191,6 +206,19 @@
=back
+These three methods each returna list of method modifiers I<in the
+order in which they are run>.
+
+=over 4
+
+=item B<before_modifiers>
+
+=item B<after_modifiers>
+
+=item B<around_modifiers>
+
+=back
+
=head1 AUTHORS
Stevan Little E<lt>stevan at iinteractive.comE<gt>
Modified: trunk/libclass-mop-perl/lib/Class/MOP/Module.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/lib/Class/MOP/Module.pm?rev=26740&op=diff
==============================================================================
--- trunk/libclass-mop-perl/lib/Class/MOP/Module.pm (original)
+++ trunk/libclass-mop-perl/lib/Class/MOP/Module.pm Mon Nov 10 09:50:11 2008
@@ -6,7 +6,7 @@
use Scalar::Util 'blessed';
-our $VERSION = '0.68';
+our $VERSION = '0.69';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
Modified: trunk/libclass-mop-perl/lib/Class/MOP/Object.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/lib/Class/MOP/Object.pm?rev=26740&op=diff
==============================================================================
--- trunk/libclass-mop-perl/lib/Class/MOP/Object.pm (original)
+++ trunk/libclass-mop-perl/lib/Class/MOP/Object.pm Mon Nov 10 09:50:11 2008
@@ -6,7 +6,7 @@
use Scalar::Util 'blessed';
-our $VERSION = '0.68';
+our $VERSION = '0.69';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
Modified: trunk/libclass-mop-perl/lib/Class/MOP/Package.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/lib/Class/MOP/Package.pm?rev=26740&op=diff
==============================================================================
--- trunk/libclass-mop-perl/lib/Class/MOP/Package.pm (original)
+++ trunk/libclass-mop-perl/lib/Class/MOP/Package.pm Mon Nov 10 09:50:11 2008
@@ -7,7 +7,7 @@
use Scalar::Util 'blessed';
use Carp 'confess';
-our $VERSION = '0.68';
+our $VERSION = '0.69';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
Modified: trunk/libclass-mop-perl/lib/metaclass.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/lib/metaclass.pm?rev=26740&op=diff
==============================================================================
--- trunk/libclass-mop-perl/lib/metaclass.pm (original)
+++ trunk/libclass-mop-perl/lib/metaclass.pm Mon Nov 10 09:50:11 2008
@@ -7,7 +7,7 @@
use Carp 'confess';
use Scalar::Util 'blessed';
-our $VERSION = '0.68';
+our $VERSION = '0.69';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
Modified: trunk/libclass-mop-perl/t/031_method_modifiers.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/t/031_method_modifiers.t?rev=26740&op=diff
==============================================================================
--- trunk/libclass-mop-perl/t/031_method_modifiers.t (original)
+++ trunk/libclass-mop-perl/t/031_method_modifiers.t Mon Nov 10 09:50:11 2008
@@ -3,129 +3,208 @@
use strict;
use warnings;
-use Test::More tests => 26;
+use Test::More tests => 28;
use Test::Exception;
-BEGIN {
- use_ok('Class::MOP');
- use_ok('Class::MOP::Method');
-}
+use Class::MOP;
+use Class::MOP::Method;
# test before and afters
{
- my $trace = '';
-
- my $method = Class::MOP::Method->wrap(
- body => sub { $trace .= 'primary' },
- package_name => 'main',
- name => '__ANON__',
- );
- isa_ok($method, 'Class::MOP::Method');
-
- $method->();
- is($trace, 'primary', '... got the right return value from method');
- $trace = '';
-
- my $wrapped = Class::MOP::Method::Wrapped->wrap($method);
- isa_ok($wrapped, 'Class::MOP::Method::Wrapped');
- isa_ok($wrapped, 'Class::MOP::Method');
-
- $wrapped->();
- is($trace, 'primary', '... got the right return value from the wrapped method');
- $trace = '';
-
- lives_ok {
- $wrapped->add_before_modifier(sub { $trace .= 'before -> ' });
- } '... added the before modifier okay';
-
- $wrapped->();
- is($trace, 'before -> primary', '... got the right return value from the wrapped method (w/ before)');
- $trace = '';
-
- lives_ok {
- $wrapped->add_after_modifier(sub { $trace .= ' -> after' });
- } '... added the after modifier okay';
-
- $wrapped->();
- is($trace, 'before -> primary -> after', '... got the right return value from the wrapped method (w/ before)');
- $trace = '';
+ my $trace = '';
+
+ my $method = Class::MOP::Method->wrap(
+ body => sub { $trace .= 'primary' },
+ package_name => 'main',
+ name => '__ANON__',
+ );
+ isa_ok( $method, 'Class::MOP::Method' );
+
+ $method->();
+ is( $trace, 'primary', '... got the right return value from method' );
+ $trace = '';
+
+ my $wrapped = Class::MOP::Method::Wrapped->wrap($method);
+ isa_ok( $wrapped, 'Class::MOP::Method::Wrapped' );
+ isa_ok( $wrapped, 'Class::MOP::Method' );
+
+ $wrapped->();
+ is( $trace, 'primary',
+ '... got the right return value from the wrapped method' );
+ $trace = '';
+
+ lives_ok {
+ $wrapped->add_before_modifier( sub { $trace .= 'before -> ' } );
+ }
+ '... added the before modifier okay';
+
+ $wrapped->();
+ is( $trace, 'before -> primary',
+ '... got the right return value from the wrapped method (w/ before)'
+ );
+ $trace = '';
+
+ lives_ok {
+ $wrapped->add_after_modifier( sub { $trace .= ' -> after' } );
+ }
+ '... added the after modifier okay';
+
+ $wrapped->();
+ is( $trace, 'before -> primary -> after',
+ '... got the right return value from the wrapped method (w/ before)'
+ );
+ $trace = '';
}
# test around method
{
- my $method = Class::MOP::Method->wrap(
- sub { 4 },
- package_name => 'main',
- name => '__ANON__',
- );
- isa_ok($method, 'Class::MOP::Method');
-
- is($method->(), 4, '... got the right value from the wrapped method');
-
- my $wrapped = Class::MOP::Method::Wrapped->wrap($method);
- isa_ok($wrapped, 'Class::MOP::Method::Wrapped');
- isa_ok($wrapped, 'Class::MOP::Method');
-
- is($wrapped->(), 4, '... got the right value from the wrapped method');
-
- lives_ok {
- $wrapped->add_around_modifier(sub { (3, $_[0]->()) });
- $wrapped->add_around_modifier(sub { (2, $_[0]->()) });
- $wrapped->add_around_modifier(sub { (1, $_[0]->()) });
- $wrapped->add_around_modifier(sub { (0, $_[0]->()) });
- } '... added the around modifier okay';
-
- is_deeply(
- [ $wrapped->() ],
- [ 0, 1, 2, 3, 4 ],
- '... got the right results back from the around methods (in list context)');
-
- is(scalar $wrapped->(), 4, '... got the right results back from the around methods (in scalar context)');
-}
-
-{
- my @tracelog;
-
- my $method = Class::MOP::Method->wrap(
- sub { push @tracelog => 'primary' },
- package_name => 'main',
- name => '__ANON__',
- );
- isa_ok($method, 'Class::MOP::Method');
-
- my $wrapped = Class::MOP::Method::Wrapped->wrap($method);
- isa_ok($wrapped, 'Class::MOP::Method::Wrapped');
- isa_ok($wrapped, 'Class::MOP::Method');
-
- lives_ok {
- $wrapped->add_before_modifier(sub { push @tracelog => 'before 1' });
- $wrapped->add_before_modifier(sub { push @tracelog => 'before 2' });
- $wrapped->add_before_modifier(sub { push @tracelog => 'before 3' });
- } '... added the before modifier okay';
-
- lives_ok {
- $wrapped->add_around_modifier(sub { push @tracelog => 'around 1'; $_[0]->(); });
- $wrapped->add_around_modifier(sub { push @tracelog => 'around 2'; $_[0]->(); });
- $wrapped->add_around_modifier(sub { push @tracelog => 'around 3'; $_[0]->(); });
- } '... added the around modifier okay';
-
- lives_ok {
- $wrapped->add_after_modifier(sub { push @tracelog => 'after 1' });
- $wrapped->add_after_modifier(sub { push @tracelog => 'after 2' });
- $wrapped->add_after_modifier(sub { push @tracelog => 'after 3' });
- } '... added the after modifier okay';
-
- $wrapped->();
- is_deeply(
- \@tracelog,
- [
- 'before 3', 'before 2', 'before 1', # last-in-first-out order
- 'around 3', 'around 2', 'around 1', # last-in-first-out order
- 'primary',
- 'after 1', 'after 2', 'after 3', # first-in-first-out order
- ],
- '... got the right tracelog from all our before/around/after methods');
-}
-
-
-
+ my $method = Class::MOP::Method->wrap(
+ sub {4},
+ package_name => 'main',
+ name => '__ANON__',
+ );
+ isa_ok( $method, 'Class::MOP::Method' );
+
+ is( $method->(), 4, '... got the right value from the wrapped method' );
+
+ my $wrapped = Class::MOP::Method::Wrapped->wrap($method);
+ isa_ok( $wrapped, 'Class::MOP::Method::Wrapped' );
+ isa_ok( $wrapped, 'Class::MOP::Method' );
+
+ is( $wrapped->(), 4, '... got the right value from the wrapped method' );
+
+ lives_ok {
+ $wrapped->add_around_modifier( sub { ( 3, $_[0]->() ) } );
+ $wrapped->add_around_modifier( sub { ( 2, $_[0]->() ) } );
+ $wrapped->add_around_modifier( sub { ( 1, $_[0]->() ) } );
+ $wrapped->add_around_modifier( sub { ( 0, $_[0]->() ) } );
+ }
+ '... added the around modifier okay';
+
+ is_deeply(
+ [ $wrapped->() ],
+ [ 0, 1, 2, 3, 4 ],
+ '... got the right results back from the around methods (in list context)'
+ );
+
+ is( scalar $wrapped->(), 4,
+ '... got the right results back from the around methods (in scalar context)'
+ );
+}
+
+{
+ my @tracelog;
+
+ my $method = Class::MOP::Method->wrap(
+ sub { push @tracelog => 'primary' },
+ package_name => 'main',
+ name => '__ANON__',
+ );
+ isa_ok( $method, 'Class::MOP::Method' );
+
+ my $wrapped = Class::MOP::Method::Wrapped->wrap($method);
+ isa_ok( $wrapped, 'Class::MOP::Method::Wrapped' );
+ isa_ok( $wrapped, 'Class::MOP::Method' );
+
+ lives_ok {
+ $wrapped->add_before_modifier( sub { push @tracelog => 'before 1' } );
+ $wrapped->add_before_modifier( sub { push @tracelog => 'before 2' } );
+ $wrapped->add_before_modifier( sub { push @tracelog => 'before 3' } );
+ }
+ '... added the before modifier okay';
+
+ lives_ok {
+ $wrapped->add_around_modifier(
+ sub { push @tracelog => 'around 1'; $_[0]->(); } );
+ $wrapped->add_around_modifier(
+ sub { push @tracelog => 'around 2'; $_[0]->(); } );
+ $wrapped->add_around_modifier(
+ sub { push @tracelog => 'around 3'; $_[0]->(); } );
+ }
+ '... added the around modifier okay';
+
+ lives_ok {
+ $wrapped->add_after_modifier( sub { push @tracelog => 'after 1' } );
+ $wrapped->add_after_modifier( sub { push @tracelog => 'after 2' } );
+ $wrapped->add_after_modifier( sub { push @tracelog => 'after 3' } );
+ }
+ '... added the after modifier okay';
+
+ $wrapped->();
+ is_deeply(
+ \@tracelog,
+ [
+ 'before 3', 'before 2', 'before 1', # last-in-first-out order
+ 'around 3', 'around 2', 'around 1', # last-in-first-out order
+ 'primary',
+ 'after 1', 'after 2', 'after 3', # first-in-first-out order
+ ],
+ '... got the right tracelog from all our before/around/after methods'
+ );
+}
+
+# test introspection
+{
+ sub before1 {
+ }
+
+ sub before2 {
+ }
+
+ sub before3 {
+ }
+
+ sub after1 {
+ }
+
+ sub after2 {
+ }
+
+ sub after3 {
+ }
+
+ sub around1 {
+ }
+
+ sub around2 {
+ }
+
+ sub around3 {
+ }
+
+ sub orig {
+ }
+
+ my $method = Class::MOP::Method->wrap(
+ body => \&orig,
+ package_name => 'main',
+ name => '__ANON__',
+ );
+
+ my $wrapped = Class::MOP::Method::Wrapped->wrap($method);
+
+ $wrapped->add_before_modifier($_)
+ for \&before1, \&before2, \&before3;
+
+ $wrapped->add_after_modifier($_)
+ for \&after1, \&after2, \&after3;
+
+ $wrapped->add_around_modifier($_)
+ for \&around1, \&around2, \&around3;
+
+ is( $wrapped->get_original_method, $method,
+ 'check get_original_method' );
+
+ is_deeply( [ $wrapped->before_modifiers ],
+ [ \&before3, \&before2, \&before1 ],
+ 'check before_modifiers' );
+
+ is_deeply( [ $wrapped->after_modifiers ],
+ [ \&after1, \&after2, \&after3 ],
+ 'check after_modifiers' );
+
+ is_deeply( [ $wrapped->around_modifiers ],
+ [ \&around3, \&around2, \&around1 ],
+ 'check around_modifiers' );
+}
+
More information about the Pkg-perl-cvs-commits
mailing list