2 package Class::MOP::Class::Immutable;
7 use Class::MOP::Method::Constructor;
10 use Scalar::Util 'blessed';
12 our $VERSION = '0.04';
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";
47 # superclasses is an accessor, so
48 # it just cannot be changed
51 (!@_) || confess 'Cannot change the "superclasses" on an immmutable instance';
52 @{$class->get_package_symbol('@ISA')};
58 sub is_immutable { 1 }
60 sub make_immutable { () }
62 sub make_metaclass_immutable {
63 my ($class, $metaclass, %options) = @_;
66 # i really need the // (defined-or) operator here
67 $options{inline_accessors} = 1 unless exists $options{inline_accessors};
68 $options{inline_constructor} = 1 unless exists $options{inline_constructor};
69 $options{constructor_name} = 'new' unless exists $options{constructor_name};
70 $options{debug} = 0 unless exists $options{debug};
72 my $meta_instance = $metaclass->get_meta_instance;
73 $metaclass->{'___class_precedence_list'} = [ $metaclass->class_precedence_list ];
74 $metaclass->{'___compute_all_applicable_attributes'} = [ $metaclass->compute_all_applicable_attributes ];
75 $metaclass->{'___get_meta_instance'} = $meta_instance;
76 $metaclass->{'___original_class'} = blessed($metaclass);
78 if ($options{inline_accessors}) {
79 foreach my $attr_name ($metaclass->get_attribute_list) {
80 # inline the accessors
81 $metaclass->get_attribute($attr_name)
82 ->install_accessors(1);
86 if ($options{inline_constructor}) {
87 my $constructor_class = $options{constructor_class} || 'Class::MOP::Method::Constructor';
88 $metaclass->add_method(
89 $options{constructor_name},
90 $constructor_class->new(
92 meta_instance => $meta_instance,
93 attributes => $metaclass->{'___compute_all_applicable_attributes'}
98 # now cache the method map ...
99 $metaclass->{'___get_method_map'} = $metaclass->get_method_map;
101 bless $metaclass => $class;
106 sub get_meta_instance { (shift)->{'___get_meta_instance'} }
107 sub class_precedence_list { @{(shift)->{'___class_precedence_list'}} }
108 sub compute_all_applicable_attributes { @{(shift)->{'___compute_all_applicable_attributes'}} }
109 sub get_mutable_metaclass_name { (shift)->{'___original_class'} }
110 sub get_method_map { (shift)->{'___get_method_map'} }
120 Class::MOP::Class::Immutable - An immutable version of Class::MOP::Class
127 __PACKAGE__->meta->add_attribute('x' => (accessor => 'x', default => 10));
128 __PACKAGE__->meta->add_attribute('y' => (accessor => 'y'));
132 $class->meta->new_object(@_);
141 __PACKAGE__->meta->make_immutable(); # close the class
145 Class::MOP offers many benefits to object oriented development but it
146 comes at a cost. Pure Class::MOP classes can be quite a bit slower than
147 the typical hand coded Perl classes. This is because just about
148 I<everything> is recalculated on the fly, and nothing is cached. The
149 reason this is so, is because Perl itself allows you to modify virtually
150 everything at runtime. Class::MOP::Class::Immutable offers an alternative
153 By making your class immutable, you are promising that you will not
154 modify your inheritence tree or the attributes of any classes in
155 that tree. Since runtime modifications like this are fairly atypical
156 (and usually recomended against), this is not usally a very hard promise
157 to make. For making this promise you are given a wide range of
158 optimization options which bring speed close to (and sometimes above)
159 those of typical hand coded Perl.
167 This will return a B<Class::MOP::Class> instance which is related
172 =head2 Introspection and Construction
176 =item B<make_metaclass_immutable>
178 The arguments to C<Class::MOP::Class::make_immutable> are passed
179 to this method, which
183 =item I<inline_accessors (Bool)>
185 =item I<inline_constructor (Bool)>
187 =item I<debug (Bool)>
189 =item I<constructor_name (Str)>
193 =item B<is_immutable>
197 =item B<make_immutable>
199 =item B<get_mutable_metaclass_name>
203 =head2 Methods which will die if you touch them.
207 =item B<add_attribute>
211 =item B<add_package_symbol>
213 =item B<alias_method>
215 =item B<remove_attribute>
217 =item B<remove_method>
219 =item B<remove_package_symbol>
223 =head2 Methods which work slightly differently.
227 =item B<superclasses>
229 This method becomes read-only in an immutable class.
233 =head2 Cached methods
237 =item B<class_precedence_list>
239 =item B<compute_all_applicable_attributes>
241 =item B<get_meta_instance>
243 =item B<get_method_map>
249 Stevan Little E<lt>stevan@iinteractive.comE<gt>
251 Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
253 =head1 COPYRIGHT AND LICENSE
255 Copyright 2006 by Infinity Interactive, Inc.
257 L<http://www.iinteractive.com>
259 This library is free software; you can redistribute it and/or modify
260 it under the same terms as Perl itself.