Merge the topic/mi-methods-attributes branch.
[gitmo/Class-MOP.git] / lib / Class / MOP / Class / Immutable / Trait.pm
CommitLineData
f5d08022 1package Class::MOP::Class::Immutable::Trait;
2
3use strict;
4use warnings;
5
6use MRO::Compat;
7
6446bd59 8use Carp 'confess';
f5d08022 9use Scalar::Util 'blessed', 'weaken';
10
ec52b37a 11our $VERSION = '0.97';
f04900bf 12$VERSION = eval $VERSION;
13our $AUTHORITY = 'cpan:STEVAN';
14
f5d08022 15# the original class of the metaclass instance
34233474 16sub _get_mutable_metaclass_name { $_[0]{__immutable}{original_class} }
f5d08022 17
78f6e9c6 18sub is_mutable { 0 }
19sub is_immutable { 1 }
f5d08022 20
a986e165 21sub _immutable_metaclass { ref $_[1] }
22
f5d08022 23sub superclasses {
78f6e9c6 24 my $orig = shift;
25 my $self = shift;
26 confess "This method is read-only" if @_;
27 $self->$orig;
f5d08022 28}
29
6446bd59 30sub _immutable_cannot_call {
e347ce3f 31 my $name = shift;
32 Carp::confess "The '$name' method cannot be called on an immutable instance";
6446bd59 33}
f5d08022 34
e347ce3f 35for my $name (qw/add_method alias_method remove_method add_attribute remove_attribute remove_package_symbol/) {
36 no strict 'refs';
37 *{__PACKAGE__."::$name"} = sub { _immutable_cannot_call($name) };
38}
f5d08022 39
6446bd59 40sub class_precedence_list {
78f6e9c6 41 my $orig = shift;
42 my $self = shift;
43 @{ $self->{__immutable}{class_precedence_list}
44 ||= [ $self->$orig ] };
6446bd59 45}
46
47sub linearized_isa {
78f6e9c6 48 my $orig = shift;
49 my $self = shift;
50 @{ $self->{__immutable}{linearized_isa} ||= [ $self->$orig ] };
6446bd59 51}
52
53sub get_all_methods {
78f6e9c6 54 my $orig = shift;
55 my $self = shift;
56 @{ $self->{__immutable}{get_all_methods} ||= [ $self->$orig ] };
6446bd59 57}
58
59sub get_all_method_names {
78f6e9c6 60 my $orig = shift;
61 my $self = shift;
62 @{ $self->{__immutable}{get_all_method_names} ||= [ $self->$orig ] };
6446bd59 63}
64
65sub get_all_attributes {
78f6e9c6 66 my $orig = shift;
67 my $self = shift;
68 @{ $self->{__immutable}{get_all_attributes} ||= [ $self->$orig ] };
6446bd59 69}
f5d08022 70
6446bd59 71sub get_meta_instance {
78f6e9c6 72 my $orig = shift;
73 my $self = shift;
74 $self->{__immutable}{get_meta_instance} ||= $self->$orig;
6446bd59 75}
76
241646a3 77sub _get_method_map {
78f6e9c6 78 my $orig = shift;
79 my $self = shift;
241646a3 80 $self->{__immutable}{_get_method_map} ||= $self->$orig;
6446bd59 81}
f5d08022 82
86e1c8d8 83sub add_package_symbol {
84 my $orig = shift;
85 my $self = shift;
86 confess "Cannot add package symbols to an immutable metaclass"
87 unless ( caller(3) )[3] eq 'Class::MOP::Package::get_package_symbol';
88
89 $self->$orig(@_);
90}
91
f5d08022 921;
15726b75 93
94__END__
95
96=pod
97
98=head1 NAME
99
100Class::MOP::Class::Immutable::Trait - Implements immutability for metaclass objects
101
102=head1 DESCRIPTION
103
9e25e01f 104This class provides a pseudo-trait that is applied to immutable metaclass
105objects. In reality, it is simply a parent class.
106
107It implements caching and read-only-ness for various metaclass methods.
15726b75 108
109=head1 AUTHOR
110
111Yuval Kogman E<lt>nothingmuch@cpan.orgE<gt>
112
113=head1 COPYRIGHT AND LICENSE
114
115Copyright 2009 by Infinity Interactive, Inc.
116
117L<http://www.iinteractive.com>
118
119This library is free software; you can redistribute it and/or modify
120it under the same terms as Perl itself.
121
122=cut
123