File Coverage

blib/lib/Moose/Meta/Class/Immutable/Trait.pm
Criterion Covered Total %
statement 35 52 67.3
branch 4 8 50.0
condition 5 12 41.6
subroutine 10 14 71.4
pod 0 4 0.0
total 54 90 60.0


line stmt bran cond sub pod time code
1             package Moose::Meta::Class::Immutable::Trait;
2             our $VERSION = '2.2205';
3              
4 380     380   2769 use strict;
  380         2244  
  380         12941  
5 380     380   2115 use warnings;
  380         899  
  380         10872  
6              
7 380     380   3546 use Class::MOP;
  380         2103  
  380         9972  
8 380     380   2120 use Scalar::Util qw( blessed );
  380         1040  
  380         24189  
9              
10 380     380   3888 use parent 'Class::MOP::Class::Immutable::Trait';
  380         977  
  380         2503  
11              
12 380     380   28011 use Moose::Util 'throw_exception';
  380         1047  
  380         2754  
13              
14 0     0 0 0 sub add_role { $_[1]->_immutable_cannot_call }
  1     1   5  
15              
16             sub calculate_all_roles {
17 0     0 0 0 my $orig = shift;
  15     15   36  
18 0         0 my $self = shift;
  15         36  
19 0   0     0 @{ $self->{__immutable}{calculate_all_roles} ||= [ $self->$orig ] };
  0   100     0  
  15         26  
  15         87  
20             }
21              
22             sub calculate_all_roles_with_inheritance {
23 0     0 0 0 my $orig = shift;
  12     12   25  
24 0         0 my $self = shift;
  12         25  
25 0   0     0 @{ $self->{__immutable}{calculate_all_roles_with_inheritance} ||= [ $self->$orig ] };
  0   50     0  
  12         22  
  12         82  
26             }
27              
28             sub does_role {
29 0     0 0 0 shift;
  85     85   143  
30 0         0 my $self = shift;
  85         128  
31 0         0 my $role = shift;
  85         128  
32              
33 0 0       0 (defined $role)
  85 100       185  
34             || throw_exception( RoleNameRequired => class_name => $self->name );
35              
36 0   0     0 $self->{__immutable}{does_role} ||= { map { $_->name => 1 } $self->calculate_all_roles_with_inheritance };
  0   100     0  
  84         284  
  15         131  
37              
38 0 0       0 my $name = blessed $role ? $role->name : $role;
  84 100       283  
39              
40 0         0 return $self->{__immutable}{does_role}{$name};
  84         518  
41             }
42              
43             1;
44              
45             # ABSTRACT: Implements immutability for metaclass objects
46              
47             __END__
48              
49             =pod
50              
51             =encoding UTF-8
52              
53             =head1 NAME
54              
55             Moose::Meta::Class::Immutable::Trait - Implements immutability for metaclass objects
56              
57             =head1 VERSION
58              
59             version 2.2205
60              
61             =head1 DESCRIPTION
62              
63             This class makes some Moose-specific metaclass methods immutable. This
64             is deep guts.
65              
66             =head1 BUGS
67              
68             See L<Moose/BUGS> for details on reporting bugs.
69              
70             =head1 AUTHORS
71              
72             =over 4
73              
74             =item *
75              
76             Stevan Little <stevan@cpan.org>
77              
78             =item *
79              
80             Dave Rolsky <autarch@urth.org>
81              
82             =item *
83              
84             Jesse Luehrs <doy@cpan.org>
85              
86             =item *
87              
88             Shawn M Moore <sartak@cpan.org>
89              
90             =item *
91              
92             יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
93              
94             =item *
95              
96             Karen Etheridge <ether@cpan.org>
97              
98             =item *
99              
100             Florian Ragwitz <rafl@debian.org>
101              
102             =item *
103              
104             Hans Dieter Pearcey <hdp@cpan.org>
105              
106             =item *
107              
108             Chris Prather <chris@prather.org>
109              
110             =item *
111              
112             Matt S Trout <mstrout@cpan.org>
113              
114             =back
115              
116             =head1 COPYRIGHT AND LICENSE
117              
118             This software is copyright (c) 2006 by Infinity Interactive, Inc.
119              
120             This is free software; you can redistribute it and/or modify it under
121             the same terms as the Perl 5 programming language system itself.
122              
123             =cut