From: Guillermo Roditi <groditi@gmail.com>
Date: Wed, 11 Jun 2008 21:33:19 +0000 (+0000)
Subject: expose immutable options and transformer
X-Git-Tag: 0_64~26
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=119f3a92af2a078a06fc82d2db1a02018a0b8463;p=gitmo%2FClass-MOP.git

expose immutable options and transformer
---

diff --git a/Changes b/Changes
index 1553392..46894d4 100644
--- a/Changes
+++ b/Changes
@@ -6,6 +6,9 @@ Revision history for Perl extension Class-MOP.
       - now stores the instance of the instance 
         metaclass to avoid needless recomputation
         and deletes it when the cache is blown
+      - introduce methods to query Class::MOP::Class for 
+        the options used to make it immutable as well as
+        the proper immutable transformer. (groditi)        
 
     * Class::MOP::Package
       - {add, has, get, remove}_package_symbol all 
diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index 86d6f27..fbf30a0 100644
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -922,16 +922,36 @@ sub is_immutable { 0 }
 #      the reference stored in  $IMMUTABLE_TRANSFORMERS{$class} and ||= should DWIM
 
 {
+
     my %IMMUTABLE_TRANSFORMERS;
     my %IMMUTABLE_OPTIONS;
+
+    sub get_immutable_options {
+        my $self = shift;
+        return if $self->is_mutable;
+        confess "unable to find immutabilizing options"
+            unless exists $IMMUTABLE_OPTIONS{$self->name};
+        my %options = %{$IMMUTABLE_OPTIONS{$self->name}};
+        delete $options{IMMUTABLE_TRANSFORMER};
+        return \%options;
+    }
+
+    sub get_immutable_transformer {
+        my $self = shift;
+        if( $self->is_mutable ){
+            my $class = blessed $self || $self;
+            return $IMMUTABLE_TRANSFORMERS{$class} ||= $self->create_immutable_transformer;
+        }
+        confess "unable to find transformer for immutable class"
+            unless exists $IMMUTABLE_OPTIONS{$self->name};
+        return $IMMUTABLE_OPTIONS{$self->name}->{IMMUTABLE_TRANSFORMER};
+    }
+
     sub make_immutable {
         my $self = shift;
         my %options = @_;
-        my $class = blessed $self || $self;
-
-        $IMMUTABLE_TRANSFORMERS{$class} ||= $self->create_immutable_transformer;
-        my $transformer = $IMMUTABLE_TRANSFORMERS{$class};
 
+        my $transformer = $self->get_immutable_transformer;
         $transformer->make_metaclass_immutable($self, \%options);
         $IMMUTABLE_OPTIONS{$self->name} =
             { %options,  IMMUTABLE_TRANSFORMER => $transformer };
@@ -940,7 +960,7 @@ sub is_immutable { 0 }
             print STDERR "# of Metaclass options:      ", keys %IMMUTABLE_OPTIONS;
             print STDERR "# of Immutable transformers: ", keys %IMMUTABLE_TRANSFORMERS;
         }
-        
+
         1;
     }
 
@@ -1586,6 +1606,15 @@ the L<Class::MOP::Immutable> documentation.
 This method will reverse tranforamtion upon the class which
 made it immutable.
 
+=item B<get_immutable_transformer>
+
+Return a transformer suitable for making this class immutable or, if this
+class is immutable, the transformer used to make it immutable.
+
+=item B<get_immutable_options>
+
+If the class is immutable, return the options used to make it immutable.
+
 =item B<create_immutable_transformer>
 
 Create a transformer suitable for making this class immutable
diff --git a/t/010_self_introspection.t b/t/010_self_introspection.t
index a933e85..6326f93 100644
--- a/t/010_self_introspection.t
+++ b/t/010_self_introspection.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 200;
+use Test::More tests => 204;
 use Test::Exception;
 
 BEGIN {
@@ -74,6 +74,7 @@ my @class_mop_class_methods = qw(
     get_attribute_list get_attribute_map compute_all_applicable_attributes find_attribute_by_name
 
     is_mutable is_immutable make_mutable make_immutable create_immutable_transformer
+    get_immutable_options get_immutable_transformer
 
     DESTROY
 );
diff --git a/t/070_immutable_metaclass.t b/t/070_immutable_metaclass.t
index af2781d..6a1c356 100644
--- a/t/070_immutable_metaclass.t
+++ b/t/070_immutable_metaclass.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 84;
+use Test::More tests => 85;
 use Test::Exception;
 
 BEGIN {
@@ -76,10 +76,13 @@ BEGIN {
     ok($meta->is_mutable, '... our class is mutable');
     ok(!$meta->is_immutable, '... our class is not immutable');
 
+    my $transformer = $meta->get_immutable_transformer;
+
     lives_ok {
         $meta->make_immutable();
     } '... changed Foo to be immutable';
 
+    is($transformer, $meta->get_immutable_transformer, '... immutable transformer cache works');
     ok(!$meta->make_immutable, '... make immutable now returns nothing');
 
     ok(!$meta->is_mutable, '... our class is no longer mutable');
@@ -96,7 +99,7 @@ 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';
 
     my @supers;