X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FImmutable.pm;h=8a57479698fb5c326aee1adac99a1a70a8ba1c39;hb=6e1c8b63d87c6e1d8e84e15cc2c1f5336780515b;hp=8ee7567dcc7e7d887d831efc1281dd6cdfddd90c;hpb=69e3ab0a5a391925610bbb917d81da8d53fd1b91;p=gitmo%2FClass-MOP.git

diff --git a/lib/Class/MOP/Immutable.pm b/lib/Class/MOP/Immutable.pm
index 8ee7567..8a57479 100644
--- a/lib/Class/MOP/Immutable.pm
+++ b/lib/Class/MOP/Immutable.pm
@@ -9,9 +9,11 @@ use Class::MOP::Method::Constructor;
 use Carp         'confess';
 use Scalar::Util 'blessed';
 
-our $VERSION   = '0.03';
+our $VERSION   = '0.63';
 our $AUTHORITY = 'cpan:STEVAN';
 
+use base 'Class::MOP::Object';
+
 sub new {
     my ($class, $metaclass, $options) = @_;
 
@@ -53,7 +55,7 @@ my %DEFAULT_METHODS = (
     meta => sub {
         my $self = shift;
         # if it is not blessed, then someone is asking
-        # for the meta of Class::MOP::Class::Immutable
+        # for the meta of Class::MOP::Immutable
         return Class::MOP::Class->initialize($self) unless blessed($self);
         # otherwise, they are asking for the metaclass
         # which has been made immutable, which is itself
@@ -96,9 +98,11 @@ sub make_metaclass_immutable {
         $metaclass->add_method(
             $options{constructor_name},
             $constructor_class->new(
-                options   => \%options,
-                metaclass => $metaclass,
-                is_inline => 1,
+                options      => \%options,
+                metaclass    => $metaclass,
+                is_inline    => 1,
+                package_name => $metaclass->name,
+                name         => $options{constructor_name}
             )
         ) unless $metaclass->has_method($options{constructor_name});
     }
@@ -110,18 +114,27 @@ sub make_metaclass_immutable {
 
         my $destructor_class = $options{destructor_class};
 
-        my $destructor = $destructor_class->new(
-            options   => \%options,
-            metaclass => $metaclass,
-        );
-
-        $metaclass->add_method('DESTROY' => $destructor)
-            # NOTE:
-            # we allow the destructor to determine
-            # if it is needed or not, it can perform
-            # all sorts of checks because it has the
-            # metaclass instance
-            if $destructor->is_needed;
+        # NOTE:
+        # we allow the destructor to determine
+        # if it is needed or not before we actually 
+        # create the destructor too
+        # - SL
+        if ($destructor_class->is_needed($metaclass)) {
+            my $destructor = $destructor_class->new(
+                options      => \%options,
+                metaclass    => $metaclass,
+                package_name => $metaclass->name,
+                name         => 'DESTROY'            
+            );
+
+            $metaclass->add_method('DESTROY' => $destructor)
+                # NOTE:
+                # we allow the destructor to determine
+                # if it is needed or not, it can perform
+                # all sorts of checks because it has the
+                # metaclass instance
+                if $destructor->is_needed;
+        }
     }
 
     my $memoized_methods = $self->options->{memoize};
@@ -168,7 +181,7 @@ sub make_metaclass_mutable {
 
     if ($options{inline_destructor} && $immutable->has_method('DESTROY')) {
         $immutable->remove_method('DESTROY')
-          if $immutable->get_method('DESTROY')->blessed eq $options{destructor_class};
+          if blessed($immutable->get_method('DESTROY')) eq $options{destructor_class};
     }
 
     # NOTE:
@@ -188,10 +201,10 @@ sub make_metaclass_mutable {
     # 14:26 <@stevan> the only user of ::Method::Constructor is immutable
     # 14:27 <@stevan> if someone uses it outside of immutable,.. they are either: mst or groditi
     # 14:27 <@stevan> so I am not worried
-    if ($options{inline_constructor}) {
+    if ($options{inline_constructor}  && $immutable->has_method($options{constructor_name})) {
         my $constructor_class = $options{constructor_class} || 'Class::MOP::Method::Constructor';
         $immutable->remove_method( $options{constructor_name}  )
-          if $immutable->get_method($options{constructor_name})->blessed eq $constructor_class;
+          if blessed($immutable->get_method($options{constructor_name})) eq $constructor_class;
     }
 }
 
@@ -231,9 +244,24 @@ sub create_methods_for_immutable_metaclass {
             $methods{$method_name} = sub { $_[0]->{'___' . $method_name} };
         }
     }
+    
+    my $wrapped_methods = $self->options->{wrapped};
+    
+    foreach my $method_name (keys %{ $wrapped_methods }) {
+        my $method = $self->metaclass->meta->find_method_by_name($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'} };
 
+    $methods{immutable_transformer} = sub { $self };
+
     return \%methods;
 }
 
@@ -279,8 +307,9 @@ metaclass. Current features include making methods read-only,
 making methods un-callable and memoizing methods (in a type specific
 way too).
 
-This module is fairly new to the MOP, and quite possibly will be
-expanded and further generalized as the need arises.
+This module is not for the feint of heart, it does some whacky things
+to the metaclass in order to make it immutable. If you are just curious, 
+I suggest you turn back now, there is nothing to see here.
 
 =head1 METHODS