[gitmo/Class-MOP.git] / lib / Class / MOP / Immutable.pm


package Class::MOP::Immutable;

use strict;
use warnings;

use Class::MOP::Method::Constructor;

use Carp         'confess';
use Scalar::Util 'blessed';

our $VERSION   = '0.65';
our $AUTHORITY = 'cpan:STEVAN';

use base 'Class::MOP::Object';

sub new {
    my ($class, @args) = @_;

    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};
    }

    # FIXME make a proper constructor using ->meta->new_object
    my $self = bless {
        'metaclass'           => $metaclass,
        'options'             => $options,
        'immutable_metaclass' => undef,
    } => $class;

    # 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 create_immutable_metaclass {
    my $self = shift;

    # NOTE:
    # The immutable version of the
    # metaclass is just a anon-class
    # which shadows the methods
    # appropriately
    $self->{'immutable_metaclass'} = Class::MOP::Class->create_anon_class(
        superclasses => [ blessed($self->metaclass) ],
        methods      => $self->create_methods_for_immutable_metaclass,
    );
}


my %DEFAULT_METHODS = (
    # I don't really understand this, but removing it breaks tests (groditi)
    meta => sub {
        my $self = shift;
        # if it is not blessed, then someone is asking
        # 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
        # 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  },
    make_immutable => sub { () },
);

# NOTE:
# this will actually convert the
# existing metaclass to an immutable
# version of itself
sub make_metaclass_immutable {
    my ($self, $metaclass, $options) = @_;

    my %options = (
        inline_accessors   => 1,
        inline_constructor => 1,
        inline_destructor  => 0,
        constructor_name   => 'new',
        debug              => 0,
        %$options,
    );

    %$options = %options; # FIXME who the hell is relying on this?!? tests fail =(

    if ($options{inline_accessors}) {
        foreach my $attr_name ($metaclass->get_attribute_list) {
            # inline the accessors
            $metaclass->get_attribute($attr_name)
                      ->install_accessors(1);
        }
    }

    if ($options{inline_constructor}) {
        my $constructor_class = $options{constructor_class} || 'Class::MOP::Method::Constructor';
        $metaclass->add_method(
            $options{constructor_name},
            $constructor_class->new(
                options      => \%options,
                metaclass    => $metaclass,
                is_inline    => 1,
                package_name => $metaclass->name,
                name         => $options{constructor_name}
            )
        ) if $options{replace_constructor} or !$metaclass->has_method($options{constructor_name});
    }

    if ($options{inline_destructor}) {
        (exists $options{destructor_class})
            || confess "The 'inline_destructor' option is present, but "
                     . "no destructor class was specified";

        my $destructor_class = $options{destructor_class};

        # 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};
    foreach my $method_name (keys %{$memoized_methods}) {
        my $type = $memoized_methods->{$method_name};

        ($metaclass->can($method_name))
            || confess "Could not find the method '$method_name' in " . $metaclass->name;

        if ($type eq 'ARRAY') {
            $metaclass->{'___' . $method_name} = [ $metaclass->$method_name ];
        }
        elsif ($type eq 'HASH') {
            $metaclass->{'___' . $method_name} = { $metaclass->$method_name };
        }
        elsif ($type eq 'SCALAR') {
            $metaclass->{'___' . $method_name} = $metaclass->$method_name;
        }
    }

    $metaclass->{'___original_class'} = blessed($metaclass);
    bless $metaclass => $self->immutable_metaclass->name;
}

sub make_metaclass_mutable {
    my ($self, $immutable, $options) = @_;

    my %options = %$options;

    my $original_class = $immutable->get_mutable_metaclass_name;
    delete $immutable->{'___original_class'} ;
    bless $immutable => $original_class;

    my $memoized_methods = $self->options->{memoize};
    foreach my $method_name (keys %{$memoized_methods}) {
        my $type = $memoized_methods->{$method_name};

        ($immutable->can($method_name))
          || confess "Could not find the method '$method_name' in " . $immutable->name;
        if ($type eq 'SCALAR' || $type eq 'ARRAY' ||  $type eq 'HASH' ) {
            delete $immutable->{'___' . $method_name};
        }
    }

    if ($options{inline_destructor} && $immutable->has_method('DESTROY')) {
        $immutable->remove_method('DESTROY')
          if blessed($immutable->get_method('DESTROY')) eq $options{destructor_class};
    }

    # NOTE:
    # 14:01 <@stevan> nah,. you shouldnt
    # 14:01 <@stevan> they are just inlined
    # 14:01 <@stevan> which is the default in Moose anyway
    # 14:02 <@stevan> and adding new attributes will just DWIM
    # 14:02 <@stevan> and you really cant change an attribute anyway
    # if ($options{inline_accessors}) {
    #     foreach my $attr_name ($immutable->get_attribute_list) {
    #         my $attr = $immutable->get_attribute($attr_name);
    #         $attr->remove_accessors;
    #         $attr->install_accessors(0);
    #     }
    # }

    # 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}  && $immutable->has_method($options{constructor_name})) {
        my $constructor_class = $options{constructor_class} || 'Class::MOP::Method::Constructor';
        $immutable->remove_method( $options{constructor_name}  )
          if blessed($immutable->get_method($options{constructor_name})) eq $constructor_class;
    }
}

sub create_methods_for_immutable_metaclass {
    my $self = shift;

    my %methods = %DEFAULT_METHODS;

    foreach my $read_only_method (@{$self->options->{read_only}}) {
        my $method = $self->metaclass->meta->find_method_by_name($read_only_method);

        (defined $method)
            || confess "Could not find the method '$read_only_method' in " . $self->metaclass->name;

        $methods{$read_only_method} = sub {
            confess "This method is read-only" if scalar @_ > 1;
            goto &{$method->body}
        };
    }

    foreach my $cannot_call_method (@{$self->options->{cannot_call}}) {
        $methods{$cannot_call_method} = sub {
            confess "This method ($cannot_call_method) cannot be called on an immutable instance";
        };
    }

    my $memoized_methods = $self->options->{memoize};
    foreach my $method_name (keys %{$memoized_methods}) {
        my $type = $memoized_methods->{$method_name};
        if ($type eq 'ARRAY') {
            $methods{$method_name} = sub { @{$_[0]->{'___' . $method_name}} };
        }
        elsif ($type eq 'HASH') {
            $methods{$method_name} = sub { %{$_[0]->{'___' . $method_name}} };
        }
        elsif ($type eq 'SCALAR') {
            $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;
}

1;

__END__

=pod

=head1 NAME

Class::MOP::Immutable - A class to transform Class::MOP::Class metaclasses

=head1 SYNOPSIS

    use Class::MOP::Immutable;

    my $immutable_metaclass = Class::MOP::Immutable->new($metaclass, {
        read_only   => [qw/superclasses/],
        cannot_call => [qw/
            add_method
            alias_method
            remove_method
            add_attribute
            remove_attribute
            add_package_symbol
            remove_package_symbol
        /],
        memoize     => {
            class_precedence_list             => 'ARRAY',
            compute_all_applicable_attributes => 'ARRAY',
            get_meta_instance                 => 'SCALAR',
            get_method_map                    => 'SCALAR',
        }
    });

    $immutable_metaclass->make_metaclass_immutable(@_)

=head1 DESCRIPTION

This is basically a module for applying a transformation on a given
metaclass. Current features include making methods read-only,
making methods un-callable and memoizing methods (in a type specific
way too).

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

=over 4

=item B<new ($metaclass, \%options)>

Given a C<$metaclass> and a set of C<%options> this module will
prepare an immutable version of the C<$metaclass>, which can then
be applied to the C<$metaclass> using the C<make_metaclass_immutable>
method.

=item B<options>

Returns the options HASH set in C<new>.

=item B<metaclass>

Returns the metaclass set in C<new>.

=item B<immutable_metaclass>

Returns the immutable metaclass created within C<new>.

=back

=over 4

=item B<create_immutable_metaclass>

This will create the immutable version of the C<$metaclass>, but will
not actually change the original metaclass.

=item B<create_methods_for_immutable_metaclass>

This will create all the methods for the immutable metaclass based
on the C<%options> passed into C<new>.

=item B<make_metaclass_immutable (%options)>

This will actually change the C<$metaclass> into the immutable version.

=item B<make_metaclass_mutable (%options)>

This will change the C<$metaclass> into the mutable version by reversing
the immutable process. C<%options> should be the same options that were
given to make_metaclass_immutable.

=back

=head1 AUTHORS

Stevan Little E<lt>stevan@iinteractive.comE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2006-2008 by Infinity Interactive, Inc.

L<http://www.iinteractive.com>

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut
Commit	Line	Data
c23184fc	1
	2	package Class::MOP::Immutable;
	3
	4	use strict;
	5	use warnings;
	6
	7	use Class::MOP::Method::Constructor;
	8
	9	use Carp 'confess';
	10	use Scalar::Util 'blessed';
	11
2e5c1a3f	12	our $VERSION = '0.65';
c23184fc	13	our $AUTHORITY = 'cpan:STEVAN';
c23184fc	14
d7b2249e	15	use base 'Class::MOP::Object';
d7b2249e	16
0ac992ee	17	sub new {
1ae8e211	18	my ($class, @args) = @_;
0ac992ee	19
1ae8e211	20	my ( $metaclass, $options );
	21
	22	if ( @args == 2 ) {
	23	# compatibility args
	24	( $metaclass, $options ) = @args;
	25	} else {
	26	unshift @args, "metaclass" if @args % 2 == 1;
	27
	28	# default named args
	29	my %options = @args;
	30	$options = \%options;
	31	$metaclass = $options{metaclass};
	32	}
	33
	34	# FIXME make a proper constructor using ->meta->new_object
c23184fc	35	my $self = bless {
8683db0e	36	'metaclass' => $metaclass,
	37	'options' => $options,
	38	'immutable_metaclass' => undef,
c23184fc	39	} => $class;
0ac992ee	40
c23184fc	41	# NOTE:
0ac992ee	42	# we initialize the immutable
c23184fc	43	# version of the metaclass here
1ae8e211	44	# FIXME lazify
c23184fc	45	$self->create_immutable_metaclass;
0ac992ee	46
c23184fc	47	return $self;
	48	}
	49
8683db0e	50	sub immutable_metaclass { (shift)->{'immutable_metaclass'} }
	51	sub metaclass { (shift)->{'metaclass'} }
	52	sub options { (shift)->{'options'} }
c23184fc	53
	54	sub create_immutable_metaclass {
	55	my $self = shift;
	56
	57	# NOTE:
0ac992ee	58	# The immutable version of the
c23184fc	59	# metaclass is just a anon-class
0ac992ee	60	# which shadows the methods
c23184fc	61	# appropriately
8683db0e	62	$self->{'immutable_metaclass'} = Class::MOP::Class->create_anon_class(
c23184fc	63	superclasses => [ blessed($self->metaclass) ],
c23184fc	64	methods => $self->create_methods_for_immutable_metaclass,
0ac992ee	65	);
c23184fc	66	}
c23184fc	67
d9586da2	68
c23184fc	69	my %DEFAULT_METHODS = (
d9586da2	70	# I don't really understand this, but removing it breaks tests (groditi)
0ac992ee	71	meta => sub {
c23184fc	72	my $self = shift;
0ac992ee	73	# if it is not blessed, then someone is asking
127d39a7	74	# for the meta of Class::MOP::Immutable
c23184fc	75	return Class::MOP::Class->initialize($self) unless blessed($self);
0ac992ee	76	# otherwise, they are asking for the metaclass
c23184fc	77	# which has been made immutable, which is itself
84bc89b3	78	# except in the cases where it is a metaclass itself
	79	# that has been made immutable and for that we need
	80	# to dig a bit ...
	81	if ($self->isa('Class::MOP::Class')) {
	82	return $self->{'___original_class'}->meta;
	83	}
	84	else {
	85	return $self;
	86	}
c23184fc	87	},
d9586da2	88	is_mutable => sub { 0 },
	89	is_immutable => sub { 1 },
	90	make_immutable => sub { () },
c23184fc	91	);
	92
	93	# NOTE:
0ac992ee	94	# this will actually convert the
0ac992ee	95	# existing metaclass to an immutable
c23184fc	96	# version of itself
c23184fc	97	sub make_metaclass_immutable {
229910b5	98	my ($self, $metaclass, $options) = @_;
229910b5	99
1a84e3f3	100	my %options = (
	101	inline_accessors => 1,
	102	inline_constructor => 1,
	103	inline_destructor => 0,
	104	constructor_name => 'new',
	105	debug => 0,
	106	%$options,
	107	);
	108
	109	%$options = %options; # FIXME who the hell is relying on this?!? tests fail =(
0ac992ee	110
c23184fc	111	if ($options{inline_accessors}) {
	112	foreach my $attr_name ($metaclass->get_attribute_list) {
	113	# inline the accessors
	114	$metaclass->get_attribute($attr_name)
0ac992ee	115	->install_accessors(1);
0ac992ee	116	}
c23184fc	117	}
c23184fc	118
0ac992ee	119	if ($options{inline_constructor}) {
c23184fc	120	my $constructor_class = $options{constructor_class} \|\| 'Class::MOP::Method::Constructor';
c23184fc	121	$metaclass->add_method(
	122	$options{constructor_name},
	123	$constructor_class->new(
4c105333	124	options => \%options,
	125	metaclass => $metaclass,
	126	is_inline => 1,
	127	package_name => $metaclass->name,
	128	name => $options{constructor_name}
c23184fc	129	)
6c2f6b5c	130	) if $options{replace_constructor} or !$metaclass->has_method($options{constructor_name});
0ac992ee	131	}
	132
	133	if ($options{inline_destructor}) {
c23184fc	134	(exists $options{destructor_class})
	135	\|\| confess "The 'inline_destructor' option is present, but "
	136	. "no destructor class was specified";
0ac992ee	137
c23184fc	138	my $destructor_class = $options{destructor_class};
0ac992ee	139
cc05f61c	140	# NOTE:
	141	# we allow the destructor to determine
	142	# if it is needed or not before we actually
	143	# create the destructor too
	144	# - SL
	145	if ($destructor_class->is_needed($metaclass)) {
	146	my $destructor = $destructor_class->new(
	147	options => \%options,
	148	metaclass => $metaclass,
	149	package_name => $metaclass->name,
	150	name => 'DESTROY'
	151	);
	152
	153	$metaclass->add_method('DESTROY' => $destructor)
	154	# NOTE:
	155	# we allow the destructor to determine
	156	# if it is needed or not, it can perform
	157	# all sorts of checks because it has the
	158	# metaclass instance
	159	if $destructor->is_needed;
	160	}
0ac992ee	161	}
0ac992ee	162
c23184fc	163	my $memoized_methods = $self->options->{memoize};
	164	foreach my $method_name (keys %{$memoized_methods}) {
	165	my $type = $memoized_methods->{$method_name};
0ac992ee	166
c23184fc	167	($metaclass->can($method_name))
0ac992ee	168	\|\| confess "Could not find the method '$method_name' in " . $metaclass->name;
0ac992ee	169
c23184fc	170	if ($type eq 'ARRAY') {
	171	$metaclass->{'___' . $method_name} = [ $metaclass->$method_name ];
	172	}
	173	elsif ($type eq 'HASH') {
0ac992ee	174	$metaclass->{'___' . $method_name} = { $metaclass->$method_name };
c23184fc	175	}
	176	elsif ($type eq 'SCALAR') {
	177	$metaclass->{'___' . $method_name} = $metaclass->$method_name;
	178	}
0ac992ee	179	}
0ac992ee	180
0ac992ee	181	$metaclass->{'___original_class'} = blessed($metaclass);
c23184fc	182	bless $metaclass => $self->immutable_metaclass->name;
	183	}
	184
0ac992ee	185	sub make_metaclass_mutable {
229910b5	186	my ($self, $immutable, $options) = @_;
	187
	188	my %options = %$options;
0ac992ee	189
	190	my $original_class = $immutable->get_mutable_metaclass_name;
	191	delete $immutable->{'___original_class'} ;
	192	bless $immutable => $original_class;
	193
	194	my $memoized_methods = $self->options->{memoize};
	195	foreach my $method_name (keys %{$memoized_methods}) {
	196	my $type = $memoized_methods->{$method_name};
	197
	198	($immutable->can($method_name))
	199	\|\| confess "Could not find the method '$method_name' in " . $immutable->name;
	200	if ($type eq 'SCALAR' \|\| $type eq 'ARRAY' \|\| $type eq 'HASH' ) {
	201	delete $immutable->{'___' . $method_name};
	202	}
	203	}
	204
	205	if ($options{inline_destructor} && $immutable->has_method('DESTROY')) {
	206	$immutable->remove_method('DESTROY')
11b56828	207	if blessed($immutable->get_method('DESTROY')) eq $options{destructor_class};
0ac992ee	208	}
0ac992ee	209
b817e248	210	# NOTE:
	211	# 14:01 <@stevan> nah,. you shouldnt
	212	# 14:01 <@stevan> they are just inlined
	213	# 14:01 <@stevan> which is the default in Moose anyway
	214	# 14:02 <@stevan> and adding new attributes will just DWIM
	215	# 14:02 <@stevan> and you really cant change an attribute anyway
	216	# if ($options{inline_accessors}) {
	217	# foreach my $attr_name ($immutable->get_attribute_list) {
	218	# my $attr = $immutable->get_attribute($attr_name);
	219	# $attr->remove_accessors;
	220	# $attr->install_accessors(0);
	221	# }
	222	# }
	223
	224	# 14:26 <@stevan> the only user of ::Method::Constructor is immutable
	225	# 14:27 <@stevan> if someone uses it outside of immutable,.. they are either: mst or groditi
	226	# 14:27 <@stevan> so I am not worried
11b56828	227	if ($options{inline_constructor} && $immutable->has_method($options{constructor_name})) {
0ac992ee	228	my $constructor_class = $options{constructor_class} \|\| 'Class::MOP::Method::Constructor';
0ac992ee	229	$immutable->remove_method( $options{constructor_name} )
11b56828	230	if blessed($immutable->get_method($options{constructor_name})) eq $constructor_class;
0ac992ee	231	}
	232	}
	233
c23184fc	234	sub create_methods_for_immutable_metaclass {
c23184fc	235	my $self = shift;
0ac992ee	236
c23184fc	237	my %methods = %DEFAULT_METHODS;
0ac992ee	238
c23184fc	239	foreach my $read_only_method (@{$self->options->{read_only}}) {
c23184fc	240	my $method = $self->metaclass->meta->find_method_by_name($read_only_method);
0ac992ee	241
c23184fc	242	(defined $method)
c23184fc	243	\|\| confess "Could not find the method '$read_only_method' in " . $self->metaclass->name;
0ac992ee	244
c23184fc	245	$methods{$read_only_method} = sub {
	246	confess "This method is read-only" if scalar @_ > 1;
	247	goto &{$method->body}
	248	};
	249	}
0ac992ee	250
c23184fc	251	foreach my $cannot_call_method (@{$self->options->{cannot_call}}) {
	252	$methods{$cannot_call_method} = sub {
	253	confess "This method ($cannot_call_method) cannot be called on an immutable instance";
	254	};
0ac992ee	255	}
0ac992ee	256
c23184fc	257	my $memoized_methods = $self->options->{memoize};
c23184fc	258	foreach my $method_name (keys %{$memoized_methods}) {
	259	my $type = $memoized_methods->{$method_name};
	260	if ($type eq 'ARRAY') {
	261	$methods{$method_name} = sub { @{$_[0]->{'___' . $method_name}} };
	262	}
	263	elsif ($type eq 'HASH') {
	264	$methods{$method_name} = sub { %{$_[0]->{'___' . $method_name}} };
	265	}
	266	elsif ($type eq 'SCALAR') {
	267	$methods{$method_name} = sub { $_[0]->{'___' . $method_name} };
0ac992ee	268	}
0ac992ee	269	}
53299a7b	270
5f3efd66	271	my $wrapped_methods = $self->options->{wrapped};
	272
	273	foreach my $method_name (keys %{ $wrapped_methods }) {
53299a7b	274	my $method = $self->metaclass->meta->find_method_by_name($method_name);
5f3efd66	275
	276	(defined $method)
	277	\|\| confess "Could not find the method '$method_name' in " . $self->metaclass->name;
	278
	279	my $wrapper = $wrapped_methods->{$method_name};
	280
	281	$methods{$method_name} = sub { $wrapper->($method, @_) };
53299a7b	282	}
0ac992ee	283
	284	$methods{get_mutable_metaclass_name} = sub { (shift)->{'___original_class'} };
	285
9f3ff885	286	$methods{immutable_transformer} = sub { $self };
9f3ff885	287
c23184fc	288	return \%methods;
	289	}
	290
	291	1;
	292
	293	__END__
	294
	295	=pod
	296
0ac992ee	297	=head1 NAME
c23184fc	298
	299	Class::MOP::Immutable - A class to transform Class::MOP::Class metaclasses
	300
	301	=head1 SYNOPSIS
	302
96e38ba6	303	use Class::MOP::Immutable;
0ac992ee	304
96e38ba6	305	my $immutable_metaclass = Class::MOP::Immutable->new($metaclass, {
	306	read_only => [qw/superclasses/],
	307	cannot_call => [qw/
	308	add_method
	309	alias_method
	310	remove_method
	311	add_attribute
	312	remove_attribute
	313	add_package_symbol
0ac992ee	314	remove_package_symbol
96e38ba6	315	/],
	316	memoize => {
	317	class_precedence_list => 'ARRAY',
0ac992ee	318	compute_all_applicable_attributes => 'ARRAY',
	319	get_meta_instance => 'SCALAR',
	320	get_method_map => 'SCALAR',
96e38ba6	321	}
0ac992ee	322	});
96e38ba6	323
	324	$immutable_metaclass->make_metaclass_immutable(@_)
	325
c23184fc	326	=head1 DESCRIPTION
c23184fc	327
0ac992ee	328	This is basically a module for applying a transformation on a given
0ac992ee	329	metaclass. Current features include making methods read-only,
96e38ba6	330	making methods un-callable and memoizing methods (in a type specific
0ac992ee	331	way too).
96e38ba6	332
127d39a7	333	This module is not for the feint of heart, it does some whacky things
	334	to the metaclass in order to make it immutable. If you are just curious,
	335	I suggest you turn back now, there is nothing to see here.
96e38ba6	336
c23184fc	337	=head1 METHODS
	338
	339	=over 4
	340
96e38ba6	341	=item B<new ($metaclass, \%options)>
96e38ba6	342
0ac992ee	343	Given a C<$metaclass> and a set of C<%options> this module will
	344	prepare an immutable version of the C<$metaclass>, which can then
	345	be applied to the C<$metaclass> using the C<make_metaclass_immutable>
96e38ba6	346	method.
96e38ba6	347
c23184fc	348	=item B<options>
c23184fc	349
96e38ba6	350	Returns the options HASH set in C<new>.
96e38ba6	351
c23184fc	352	=item B<metaclass>
c23184fc	353
96e38ba6	354	Returns the metaclass set in C<new>.
96e38ba6	355
c23184fc	356	=item B<immutable_metaclass>
c23184fc	357
96e38ba6	358	Returns the immutable metaclass created within C<new>.
96e38ba6	359
c23184fc	360	=back
	361
	362	=over 4
	363
	364	=item B<create_immutable_metaclass>
	365
0ac992ee	366	This will create the immutable version of the C<$metaclass>, but will
0ac992ee	367	not actually change the original metaclass.
96e38ba6	368
c23184fc	369	=item B<create_methods_for_immutable_metaclass>
c23184fc	370
0ac992ee	371	This will create all the methods for the immutable metaclass based
96e38ba6	372	on the C<%options> passed into C<new>.
96e38ba6	373
0ac992ee	374	=item B<make_metaclass_immutable (%options)>
c23184fc	375
96e38ba6	376	This will actually change the C<$metaclass> into the immutable version.
96e38ba6	377
0ac992ee	378	=item B<make_metaclass_mutable (%options)>
	379
	380	This will change the C<$metaclass> into the mutable version by reversing
	381	the immutable process. C<%options> should be the same options that were
	382	given to make_metaclass_immutable.
	383
c23184fc	384	=back
	385
	386	=head1 AUTHORS
	387
	388	Stevan Little E<lt>stevan@iinteractive.comE<gt>
	389
	390	=head1 COPYRIGHT AND LICENSE
	391
69e3ab0a	392	Copyright 2006-2008 by Infinity Interactive, Inc.
c23184fc	393
	394	L<http://www.iinteractive.com>
	395
	396	This library is free software; you can redistribute it and/or modify
0ac992ee	397	it under the same terms as Perl itself.
c23184fc	398
c23184fc	399	=cut