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

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

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