r12984 - in /branches/upstream/libclass-mop-perl/current: ./ examples/ lib/ lib/Class/ lib/Class/MOP/ lib/Class/MOP/Method/ t/
gregoa-guest at users.alioth.debian.org
gregoa-guest at users.alioth.debian.org
Fri Jan 18 21:40:03 UTC 2008
Author: gregoa-guest
Date: Fri Jan 18 21:40:03 2008
New Revision: 12984
URL: http://svn.debian.org/wsvn/?sc=1&rev=12984
Log:
[svn-upgrade] Integrating new upstream version, libclass-mop-perl (0.51)
Modified:
branches/upstream/libclass-mop-perl/current/Changes
branches/upstream/libclass-mop-perl/current/META.yml
branches/upstream/libclass-mop-perl/current/MOP.xs
branches/upstream/libclass-mop-perl/current/README
branches/upstream/libclass-mop-perl/current/examples/ArrayBasedStorage.pod
branches/upstream/libclass-mop-perl/current/examples/AttributesWithHistory.pod
branches/upstream/libclass-mop-perl/current/examples/C3MethodDispatchOrder.pod
branches/upstream/libclass-mop-perl/current/examples/ClassEncapsulatedAttributes.pod
branches/upstream/libclass-mop-perl/current/examples/InsideOutClass.pod
branches/upstream/libclass-mop-perl/current/examples/InstanceCountingClass.pod
branches/upstream/libclass-mop-perl/current/examples/LazyClass.pod
branches/upstream/libclass-mop-perl/current/examples/Perl6Attribute.pod
branches/upstream/libclass-mop-perl/current/lib/Class/MOP.pm
branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Attribute.pm
branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Class.pm
branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Immutable.pm
branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Instance.pm
branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method.pm
branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Accessor.pm
branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Constructor.pm
branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Generated.pm
branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Wrapped.pm
branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Module.pm
branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Object.pm
branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Package.pm
branches/upstream/libclass-mop-perl/current/lib/metaclass.pm
branches/upstream/libclass-mop-perl/current/t/010_self_introspection.t
Modified: branches/upstream/libclass-mop-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/Changes?rev=12984&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/Changes (original)
+++ branches/upstream/libclass-mop-perl/current/Changes Fri Jan 18 21:40:03 2008
@@ -1,4 +1,29 @@
Revision history for Perl extension Class-MOP.
+
+0.51 Mon. Jan. 14, 2008
+ ~~~ some misc. doc. fixes ~~~
+ ~~ updated copyright dates ~~
+
+ * Class::MOP
+ - now sets the IS_RUNNING_ON_5_10
+ constant so that we can take advantage
+ of some of the nice bits of 5.10
+
+ * Class::MOP::Class
+ - uses the IS_RUNNING_ON_5_10 flag to
+ optimize the &linearized_isa method
+ and avoid the hack/check for circular
+ inheritence in &class_precedence_list
+ - added rebless_instance method (Sartak)
+ - added tests for this
+
+ * Class::MOP::Immutable
+ - the immutable class now keeps track of
+ the transformer which immutablized it
+
+ * Class::MOP::Instance
+ - added rebless_instance_structure method (Sartak)
+ - added tests for this
0.50 Fri. Dec. 21, 2007
* Class::MOP::Class
Modified: branches/upstream/libclass-mop-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/META.yml?rev=12984&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/META.yml (original)
+++ branches/upstream/libclass-mop-perl/current/META.yml Fri Jan 18 21:40:03 2008
@@ -20,16 +20,16 @@
provides:
Class::MOP:
file: lib/Class/MOP.pm
- version: 0.50
+ version: 0.51
Class::MOP::Attribute:
file: lib/Class/MOP/Attribute.pm
- version: 0.21
+ version: 0.22
Class::MOP::Class:
file: lib/Class/MOP/Class.pm
- version: 0.25
+ version: 0.26
Class::MOP::Immutable:
file: lib/Class/MOP/Immutable.pm
- version: 0.03
+ version: 0.04
Class::MOP::Instance:
file: lib/Class/MOP/Instance.pm
version: 0.03
@@ -64,4 +64,4 @@
Carp: 0
Scalar::Util: 1.18
Sub::Name: 0.02
-version: 0.50
+version: 0.51
Modified: branches/upstream/libclass-mop-perl/current/MOP.xs
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/MOP.xs?rev=12984&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/MOP.xs (original)
+++ branches/upstream/libclass-mop-perl/current/MOP.xs Fri Jan 18 21:40:03 2008
@@ -16,6 +16,8 @@
*/
MODULE = Class::MOP PACKAGE = Class::MOP
+
+PROTOTYPES: ENABLE
SV*
check_package_cache_flag(pkg)
Modified: branches/upstream/libclass-mop-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/README?rev=12984&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/README (original)
+++ branches/upstream/libclass-mop-perl/current/README Fri Jan 18 21:40:03 2008
@@ -1,4 +1,4 @@
-Class::MOP version 0.50
+Class::MOP version 0.51
===========================
See the individual module documentation for more information
@@ -23,7 +23,7 @@
COPYRIGHT AND LICENCE
-Copyright (C) 2006, 2007 Infinity Interactive, Inc.
+Copyright (C) 2006-2008 Infinity Interactive, Inc.
http://www.iinteractive.com
Modified: branches/upstream/libclass-mop-perl/current/examples/ArrayBasedStorage.pod
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/examples/ArrayBasedStorage.pod?rev=12984&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/examples/ArrayBasedStorage.pod (original)
+++ branches/upstream/libclass-mop-perl/current/examples/ArrayBasedStorage.pod Fri Jan 18 21:40:03 2008
@@ -121,7 +121,7 @@
=head1 COPYRIGHT AND LICENSE
-Copyright 2006, 2007 by Infinity Interactive, Inc.
+Copyright 2006-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
Modified: branches/upstream/libclass-mop-perl/current/examples/AttributesWithHistory.pod
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/examples/AttributesWithHistory.pod?rev=12984&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/examples/AttributesWithHistory.pod (original)
+++ branches/upstream/libclass-mop-perl/current/examples/AttributesWithHistory.pod Fri Jan 18 21:40:03 2008
@@ -126,7 +126,7 @@
=head1 COPYRIGHT AND LICENSE
-Copyright 2006, 2007 by Infinity Interactive, Inc.
+Copyright 2006-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
Modified: branches/upstream/libclass-mop-perl/current/examples/C3MethodDispatchOrder.pod
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/examples/C3MethodDispatchOrder.pod?rev=12984&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/examples/C3MethodDispatchOrder.pod (original)
+++ branches/upstream/libclass-mop-perl/current/examples/C3MethodDispatchOrder.pod Fri Jan 18 21:40:03 2008
@@ -129,7 +129,7 @@
=head1 COPYRIGHT AND LICENSE
-Copyright 2006, 2007 by Infinity Interactive, Inc.
+Copyright 2006-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
Modified: branches/upstream/libclass-mop-perl/current/examples/ClassEncapsulatedAttributes.pod
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/examples/ClassEncapsulatedAttributes.pod?rev=12984&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/examples/ClassEncapsulatedAttributes.pod (original)
+++ branches/upstream/libclass-mop-perl/current/examples/ClassEncapsulatedAttributes.pod Fri Jan 18 21:40:03 2008
@@ -141,7 +141,7 @@
=head1 COPYRIGHT AND LICENSE
-Copyright 2006, 2007 by Infinity Interactive, Inc.
+Copyright 2006-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
Modified: branches/upstream/libclass-mop-perl/current/examples/InsideOutClass.pod
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/examples/InsideOutClass.pod?rev=12984&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/examples/InsideOutClass.pod (original)
+++ branches/upstream/libclass-mop-perl/current/examples/InsideOutClass.pod Fri Jan 18 21:40:03 2008
@@ -185,7 +185,7 @@
=head1 COPYRIGHT AND LICENSE
-Copyright 2006, 2007 by Infinity Interactive, Inc.
+Copyright 2006-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
Modified: branches/upstream/libclass-mop-perl/current/examples/InstanceCountingClass.pod
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/examples/InstanceCountingClass.pod?rev=12984&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/examples/InstanceCountingClass.pod (original)
+++ branches/upstream/libclass-mop-perl/current/examples/InstanceCountingClass.pod Fri Jan 18 21:40:03 2008
@@ -63,7 +63,7 @@
=head1 COPYRIGHT AND LICENSE
-Copyright 2006, 2007 by Infinity Interactive, Inc.
+Copyright 2006-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
Modified: branches/upstream/libclass-mop-perl/current/examples/LazyClass.pod
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/examples/LazyClass.pod?rev=12984&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/examples/LazyClass.pod (original)
+++ branches/upstream/libclass-mop-perl/current/examples/LazyClass.pod Fri Jan 18 21:40:03 2008
@@ -153,7 +153,7 @@
=head1 COPYRIGHT AND LICENSE
-Copyright 2006, 2007 by Infinity Interactive, Inc.
+Copyright 2006-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
Modified: branches/upstream/libclass-mop-perl/current/examples/Perl6Attribute.pod
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/examples/Perl6Attribute.pod?rev=12984&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/examples/Perl6Attribute.pod (original)
+++ branches/upstream/libclass-mop-perl/current/examples/Perl6Attribute.pod Fri Jan 18 21:40:03 2008
@@ -73,7 +73,7 @@
=head1 COPYRIGHT AND LICENSE
-Copyright 2006, 2007 by Infinity Interactive, Inc.
+Copyright 2006-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
Modified: branches/upstream/libclass-mop-perl/current/lib/Class/MOP.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/lib/Class/MOP.pm?rev=12984&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/lib/Class/MOP.pm (original)
+++ branches/upstream/libclass-mop-perl/current/lib/Class/MOP.pm Fri Jan 18 21:40:03 2008
@@ -14,15 +14,20 @@
use Class::MOP::Immutable;
BEGIN {
- our $VERSION = '0.50';
+ our $VERSION = '0.51';
our $AUTHORITY = 'cpan:STEVAN';
use XSLoader;
XSLoader::load( 'Class::MOP', $VERSION );
unless ($] < 5.009_005) {
+ require mro;
no warnings 'redefine', 'prototype';
*check_package_cache_flag = \&mro::get_pkg_gen;
+ *IS_RUNNING_ON_5_10 = sub () { 1 };
+ }
+ else {
+ *IS_RUNNING_ON_5_10 = sub () { 0 };
}
}
@@ -69,14 +74,14 @@
}
sub is_class_loaded {
- my $class = shift;
- no strict 'refs';
- return 1 if defined ${"${class}::VERSION"} || defined @{"${class}::ISA"};
- foreach (keys %{"${class}::"}) {
- next if substr($_, -2, 2) eq '::';
- return 1 if defined &{"${class}::$_"};
- }
- return 0;
+ my $class = shift;
+ no strict 'refs';
+ return 1 if defined ${"${class}::VERSION"} || defined @{"${class}::ISA"};
+ foreach (keys %{"${class}::"}) {
+ next if substr($_, -2, 2) eq '::';
+ return 1 if defined &{"${class}::$_"};
+ }
+ return 0;
}
@@ -724,6 +729,18 @@
=head1 FUNCTIONS
+=head2 Constants
+
+=over 4
+
+=item I<IS_RUNNING_ON_5_10>
+
+We set this constant depending on what version perl we are on, this
+allows us to take advantage of new 5.10 features and stay backwards
+compat.
+
+=back
+
=head2 Utility functions
=over 4
@@ -899,7 +916,7 @@
=head1 COPYRIGHT AND LICENSE
-Copyright 2006, 2007 by Infinity Interactive, Inc.
+Copyright 2006-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
Modified: branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Attribute.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Attribute.pm?rev=12984&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Attribute.pm (original)
+++ branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Attribute.pm Fri Jan 18 21:40:03 2008
@@ -9,7 +9,7 @@
use Carp 'confess';
use Scalar::Util 'blessed', 'reftype', 'weaken';
-our $VERSION = '0.21';
+our $VERSION = '0.22';
our $AUTHORITY = 'cpan:STEVAN';
use base 'Class::MOP::Object';
@@ -495,9 +495,19 @@
=item I<predicate>
-This is a basic test to see if the value of the attribute is not
-C<undef>. It will return true (C<1>) if the attribute's value is
-defined, and false (C<0>) otherwise.
+This is a basic test to see if any value has been set for the
+attribute. It will return true (C<1>) if the attribute has been set
+to any value (even C<undef>), and false (C<0>) otherwise.
+
+B<NOTE:>
+The predicate will return true even when you set an attribute's
+value to C<undef>. This behaviour has changed as of version 0.43. In
+older versions, the predicate (erroneously) checked for attribute
+value definedness, instead of presence as it is now.
+
+If you really want to get rid of the value, you have to define and
+use a I<clearer> (see below).
+
=item I<clearer>
@@ -726,7 +736,7 @@
=head1 COPYRIGHT AND LICENSE
-Copyright 2006, 2007 by Infinity Interactive, Inc.
+Copyright 2006-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
Modified: branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Class.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Class.pm?rev=12984&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Class.pm (original)
+++ branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Class.pm Fri Jan 18 21:40:03 2008
@@ -12,7 +12,7 @@
use Scalar::Util 'blessed', 'reftype', 'weaken';
use Sub::Name 'subname';
-our $VERSION = '0.25';
+our $VERSION = '0.26';
our $AUTHORITY = 'cpan:STEVAN';
use base 'Class::MOP::Module';
@@ -393,6 +393,27 @@
return $clone;
}
+sub rebless_instance {
+ my ($self, $instance) = @_;
+ my $old_metaclass = $instance->meta();
+ my $meta_instance = $self->get_meta_instance();
+
+ $self->name->isa($old_metaclass->name)
+ || confess "You may rebless only into a subclass of (". $old_metaclass->name ."), of which (". $self->name .") isn't.";
+
+ # rebless!
+ $meta_instance->rebless_instance_structure($instance, $self);
+
+ # check and upgrade all attributes
+ my %params = map { $_->name => $meta_instance->get_slot_value($instance, $_->name) }
+ grep { $meta_instance->is_slot_initialized($instance, $_->name) }
+ $self->compute_all_applicable_attributes;
+
+ foreach my $attr ($self->compute_all_applicable_attributes) {
+ $attr->initialize_instance_slot($meta_instance, $instance, \%params);
+ }
+}
+
# Inheritance
sub superclasses {
@@ -423,7 +444,7 @@
my $symbol_table_hashref = do { no strict 'refs'; \%{"${outer_class}::"} };
- SYMBOL:
+ SYMBOL:
for my $symbol ( keys %$symbol_table_hashref ) {
next SYMBOL if $symbol !~ /\A (\w+):: \z/x;
my $inner_class = $1;
@@ -457,18 +478,28 @@
sub linearized_isa {
- my %seen;
- grep { !($seen{$_}++) } (shift)->class_precedence_list
+ if (Class::MOP::IS_RUNNING_ON_5_10()) {
+ return @{ mro::get_linear_isa( (shift)->name ) };
+ }
+ else {
+ my %seen;
+ return grep { !($seen{$_}++) } (shift)->class_precedence_list;
+ }
}
sub class_precedence_list {
my $self = shift;
- # NOTE:
- # We need to check for circular inheritance here.
- # This will do nothing if all is well, and blow
- # up otherwise. Yes, it's an ugly hack, better
- # suggestions are welcome.
- { ($self->name || return)->isa('This is a test for circular inheritance') }
+
+ unless (Class::MOP::IS_RUNNING_ON_5_10()) {
+ # NOTE:
+ # We need to check for circular inheritance here
+ # if we are are not on 5.10, cause 5.8 detects it
+ # late. This will do nothing if all is well, and
+ # blow up otherwise. Yes, it's an ugly hack, better
+ # suggestions are welcome.
+ # - SL
+ ($self->name || return)->isa('This is a test for circular inheritance')
+ }
(
$self->name,
@@ -1075,6 +1106,15 @@
think Yuval "nothingmuch" Kogman put it best when he said that cloning
is too I<context-specific> to be part of the MOP.
+=item B<rebless_instance($instance)>
+
+This will change the class of C<$instance> to the class of the invoking
+C<Class::MOP::Class>. You may only rebless the instance to a subclass of
+itself. This limitation may be relaxed in the future.
+
+This can be useful in a number of situations, such as when you are writing
+a program that doesn't know everything at object construction time.
+
=back
=head2 Informational
@@ -1449,7 +1489,7 @@
=head1 COPYRIGHT AND LICENSE
-Copyright 2006, 2007 by Infinity Interactive, Inc.
+Copyright 2006-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
Modified: branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Immutable.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Immutable.pm?rev=12984&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Immutable.pm (original)
+++ branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Immutable.pm Fri Jan 18 21:40:03 2008
@@ -9,7 +9,7 @@
use Carp 'confess';
use Scalar::Util 'blessed';
-our $VERSION = '0.03';
+our $VERSION = '0.04';
our $AUTHORITY = 'cpan:STEVAN';
sub new {
@@ -233,6 +233,8 @@
}
$methods{get_mutable_metaclass_name} = sub { (shift)->{'___original_class'} };
+
+ $methods{immutable_transformer} = sub { $self };
return \%methods;
}
@@ -337,7 +339,7 @@
=head1 COPYRIGHT AND LICENSE
-Copyright 2006, 2007 by Infinity Interactive, Inc.
+Copyright 2006-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
Modified: branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Instance.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Instance.pm?rev=12984&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Instance.pm (original)
+++ branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Instance.pm Fri Jan 18 21:40:03 2008
@@ -108,13 +108,18 @@
}
sub weaken_slot_value {
- my ($self, $instance, $slot_name) = @_;
- weaken $instance->{$slot_name};
+ my ($self, $instance, $slot_name) = @_;
+ weaken $instance->{$slot_name};
}
sub strengthen_slot_value {
- my ($self, $instance, $slot_name) = @_;
- $self->set_slot_value($instance, $slot_name, $self->get_slot_value($instance, $slot_name));
+ my ($self, $instance, $slot_name) = @_;
+ $self->set_slot_value($instance, $slot_name, $self->get_slot_value($instance, $slot_name));
+}
+
+sub rebless_instance_structure {
+ my ($self, $instance, $metaclass) = @_;
+ bless $instance, $metaclass->name;
}
# inlinable operation snippets
@@ -283,6 +288,8 @@
=item B<strengthen_slot_value ($instance_structure, $slot_name)>
+=item B<rebless_instance_structure ($instance_structure, $new_metaclass)>
+
=back
=head2 Inlineable Instance Operations
@@ -329,7 +336,7 @@
=head1 COPYRIGHT AND LICENSE
-Copyright 2006, 2007 by Infinity Interactive, Inc.
+Copyright 2006-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
Modified: branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method.pm?rev=12984&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method.pm (original)
+++ branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method.pm Fri Jan 18 21:40:03 2008
@@ -131,7 +131,7 @@
=head1 COPYRIGHT AND LICENSE
-Copyright 2006, 2007 by Infinity Interactive, Inc.
+Copyright 2006-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
Modified: branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Accessor.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Accessor.pm?rev=12984&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Accessor.pm (original)
+++ branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Accessor.pm Fri Jan 18 21:40:03 2008
@@ -288,7 +288,7 @@
=head1 COPYRIGHT AND LICENSE
-Copyright 2006, 2007 by Infinity Interactive, Inc.
+Copyright 2006-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
Modified: branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Constructor.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Constructor.pm?rev=12984&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Constructor.pm (original)
+++ branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Constructor.pm Fri Jan 18 21:40:03 2008
@@ -224,7 +224,7 @@
=head1 COPYRIGHT AND LICENSE
-Copyright 2006, 2007 by Infinity Interactive, Inc.
+Copyright 2006-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
Modified: branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Generated.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Generated.pm?rev=12984&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Generated.pm (original)
+++ branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Generated.pm Fri Jan 18 21:40:03 2008
@@ -86,7 +86,7 @@
=head1 COPYRIGHT AND LICENSE
-Copyright 2006, 2007 by Infinity Interactive, Inc.
+Copyright 2006-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
Modified: branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Wrapped.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Wrapped.pm?rev=12984&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Wrapped.pm (original)
+++ branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Wrapped.pm Fri Jan 18 21:40:03 2008
@@ -20,119 +20,119 @@
# At this point it's "fast enough", after all
# you can't get something for nothing :)
my $_build_wrapped_method = sub {
- my $modifier_table = shift;
- my ($before, $after, $around) = (
- $modifier_table->{before},
- $modifier_table->{after},
- $modifier_table->{around},
- );
- if (@$before && @$after) {
- $modifier_table->{cache} = sub {
- $_->(@_) for @{$before};
- my @rval;
- ((defined wantarray) ?
- ((wantarray) ?
- (@rval = $around->{cache}->(@_))
- :
- ($rval[0] = $around->{cache}->(@_)))
- :
- $around->{cache}->(@_));
- $_->(@_) for @{$after};
- return unless defined wantarray;
- return wantarray ? @rval : $rval[0];
- }
- }
- elsif (@$before && !@$after) {
- $modifier_table->{cache} = sub {
- $_->(@_) for @{$before};
- return $around->{cache}->(@_);
- }
- }
- elsif (@$after && !@$before) {
- $modifier_table->{cache} = sub {
- my @rval;
- ((defined wantarray) ?
- ((wantarray) ?
- (@rval = $around->{cache}->(@_))
- :
- ($rval[0] = $around->{cache}->(@_)))
- :
- $around->{cache}->(@_));
- $_->(@_) for @{$after};
- return unless defined wantarray;
- return wantarray ? @rval : $rval[0];
- }
- }
- else {
- $modifier_table->{cache} = $around->{cache};
- }
+ my $modifier_table = shift;
+ my ($before, $after, $around) = (
+ $modifier_table->{before},
+ $modifier_table->{after},
+ $modifier_table->{around},
+ );
+ if (@$before && @$after) {
+ $modifier_table->{cache} = sub {
+ $_->(@_) for @{$before};
+ my @rval;
+ ((defined wantarray) ?
+ ((wantarray) ?
+ (@rval = $around->{cache}->(@_))
+ :
+ ($rval[0] = $around->{cache}->(@_)))
+ :
+ $around->{cache}->(@_));
+ $_->(@_) for @{$after};
+ return unless defined wantarray;
+ return wantarray ? @rval : $rval[0];
+ }
+ }
+ elsif (@$before && !@$after) {
+ $modifier_table->{cache} = sub {
+ $_->(@_) for @{$before};
+ return $around->{cache}->(@_);
+ }
+ }
+ elsif (@$after && !@$before) {
+ $modifier_table->{cache} = sub {
+ my @rval;
+ ((defined wantarray) ?
+ ((wantarray) ?
+ (@rval = $around->{cache}->(@_))
+ :
+ ($rval[0] = $around->{cache}->(@_)))
+ :
+ $around->{cache}->(@_));
+ $_->(@_) for @{$after};
+ return unless defined wantarray;
+ return wantarray ? @rval : $rval[0];
+ }
+ }
+ else {
+ $modifier_table->{cache} = $around->{cache};
+ }
};
sub wrap {
- my $class = shift;
- my $code = shift;
- (blessed($code) && $code->isa('Class::MOP::Method'))
- || confess "Can only wrap blessed CODE";
- my $modifier_table = {
- cache => undef,
- orig => $code,
- before => [],
- after => [],
- around => {
- cache => $code->body,
- methods => [],
- },
- };
- $_build_wrapped_method->($modifier_table);
- my $method = $class->SUPER::wrap(sub { $modifier_table->{cache}->(@_) });
- $method->{'%!modifier_table'} = $modifier_table;
- $method;
+ my $class = shift;
+ my $code = shift;
+ (blessed($code) && $code->isa('Class::MOP::Method'))
+ || confess "Can only wrap blessed CODE";
+ my $modifier_table = {
+ cache => undef,
+ orig => $code,
+ before => [],
+ after => [],
+ around => {
+ cache => $code->body,
+ methods => [],
+ },
+ };
+ $_build_wrapped_method->($modifier_table);
+ my $method = $class->SUPER::wrap(sub { $modifier_table->{cache}->(@_) });
+ $method->{'%!modifier_table'} = $modifier_table;
+ $method;
}
sub get_original_method {
- my $code = shift;
+ my $code = shift;
$code->{'%!modifier_table'}->{orig};
}
sub add_before_modifier {
- my $code = shift;
- my $modifier = shift;
- unshift @{$code->{'%!modifier_table'}->{before}} => $modifier;
- $_build_wrapped_method->($code->{'%!modifier_table'});
+ my $code = shift;
+ my $modifier = shift;
+ unshift @{$code->{'%!modifier_table'}->{before}} => $modifier;
+ $_build_wrapped_method->($code->{'%!modifier_table'});
}
sub add_after_modifier {
- my $code = shift;
- my $modifier = shift;
- push @{$code->{'%!modifier_table'}->{after}} => $modifier;
- $_build_wrapped_method->($code->{'%!modifier_table'});
+ my $code = shift;
+ my $modifier = shift;
+ push @{$code->{'%!modifier_table'}->{after}} => $modifier;
+ $_build_wrapped_method->($code->{'%!modifier_table'});
}
{
- # NOTE:
- # this is another possible candidate for
- # optimization as well. There is an overhead
- # associated with the currying that, if
- # eliminated might make around modifiers
- # more manageable.
- my $compile_around_method = sub {{
- my $f1 = pop;
- return $f1 unless @_;
- my $f2 = pop;
- push @_, sub { $f2->( $f1, @_ ) };
- redo;
- }};
+ # NOTE:
+ # this is another possible candidate for
+ # optimization as well. There is an overhead
+ # associated with the currying that, if
+ # eliminated might make around modifiers
+ # more manageable.
+ my $compile_around_method = sub {{
+ my $f1 = pop;
+ return $f1 unless @_;
+ my $f2 = pop;
+ push @_, sub { $f2->( $f1, @_ ) };
+ redo;
+ }};
- sub add_around_modifier {
- my $code = shift;
- my $modifier = shift;
- unshift @{$code->{'%!modifier_table'}->{around}->{methods}} => $modifier;
- $code->{'%!modifier_table'}->{around}->{cache} = $compile_around_method->(
- @{$code->{'%!modifier_table'}->{around}->{methods}},
- $code->{'%!modifier_table'}->{orig}->body
- );
- $_build_wrapped_method->($code->{'%!modifier_table'});
- }
+ sub add_around_modifier {
+ my $code = shift;
+ my $modifier = shift;
+ unshift @{$code->{'%!modifier_table'}->{around}->{methods}} => $modifier;
+ $code->{'%!modifier_table'}->{around}->{cache} = $compile_around_method->(
+ @{$code->{'%!modifier_table'}->{around}->{methods}},
+ $code->{'%!modifier_table'}->{orig}->body
+ );
+ $_build_wrapped_method->($code->{'%!modifier_table'});
+ }
}
1;
@@ -181,7 +181,7 @@
=head1 COPYRIGHT AND LICENSE
-Copyright 2006, 2007 by Infinity Interactive, Inc.
+Copyright 2006-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
Modified: branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Module.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Module.pm?rev=12984&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Module.pm (original)
+++ branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Module.pm Fri Jan 18 21:40:03 2008
@@ -79,7 +79,7 @@
=head1 COPYRIGHT AND LICENSE
-Copyright 2006, 2007 by Infinity Interactive, Inc.
+Copyright 2006-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
Modified: branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Object.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Object.pm?rev=12984&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Object.pm (original)
+++ branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Object.pm Fri Jan 18 21:40:03 2008
@@ -93,7 +93,7 @@
=head1 COPYRIGHT AND LICENSE
-Copyright 2006, 2007 by Infinity Interactive, Inc.
+Copyright 2006-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
Modified: branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Package.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Package.pm?rev=12984&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Package.pm (original)
+++ branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Package.pm Fri Jan 18 21:40:03 2008
@@ -292,7 +292,7 @@
=head1 COPYRIGHT AND LICENSE
-Copyright 2006, 2007 by Infinity Interactive, Inc.
+Copyright 2006-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
Modified: branches/upstream/libclass-mop-perl/current/lib/metaclass.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/lib/metaclass.pm?rev=12984&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/lib/metaclass.pm (original)
+++ branches/upstream/libclass-mop-perl/current/lib/metaclass.pm Fri Jan 18 21:40:03 2008
@@ -91,7 +91,7 @@
=head1 COPYRIGHT AND LICENSE
-Copyright 2006, 2007 by Infinity Interactive, Inc.
+Copyright 2006-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
Modified: branches/upstream/libclass-mop-perl/current/t/010_self_introspection.t
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/t/010_self_introspection.t?rev=12984&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/t/010_self_introspection.t (original)
+++ branches/upstream/libclass-mop-perl/current/t/010_self_introspection.t Fri Jan 18 21:40:03 2008
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use Test::More tests => 203;
+use Test::More tests => 205;
use Test::Exception;
BEGIN {
@@ -60,6 +60,7 @@
instance_metaclass get_meta_instance
new_object clone_object
construct_instance construct_class_instance clone_instance
+ rebless_instance
check_metaclass_compatability
attribute_metaclass method_metaclass
More information about the Pkg-perl-cvs-commits
mailing list