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