2 package Class::MOP::Class::Immutable;
7 use Class::MOP::Method::Constructor;
10 use Scalar::Util 'blessed';
12 our $VERSION = '0.03';
13 our $AUTHORITY = 'cpan:STEVAN';
15 use base 'Class::MOP::Class';
17 # enforce the meta-circularity here
18 # and hide the Immutable part
22 # if it is not blessed, then someone is asking
23 # for the meta of Class::MOP::Class::Immutable
24 return Class::MOP::Class->initialize($self) unless blessed($self);
25 # otherwise, they are asking for the metaclass
26 # which has been made immutable, which is itself
30 # methods which can *not* be called
42 confess "Cannot call method '$meth' on an immutable instance";
46 sub get_package_symbol {
47 my ($self, $variable) = @_;
48 my ($name, $sigil, $type) = $self->_deconstruct_variable_name($variable);
49 return *{$self->namespace->{$name}}{$type}
50 if exists $self->namespace->{$name};
52 # we have to do this here in order to preserve
53 # perl's autovivification of variables. However
54 # we do cut off direct access to add_package_symbol
56 $self->Class::MOP::Package::add_package_symbol($variable);
60 # superclasses is an accessor, so
61 # it just cannot be changed
64 (!@_) || confess 'Cannot change the "superclasses" on an immmutable instance';
65 @{$class->get_package_symbol('@ISA')};
71 sub is_immutable { 1 }
73 sub make_immutable { () }
75 sub make_metaclass_immutable {
76 my ($class, $metaclass, %options) = @_;
79 # i really need the // (defined-or) operator here
80 $options{inline_accessors} = 1 unless exists $options{inline_accessors};
81 $options{inline_constructor} = 1 unless exists $options{inline_constructor};
82 $options{constructor_name} = 'new' unless exists $options{constructor_name};
83 $options{debug} = 0 unless exists $options{debug};
85 my $meta_instance = $metaclass->get_meta_instance;
86 $metaclass->{'___class_precedence_list'} = [ $metaclass->class_precedence_list ];
87 $metaclass->{'___compute_all_applicable_attributes'} = [ $metaclass->compute_all_applicable_attributes ];
88 $metaclass->{'___get_meta_instance'} = $meta_instance;
89 $metaclass->{'___original_class'} = blessed($metaclass);
91 if ($options{inline_accessors}) {
92 foreach my $attr_name ($metaclass->get_attribute_list) {
93 # inline the accessors
94 $metaclass->get_attribute($attr_name)
95 ->install_accessors(1);
99 if ($options{inline_constructor}) {
100 my $constructor_class = $options{constructor_class} || 'Class::MOP::Method::Constructor';
101 $metaclass->add_method(
102 $options{constructor_name},
103 $constructor_class->new(
104 options => \%options,
105 meta_instance => $meta_instance,
106 attributes => $metaclass->{'___compute_all_applicable_attributes'}
111 # now cache the method map ...
112 $metaclass->{'___method_map'} = $metaclass->get_method_map;
114 bless $metaclass => $class;
119 sub get_meta_instance { (shift)->{'___get_meta_instance'} }
120 sub class_precedence_list { @{(shift)->{'___class_precedence_list'}} }
121 sub compute_all_applicable_attributes { @{(shift)->{'___compute_all_applicable_attributes'}} }
122 sub get_mutable_metaclass_name { (shift)->{'___original_class'} }
123 sub get_method_map { (shift)->{'___method_map'} }
133 Class::MOP::Class::Immutable - An immutable version of Class::MOP::Class
140 __PACKAGE__->meta->add_attribute('x' => (accessor => 'x', default => 10));
141 __PACKAGE__->meta->add_attribute('y' => (accessor => 'y'));
145 $class->meta->new_object(@_);
154 __PACKAGE__->meta->make_immutable(); # close the class
158 Class::MOP offers many benefits to object oriented development but it
159 comes at a cost. Pure Class::MOP classes can be quite a bit slower than
160 the typical hand coded Perl classes. This is because just about
161 I<everything> is recalculated on the fly, and nothing is cached. The
162 reason this is so, is because Perl itself allows you to modify virtually
163 everything at runtime. Class::MOP::Class::Immutable offers an alternative
166 By making your class immutable, you are promising that you will not
167 modify your inheritence tree or the attributes of any classes in
168 that tree. Since runtime modifications like this are fairly atypical
169 (and usually recomended against), this is not usally a very hard promise
170 to make. For making this promise you are given a wide range of
171 optimization options which bring speed close to (and sometimes above)
172 those of typical hand coded Perl.
180 This will return a B<Class::MOP::Class> instance which is related
185 =head2 Introspection and Construction
189 =item B<make_metaclass_immutable>
191 The arguments to C<Class::MOP::Class::make_immutable> are passed
192 to this method, which
196 =item I<inline_accessors (Bool)>
198 =item I<inline_constructor (Bool)>
200 =item I<debug (Bool)>
202 =item I<constructor_name (Str)>
206 =item B<is_immutable>
210 =item B<make_immutable>
212 =item B<get_mutable_metaclass_name>
216 =head2 Methods which will die if you touch them.
220 =item B<add_attribute>
224 =item B<add_package_symbol>
226 =item B<alias_method>
228 =item B<remove_attribute>
230 =item B<remove_method>
232 =item B<remove_package_symbol>
236 =head2 Methods which work slightly differently.
240 =item B<superclasses>
242 This method becomes read-only in an immutable class.
244 =item B<get_package_symbol>
246 This method must handle package variable autovivification
247 correctly, while still disallowing C<add_package_symbol>.
251 =head2 Cached methods
255 =item B<class_precedence_list>
257 =item B<compute_all_applicable_attributes>
259 =item B<get_meta_instance>
261 =item B<get_method_map>
267 Stevan Little E<lt>stevan@iinteractive.comE<gt>
269 Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
271 =head1 COPYRIGHT AND LICENSE
273 Copyright 2006 by Infinity Interactive, Inc.
275 L<http://www.iinteractive.com>
277 This library is free software; you can redistribute it and/or modify
278 it under the same terms as Perl itself.