lib/Moose/Meta/Class/Immutable/Trait.pm

   1 package Moose::Meta::Class::Immutable::Trait;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Class::MOP;
   7 use Scalar::Util qw( blessed );
   8
   9 our $AUTHORITY = 'cpan:STEVAN';
  10
  11 use base 'Class::MOP::Class::Immutable::Trait';
  12
  13 sub add_role { $_[1]->_immutable_cannot_call }
  14
  15 sub calculate_all_roles {
  16     my $orig = shift;
  17     my $self = shift;
  18     @{ $self->{__immutable}{calculate_all_roles} ||= [ $self->$orig ] };
  19 }
  20
  21 sub calculate_all_roles_with_inheritance {
  22     my $orig = shift;
  23     my $self = shift;
  24     @{ $self->{__immutable}{calculate_all_roles_with_inheritance} ||= [ $self->$orig ] };
  25 }
  26
  27 sub does_role {
  28     shift;
  29     my $self = shift;
  30     my $role = shift;
  31
  32     (defined $role)
  33         || $self->throw_error("You must supply a role name to look for");
  34
  35     $self->{__immutable}{does_role} ||= { map { $_->name => 1 } $self->calculate_all_roles_with_inheritance };
  36
  37     my $name = blessed $role ? $role->name : $role;
  38
  39     return $self->{__immutable}{does_role}{$name};
  40 }
  41
  42 1;
  43
  44 # ABSTRACT: Implements immutability for metaclass objects
  45
  46 __END__
  47
  48 =pod
  49
  50 =head1 DESCRIPTION
  51
  52 This class makes some Moose-specific metaclass methods immutable. This
  53 is deep guts.
  54
  55 =head1 BUGS
  56
  57 See L<Moose/BUGS> for details on reporting bugs.
  58
  59 =cut
  60