X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FImmutable.pm;h=7b4ebe026cfea73c0999273bee8a34881ba38084;hb=421e6ebc64cb617e13f908e76538a8cc3c97ca8e;hp=0c11a373095e98d477666abd33963d6357e6be25;hpb=1a84e3f334a1bda85d1e620ca1b9608395cf1180;p=gitmo%2FClass-MOP.git

diff --git a/lib/Class/MOP/Immutable.pm b/lib/Class/MOP/Immutable.pm
index 0c11a37..7b4ebe0 100644
--- a/lib/Class/MOP/Immutable.pm
+++ b/lib/Class/MOP/Immutable.pm
@@ -9,31 +9,54 @@ use Class::MOP::Method::Constructor;
 use Carp         'confess';
 use Scalar::Util 'blessed';
 
-our $VERSION   = '0.64';
+our $VERSION   = '0.64_07';
+$VERSION = eval $VERSION;
 our $AUTHORITY = 'cpan:STEVAN';
 
 use base 'Class::MOP::Object';
 
 sub new {
-    my ($class, $metaclass, $options) = @_;
+    my ($class, @args) = @_;
 
-    my $self = bless {
-        '$!metaclass'           => $metaclass,
-        '%!options'             => $options,
-        '$!immutable_metaclass' => undef,
-    } => $class;
+    my ( $metaclass, $options );
+
+    if ( @args == 2 ) {
+        # compatibility args
+        ( $metaclass, $options ) = @args;
+    } else {
+        unshift @args, "metaclass" if @args % 2 == 1;
+
+        # default named args
+        my %options = @args;
+        $options = \%options;
+        $metaclass = $options{metaclass};
+    }
+
+    my $self = $class->_new(
+        'metaclass'           => $metaclass,
+        'options'             => $options,
+        'immutable_metaclass' => undef,
+    );
 
     # NOTE:
     # we initialize the immutable
     # version of the metaclass here
+    # FIXME lazify
     $self->create_immutable_metaclass;
 
     return $self;
 }
 
-sub immutable_metaclass { (shift)->{'$!immutable_metaclass'} }
-sub metaclass           { (shift)->{'$!metaclass'}           }
-sub options             { (shift)->{'%!options'}             }
+sub _new {
+    my $class = shift;
+    my $options = @_ == 1 ? $_[0] : {@_};
+
+    bless $options, $class;
+}
+
+sub immutable_metaclass { (shift)->{'immutable_metaclass'} }
+sub metaclass           { (shift)->{'metaclass'}           }
+sub options             { (shift)->{'options'}             }
 
 sub create_immutable_metaclass {
     my $self = shift;
@@ -43,7 +66,7 @@ sub create_immutable_metaclass {
     # metaclass is just a anon-class
     # which shadows the methods
     # appropriately
-    $self->{'$!immutable_metaclass'} = Class::MOP::Class->create_anon_class(
+    $self->{'immutable_metaclass'} = Class::MOP::Class->create_anon_class(
         superclasses => [ blessed($self->metaclass) ],
         methods      => $self->create_methods_for_immutable_metaclass,
     );
@@ -59,7 +82,15 @@ my %DEFAULT_METHODS = (
         return Class::MOP::Class->initialize($self) unless blessed($self);
         # otherwise, they are asking for the metaclass
         # which has been made immutable, which is itself
-        return $self;
+        # except in the cases where it is a metaclass itself
+        # that has been made immutable and for that we need 
+        # to dig a bit ...
+        if ($self->isa('Class::MOP::Class')) {
+            return $self->{'___original_class'}->meta;
+        }
+        else {
+            return $self;
+        }
     },
     is_mutable     => sub { 0  },
     is_immutable   => sub { 1  },
@@ -103,7 +134,7 @@ sub make_metaclass_immutable {
                 package_name => $metaclass->name,
                 name         => $options{constructor_name}
             )
-        ) unless $metaclass->has_method($options{constructor_name});
+        ) if $options{replace_constructor} or !$metaclass->has_method($options{constructor_name});
     }
 
     if ($options{inline_destructor}) {