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 $VERSION   = '1.19';
  10 $VERSION = eval $VERSION;
  11 our $AUTHORITY = 'cpan:STEVAN';
  12
  13 use base 'Class::MOP::Class::Immutable::Trait';
  14
  15 sub add_role { $_[1]->_immutable_cannot_call }
  16
  17 sub calculate_all_roles {
  18     my $orig = shift;
  19     my $self = shift;
  20     @{ $self->{__immutable}{calculate_all_roles} ||= [ $self->$orig ] };
  21 }
  22
  23 sub calculate_all_roles_with_inheritance {
  24     my $orig = shift;
  25     my $self = shift;
  26     @{ $self->{__immutable}{calculate_all_roles_with_inheritance} ||= [ $self->$orig ] };
  27 }
  28
  29 sub does_role {
  30     shift;
  31     my $self = shift;
  32     my $role = shift;
  33
  34     (defined $role)
  35         || $self->throw_error("You must supply a role name to look for");
  36
  37     $self->{__immutable}{does_role} ||= { map { $_->name => 1 } $self->calculate_all_roles_with_inheritance };
  38
  39     my $name = blessed $role ? $role->name : $role;
  40
  41     return $self->{__immutable}{does_role}{$name};
  42 }
  43
  44 1;
  45
  46 __END__
  47
  48 =pod
  49
  50 =head1 NAME
  51
  52 Moose::Meta::Class::Immutable::Trait - Implements immutability for metaclass objects
  53
  54 =head1 DESCRIPTION
  55
  56 This class makes some Moose-specific metaclass methods immutable. This
  57 is deep guts.
  58
  59 =head1 BUGS
  60
  61 See L<Moose/BUGS> for details on reporting bugs.
  62
  63 =head1 AUTHOR
  64
  65 Yuval Kogman E<lt>nothingmuch@cpan.orgE<gt>
  66
  67 =head1 COPYRIGHT AND LICENSE
  68
  69 Copyright 2009 by Infinity Interactive, Inc.
  70
  71 L<http://www.iinteractive.com>
  72
  73 This library is free software; you can redistribute it and/or modify
  74 it under the same terms as Perl itself.
  75
  76 =cut
  77