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