lib/Class/MOP/Class/Immutable/Trait.pm

   1 package Class::MOP::Class::Immutable::Trait;
   2
   3 use strict;
   4 use warnings;
   5
   6 use MRO::Compat;
   7
   8 use Carp 'confess';
   9 use Scalar::Util 'blessed', 'weaken';
  10
  11 our $VERSION   = '0.87';
  12 $VERSION = eval $VERSION;
  13 our $AUTHORITY = 'cpan:STEVAN';
  14
  15 # the original class of the metaclass instance
  16 sub get_mutable_metaclass_name { $_[0]{__immutable}{original_class} }
  17
  18 sub immutable_options { %{ $_[0]{__immutable}{options} } }
  19
  20 sub is_mutable   {0}
  21 sub is_immutable {1}
  22
  23 sub superclasses {
  24     confess "This method is read-only" if @_ > 1;
  25     $_[0]->next::method;
  26 }
  27
  28 sub _immutable_cannot_call {
  29     Carp::confess "This method cannot be called on an immutable instance";
  30 }
  31
  32 sub add_method            { shift->_immutable_cannot_call }
  33 sub alias_method          { shift->_immutable_cannot_call }
  34 sub remove_method         { shift->_immutable_cannot_call }
  35 sub add_attribute         { shift->_immutable_cannot_call }
  36 sub remove_attribute      { shift->_immutable_cannot_call }
  37 sub remove_package_symbol { shift->_immutable_cannot_call }
  38
  39 sub class_precedence_list {
  40     @{ $_[0]{__immutable}{class_precedence_list}
  41             ||= [ shift->next::method ] };
  42 }
  43
  44 sub linearized_isa {
  45     @{ $_[0]{__immutable}{linearized_isa} ||= [ shift->next::method ] };
  46 }
  47
  48 sub get_all_methods {
  49     @{ $_[0]{__immutable}{get_all_methods} ||= [ shift->next::method ] };
  50 }
  51
  52 sub get_all_method_names {
  53     @{ $_[0]{__immutable}{get_all_method_names} ||= [ shift->next::method ] };
  54 }
  55
  56 sub get_all_attributes {
  57     @{ $_[0]{__immutable}{get_all_attributes} ||= [ shift->next::method ] };
  58 }
  59
  60 sub get_meta_instance {
  61     $_[0]{__immutable}{get_meta_instance} ||= shift->next::method;
  62 }
  63
  64 sub get_method_map {
  65     $_[0]{__immutable}{get_method_map} ||= shift->next::method;
  66 }
  67
  68 sub add_package_symbol {
  69     confess "Cannot add package symbols to an immutable metaclass"
  70         unless ( caller(1) )[3] eq 'Class::MOP::Package::get_package_symbol';
  71
  72     shift->next::method(@_);
  73 }
  74
  75 1;
  76
  77 __END__
  78
  79 =pod
  80
  81 =head1 NAME
  82
  83 Class::MOP::Class::Immutable::Trait - Implements immutability for metaclass objects
  84
  85 =head1 DESCRIPTION
  86
  87 This class provides a pseudo-trait that is applied to immutable metaclass
  88 objects. In reality, it is simply a parent class.
  89
  90 It implements caching and read-only-ness for various metaclass methods.
  91
  92 =head1 AUTHOR
  93
  94 Yuval Kogman E<lt>nothingmuch@cpan.orgE<gt>
  95
  96 =head1 COPYRIGHT AND LICENSE
  97
  98 Copyright 2009 by Infinity Interactive, Inc.
  99
 100 L<http://www.iinteractive.com>
 101
 102 This library is free software; you can redistribute it and/or modify
 103 it under the same terms as Perl itself.
 104
 105 =cut
 106