lib/Class/MOP/Class/Immutable.pm

   1
   2 package Class::MOP::Class::Immutable;
   3
   4 use strict;
   5 use warnings;
   6
   7 use Carp         'confess';
   8 use Scalar::Util 'blessed';
   9
  10 our $VERSION = '0.01';
  11
  12 use base 'Class::MOP::Class';
  13
  14 # methods which can *not* be called
  15
  16 sub reinitialize { confess 'Cannot call method "reinitialize" on an immutable instance' }
  17
  18 sub add_method    { confess 'Cannot call method "add_method" on an immutable instance'    }
  19 sub alias_method  { confess 'Cannot call method "alias_method" on an immutable instance'  }
  20 sub remove_method { confess 'Cannot call method "remove_method" on an immutable instance' }
  21
  22 sub add_attribute    { confess 'Cannot call method "add_attribute" on an immutable instance'    }
  23 sub remove_attribute { confess 'Cannot call method "remove_attribute" on an immutable instance' }
  24
  25 sub add_package_variable    { confess 'Cannot call method "add_package_variable" on an immutable instance'    }
  26 sub remove_package_variable { confess 'Cannot call method "remove_package_variable" on an immutable instance' }
  27
  28 # NOTE:
  29 # superclasses is an accessor, so
  30 # it just cannot be changed
  31 sub superclasses {
  32     my $class = shift;
  33     (!@_) || confess 'Cannot change the "superclasses" on an immmutable instance';
  34     no strict 'refs';
  35     @{$class->name . '::ISA'};
  36 }
  37
  38 # predicates
  39
  40 sub is_mutable   { 0 }
  41 sub is_immutable { 1 }
  42
  43 sub make_immutable { () }
  44
  45 sub make_metaclass_immutable {
  46     my ($class, $metaclass) = @_;
  47     $metaclass->{'___class_precedence_list'} = [ $metaclass->class_precedence_list ];
  48     $metaclass->{'___get_meta_instance'} = $metaclass->get_meta_instance;
  49     $metaclass->{'___compute_all_applicable_attributes'} = [ $metaclass->compute_all_applicable_attributes ];
  50     $metaclass->{'___original_class'} = blessed($metaclass);
  51     bless $metaclass => $class;
  52 }
  53
  54 # cached methods
  55
  56 sub get_meta_instance { (shift)->{'___get_meta_instance'} }
  57
  58 sub class_precedence_list {
  59     @{ (shift)->{'___class_precedence_list'} }
  60 }
  61
  62 sub compute_all_applicable_attributes {
  63     @{ (shift)->{'___compute_all_applicable_attributes'} }
  64 }
  65
  66 1;
  67
  68 __END__
  69
  70 =pod
  71
  72 =head1 NAME
  73
  74 Class::MOP::Class::Immutable - An immutable version of Class::MOP::Class
  75
  76 =head1 SYNOPSIS
  77
  78 =head1 DESCRIPTION
  79
  80 =head1 METHODS
  81
  82 =over 4
  83
  84 =item B<meta>
  85
  86 This will return a B<Class::MOP::Class> instance which is related
  87 to this class.
  88
  89 =back
  90
  91 =over 4
  92
  93
  94 =back
  95
  96 =head1 AUTHOR
  97
  98 Stevan Little E<lt>stevan@iinteractive.comE<gt>
  99
 100 =head1 COPYRIGHT AND LICENSE
 101
 102 Copyright 2006 by Infinity Interactive, Inc.
 103
 104 L<http://www.iinteractive.com>
 105
 106 This library is free software; you can redistribute it and/or modify
 107 it under the same terms as Perl itself.
 108
 109 =cut