From: Stevan Little <stevan.little@iinteractive.com>
Date: Fri, 16 May 2008 20:17:17 +0000 (+0000)
Subject: dont break trunk please
X-Git-Tag: 0_64~66
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5f3efd66c72c056da06be4eda139cdb7b7957730;p=gitmo%2FClass-MOP.git

dont break trunk please
---

diff --git a/Changes b/Changes
index 571aa05..9e97d59 100644
--- a/Changes
+++ b/Changes
@@ -1,8 +1,18 @@
 Revision history for Perl extension Class-MOP.
 
-NEXT
+0.56
     * Class::MOP::Attribute
       - add has_read_method and has_write_method
+     
+    * Class::MOP::Immutable
+      - added the ability to "wrap" methods when 
+        making the class immutable
+        
+    * Class::MOP::Class
+      - now handling the edge case of ->meta->indentifier
+        dying by wrapping add_package_symbol to specifically 
+        allow for it to work.
+        - added tests for this
 
 0.55 Mon. April 28, 2008
     - All classes now have proper C3 MRO support
diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index 9977409..304f9dc 100644
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -12,7 +12,7 @@ use Carp         'confess';
 use Scalar::Util 'blessed', 'reftype', 'weaken';
 use Sub::Name    'subname';
 
-our $VERSION   = '0.30';
+our $VERSION   = '0.31';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use base 'Class::MOP::Module';
@@ -900,29 +900,34 @@ sub is_immutable { 0 }
 sub create_immutable_transformer {
     my $self = shift;
     my $class = Class::MOP::Immutable->new($self, {
-       read_only   => [qw/superclasses/],
-       cannot_call => [qw/
+        read_only   => [qw/superclasses/],
+        cannot_call => [qw/
            add_method
            alias_method
            remove_method
            add_attribute
            remove_attribute
            remove_package_symbol
-       /],
-       memoize     => {
+        /],
+        memoize     => {
            class_precedence_list             => 'ARRAY',
            linearized_isa                    => 'ARRAY',
            compute_all_applicable_attributes => 'ARRAY',
            get_meta_instance                 => 'SCALAR',
            get_method_map                    => 'SCALAR',
-       },
-       around => { 
-           add_package_symbol => sub {
-               my $original = shift;
-               confess "NO ADD SYMBOLS FOR YOU" unless caller eq 'get_package_symbol'; 
-               $original->(@_);
-           },
-       },
+        },
+        # NOTE:
+        # this is ugly, but so are typeglobs, 
+        # so whattayahgonnadoboutit
+        # - SL
+        wrapped => { 
+            add_package_symbol => sub {
+                my $original = shift;
+                confess "Cannot add package symbols to an immutable metaclass" 
+                    unless (caller(2))[3] eq 'Class::MOP::Package::get_package_symbol'; 
+                goto $original->body;
+            },
+        },
     });
     return $class;
 }
diff --git a/lib/Class/MOP/Immutable.pm b/lib/Class/MOP/Immutable.pm
index f4a84b0..284949a 100644
--- a/lib/Class/MOP/Immutable.pm
+++ b/lib/Class/MOP/Immutable.pm
@@ -10,7 +10,7 @@ use Carp         'confess';
 use Scalar::Util 'blessed';
 use Sub::Name    'subname';
 
-our $VERSION   = '0.05';
+our $VERSION   = '0.06';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use base 'Class::MOP::Object';
@@ -235,11 +235,17 @@ sub create_methods_for_immutable_metaclass {
         }
     }
     
-    my $around_methods = $self->options->{around};
-    foreach my $method_name (keys %{$around_methods}) {
+    my $wrapped_methods = $self->options->{wrapped};
+    
+    foreach my $method_name (keys %{ $wrapped_methods }) {
         my $method = $self->metaclass->meta->find_method_by_name($method_name);
-        $method = Class::MOP::Method::Wrapped->wrap($method);
-        $method->add_around_modifier(subname ':around' => $around_methods->{$method_name});
+
+        (defined $method)
+            || confess "Could not find the method '$method_name' in " . $self->metaclass->name;
+
+        my $wrapper = $wrapped_methods->{$method_name};
+
+        $methods{$method_name} = sub { $wrapper->($method, @_) };
     }
 
     $methods{get_mutable_metaclass_name} = sub { (shift)->{'___original_class'} };
diff --git a/t/070_immutable_metaclass.t b/t/070_immutable_metaclass.t
index ffc8b76..f81b0dd 100644
--- a/t/070_immutable_metaclass.t
+++ b/t/070_immutable_metaclass.t
@@ -96,7 +96,8 @@ BEGIN {
 
     dies_ok { $meta->add_package_symbol()    } '... exception thrown as expected';
     dies_ok { $meta->remove_package_symbol() } '... exception thrown as expected';
-    lives_ok{ $meta->identifier()            } '... no exception for get_package_symbol special case';
+    
+    lives_ok { $meta->identifier() } '... no exception for get_package_symbol special case';
 
     my @supers;
     lives_ok {