File Coverage

blib/lib/MooseX/Role/Strict.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


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