X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FClass%2FImmutable%2FTrait.pm;h=79f5c02b76f4ba14075d5aaf5fd8f821e5e51cc6;hb=d5d2fbb799207b6da4a57072e42fe3617d9f91b0;hp=5d4cefc2c84f36be2af02ee9938e0b40806dfc53;hpb=15726b755736120e49d968e42b85a6e88c373c54;p=gitmo%2FClass-MOP.git

diff --git a/lib/Class/MOP/Class/Immutable/Trait.pm b/lib/Class/MOP/Class/Immutable/Trait.pm
index 5d4cefc..79f5c02 100644
--- a/lib/Class/MOP/Class/Immutable/Trait.pm
+++ b/lib/Class/MOP/Class/Immutable/Trait.pm
@@ -8,87 +8,85 @@ use MRO::Compat;
 use Carp 'confess';
 use Scalar::Util 'blessed', 'weaken';
 
-sub meta {
-    my $self = shift;
-
-    # if it is not blessed, then someone is asking
-    # for the meta of Class::MOP::Class:;Immutable::Trait
-    return Class::MOP::Class->initialize($self) unless blessed($self);
-
-    # otherwise, they are asking for the metaclass
-    # which has been made immutable, which is itself
-    # 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') ) {
-
-        # except this is a lie... oh well
-        return Class::MOP::class_of( $self->get_mutable_metaclass_name );
-    }
-    else {
-        return $self;
-    }
-}
+our $VERSION   = '1.07';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
 
 # the original class of the metaclass instance
-sub get_mutable_metaclass_name { $_[0]{__immutable}{original_class} }
+sub _get_mutable_metaclass_name { $_[0]{__immutable}{original_class} }
 
-sub immutable_options { %{ $_[0]{__immutable}{options} } }
+sub is_mutable   { 0 }
+sub is_immutable { 1 }
 
-sub is_mutable   {0}
-sub is_immutable {1}
+sub _immutable_metaclass { ref $_[1] }
 
 sub superclasses {
-    confess "This method is read-only" if @_ > 1;
-    $_[0]->next::method;
+    my $orig = shift;
+    my $self = shift;
+    confess "This method is read-only" if @_;
+    $self->$orig;
 }
 
 sub _immutable_cannot_call {
-    Carp::confess "This method cannot be called on an immutable instance";
+    my $name = shift;
+    Carp::confess "The '$name' method cannot be called on an immutable instance";
 }
 
-sub add_method            { shift->_immutable_cannot_call }
-sub alias_method          { shift->_immutable_cannot_call }
-sub remove_method         { shift->_immutable_cannot_call }
-sub add_attribute         { shift->_immutable_cannot_call }
-sub remove_attribute      { shift->_immutable_cannot_call }
-sub remove_package_symbol { shift->_immutable_cannot_call }
+for my $name (qw/add_method alias_method remove_method add_attribute remove_attribute remove_package_symbol/) {
+    no strict 'refs';
+    *{__PACKAGE__."::$name"} = sub { _immutable_cannot_call($name) };
+}
 
 sub class_precedence_list {
-    @{ $_[0]{__immutable}{class_precedence_list}
-            ||= [ shift->next::method ] };
+    my $orig = shift;
+    my $self = shift;
+    @{ $self->{__immutable}{class_precedence_list}
+            ||= [ $self->$orig ] };
 }
 
 sub linearized_isa {
-    @{ $_[0]{__immutable}{linearized_isa} ||= [ shift->next::method ] };
+    my $orig = shift;
+    my $self = shift;
+    @{ $self->{__immutable}{linearized_isa} ||= [ $self->$orig ] };
 }
 
 sub get_all_methods {
-    @{ $_[0]{__immutable}{get_all_methods} ||= [ shift->next::method ] };
+    my $orig = shift;
+    my $self = shift;
+    @{ $self->{__immutable}{get_all_methods} ||= [ $self->$orig ] };
 }
 
 sub get_all_method_names {
-    @{ $_[0]{__immutable}{get_all_method_names} ||= [ shift->next::method ] };
+    my $orig = shift;
+    my $self = shift;
+    @{ $self->{__immutable}{get_all_method_names} ||= [ $self->$orig ] };
 }
 
 sub get_all_attributes {
-    @{ $_[0]{__immutable}{get_all_attributes} ||= [ shift->next::method ] };
+    my $orig = shift;
+    my $self = shift;
+    @{ $self->{__immutable}{get_all_attributes} ||= [ $self->$orig ] };
 }
 
 sub get_meta_instance {
-    $_[0]{__immutable}{get_meta_instance} ||= shift->next::method;
+    my $orig = shift;
+    my $self = shift;
+    $self->{__immutable}{get_meta_instance} ||= $self->$orig;
 }
 
-sub get_method_map {
-    $_[0]{__immutable}{get_method_map} ||= shift->next::method;
+sub _get_method_map {
+    my $orig = shift;
+    my $self = shift;
+    $self->{__immutable}{_get_method_map} ||= $self->$orig;
 }
 
 sub add_package_symbol {
+    my $orig = shift;
+    my $self = shift;
     confess "Cannot add package symbols to an immutable metaclass"
-        unless ( caller(1) )[3] eq 'Class::MOP::Package::get_package_symbol';
+        unless ( caller(3) )[3] eq 'Class::MOP::Package::get_package_symbol';
 
-    shift->next::method(@_);
+    $self->$orig(@_);
 }
 
 1;
@@ -103,8 +101,10 @@ Class::MOP::Class::Immutable::Trait - Implements immutability for metaclass obje
 
 =head1 DESCRIPTION
 
-This class provides a trait that is applied to immutable metaclass
-objects. This is deep guts.
+This class provides a pseudo-trait that is applied to immutable metaclass
+objects. In reality, it is simply a parent class.
+
+It implements caching and read-only-ness for various metaclass methods.
 
 =head1 AUTHOR