line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package MooseX::Role::Strict; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
54168
|
use warnings; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
69
|
|
4
|
2
|
|
|
2
|
|
11
|
use strict; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
100
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
our $VERSION = 0.05; |
7
|
|
|
|
|
|
|
|
8
|
2
|
|
|
2
|
|
1051
|
use MooseX::Meta::Role::Strict; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
use Moose::Role; |
10
|
|
|
|
|
|
|
use Moose::Exporter; |
11
|
|
|
|
|
|
|
Moose::Exporter->setup_import_methods( also => 'Moose::Role' ); |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
sub init_meta { |
14
|
|
|
|
|
|
|
my ( $class, %opt ) = @_; |
15
|
|
|
|
|
|
|
return Moose::Role->init_meta( ## |
16
|
|
|
|
|
|
|
%opt, ## |
17
|
|
|
|
|
|
|
metaclass => 'MooseX::Meta::Role::Strict' |
18
|
|
|
|
|
|
|
); |
19
|
|
|
|
|
|
|
} |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
package # Hide from PAUSE |
22
|
|
|
|
|
|
|
MooseX::Meta::Role::Application::ToClass::Strict; |
23
|
|
|
|
|
|
|
use Moose; |
24
|
|
|
|
|
|
|
extends 'Moose::Meta::Role::Application::ToClass'; |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
sub apply_methods { |
27
|
|
|
|
|
|
|
my ( $self, $role, $class ) = @_; |
28
|
|
|
|
|
|
|
my @implicitly_overridden; |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
foreach my $method_name ( $role->get_method_list ) { |
31
|
|
|
|
|
|
|
next if 'meta' eq $method_name; # Moose auto-exports this |
32
|
|
|
|
|
|
|
unless ( $self->is_method_excluded($method_name) ) { |
33
|
|
|
|
|
|
|
# it if it has one already |
34
|
|
|
|
|
|
|
if ( |
35
|
|
|
|
|
|
|
$class->has_method($method_name) && |
36
|
|
|
|
|
|
|
# and if they are not the same thing ... |
37
|
|
|
|
|
|
|
$class->get_method($method_name)->body != $role->get_method($method_name)->body |
38
|
|
|
|
|
|
|
) |
39
|
|
|
|
|
|
|
{ |
40
|
|
|
|
|
|
|
push @implicitly_overridden => $method_name; |
41
|
|
|
|
|
|
|
next; |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
else { |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
# add it, although it could be overridden |
46
|
|
|
|
|
|
|
$class->add_method( $method_name, |
47
|
|
|
|
|
|
|
$role->get_method($method_name) ); |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
if ( $self->is_method_aliased($method_name) ) { |
52
|
|
|
|
|
|
|
my $aliased_method_name = $self->get_method_aliases->{$method_name}; |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
# it if it has one already |
55
|
|
|
|
|
|
|
if ( |
56
|
|
|
|
|
|
|
$class->has_method($aliased_method_name) && |
57
|
|
|
|
|
|
|
# and if they are not the same thing ... |
58
|
|
|
|
|
|
|
$class->get_method($aliased_method_name)->body != $role->get_method($method_name)->body |
59
|
|
|
|
|
|
|
) |
60
|
|
|
|
|
|
|
{ |
61
|
|
|
|
|
|
|
$class->throw_error("Cannot create a method alias if a local method of the same name exists"); |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
$class->add_method( $aliased_method_name, |
64
|
|
|
|
|
|
|
$role->get_method($method_name) ); |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
if (@implicitly_overridden) { |
69
|
|
|
|
|
|
|
my $s = @implicitly_overridden > 1 ? "s" : ""; |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
my $class_name = $class->name; |
72
|
|
|
|
|
|
|
my $role_name = $role->name; |
73
|
|
|
|
|
|
|
my $methods = join ', ' => @implicitly_overridden; |
74
|
|
|
|
|
|
|
# we use \n because we have no hope of guessing the right stack frame, |
75
|
|
|
|
|
|
|
# it's almost certainly never going to be the one above us |
76
|
|
|
|
|
|
|
$class->throw_error(<<" END_ERROR"); |
77
|
|
|
|
|
|
|
The class $class_name has implicitly overridden the method$s ($methods) from |
78
|
|
|
|
|
|
|
role $role_name. If this is intentional, please exclude the method$s from |
79
|
|
|
|
|
|
|
composition to silence this warning (see Moose::Cookbook::Roles::Recipe2) |
80
|
|
|
|
|
|
|
END_ERROR |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
# we must reset the cache here since |
85
|
|
|
|
|
|
|
# we are just aliasing methods, otherwise |
86
|
|
|
|
|
|
|
# the modifiers go wonky. |
87
|
|
|
|
|
|
|
$class->reset_package_cache_flag; |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
1; |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
__END__ |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
=head1 NAME |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
MooseX::Role::Strict - use strict 'roles' |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
=head1 VERSION |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
Version 0.05 |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
=head1 SYNOPSIS |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
This code will fail at composition time: |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
{ |
107
|
|
|
|
|
|
|
package My::Role; |
108
|
|
|
|
|
|
|
use MooseX::Role::Strict; |
109
|
|
|
|
|
|
|
sub conflict {} |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
{ |
112
|
|
|
|
|
|
|
package My::Class; |
113
|
|
|
|
|
|
|
use Moose; |
114
|
|
|
|
|
|
|
with 'My::Role'; |
115
|
|
|
|
|
|
|
sub conflict {} |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
With an error message similar to the following: |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
The class My::Class has implicitly overridden the method (conflict) from |
121
|
|
|
|
|
|
|
role My::Role ... |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
To resolve this, explictly exclude the 'conflict' method: |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
{ |
126
|
|
|
|
|
|
|
package My::Class; |
127
|
|
|
|
|
|
|
use Moose; |
128
|
|
|
|
|
|
|
with 'My::Role' => { -excludes => 'conflict' }; |
129
|
|
|
|
|
|
|
sub conflict {} |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
=head1 DESCRIPTION |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
B<WARNING>: this is ALPHA code. More features to be added later. |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
When using L<Moose::Role>, a class which provides a method a role provides |
137
|
|
|
|
|
|
|
will silently override that method. This can cause strange, hard-to-debug |
138
|
|
|
|
|
|
|
errors when the role's methods are not called. Simple use |
139
|
|
|
|
|
|
|
C<MooseX::Role::Strict> instead of C<Moose::Role> and overriding a role's |
140
|
|
|
|
|
|
|
method becomes a composition-time failure. See the synopsis for a resolution. |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
=head1 AUTHOR |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
Curtis "Ovid" Poe, C<< <ovid at cpan.org> >> |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
=head1 BUGS |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
Please report any bugs or feature requests to C<bug-moosex-role-strict at rt.cpan.org>, |
149
|
|
|
|
|
|
|
or through the web interface at |
150
|
|
|
|
|
|
|
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=MooseX-Role-Strict>. I will |
151
|
|
|
|
|
|
|
be notified, and then you'll automatically be notified of progress on your bug |
152
|
|
|
|
|
|
|
as I make changes. |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
=head1 SUPPORT |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
perldoc MooseX::Role::Strict |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
You can also look for information at: |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
=over 4 |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=MooseX-Role-Strict> |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
L<http://annocpan.org/dist/MooseX-Role-Strict> |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
=item * CPAN Ratings |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
L<http://cpanratings.perl.org/d/MooseX-Role-Strict> |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
=item * Search CPAN |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
L<http://search.cpan.org/dist/MooseX-Role-Strict/> |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
=back |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
=head1 TODO |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
Add C<-includes> to make things easier: |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
with 'Some::Role' => { -includes => 'bar' }; |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
That reverses the sense of '-excludes' in case you're more interested in the |
191
|
|
|
|
|
|
|
interface than the implementation. I'm unsure of the syntax for |
192
|
|
|
|
|
|
|
auto-converting a role to a pure interface. |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
Copyright 2009 Curtis "Ovid" Poe, all rights reserved. |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
199
|
|
|
|
|
|
|
under the same terms as Perl itself. |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
=cut |