File Coverage

blib/lib/MooX/StrictConstructor.pm
Criterion Covered Total %
statement 27 28 96.4
branch 3 4 75.0
condition 1 3 33.3
subroutine 9 9 100.0
pod n/a
total 40 44 90.9


line stmt bran cond sub pod time code
1 1     1   72459 use strict; # redundant, but quiets perlcritic
  1         5  
  1         40  
2             package MooX::StrictConstructor;
3             $MooX::StrictConstructor::VERSION = '0.010';
4             # ABSTRACT: Make your Moo-based object constructors blow up on unknown attributes.
5              
6              
7 1     1   4 use Moo 1.001000 (); # $Moo::MAKERS support
  1         30  
  1         15  
8 1     1   500 use Moo::Role ();
  1         7413  
  1         21  
9              
10 1     1   399 use Class::Method::Modifiers qw(install_modifier);
  1         1265  
  1         71  
11              
12 1     1   385 use strictures 1;
  1         1347  
  1         31  
13              
14             use constant
15 1     1   86 CON_ROLE => 'Method::Generate::Constructor::Role::StrictConstructor';
  1         2  
  1         178  
16              
17             #
18             # The gist of this code was copied directly from Graham Knop (HAARG)'s
19             # MooX::InsideOut, specifically its import sub. It has diverged a bit to
20             # handle goal specific differences.
21             #
22             sub import {
23 6     6   2927 my $class = shift;
24 6         11 my $target = caller;
25 6 50 33     47 unless ( $Moo::MAKERS{$target} && $Moo::MAKERS{$target}{is_class} ) {
26 0         0 die "MooX::StrictConstructor can only be used on Moo classes.";
27             }
28              
29 6         15 _apply_role($target);
30              
31             install_modifier($target, 'after', 'extends', sub {
32 2     2   5051 _apply_role($target);
33 6         1399 });
34             }
35              
36             sub _apply_role {
37 8     8   11 my $target = shift;
38 8         25 my $con = Moo->_constructor_maker_for($target);
39 8 100       19891 Moo::Role->apply_roles_to_object($con, CON_ROLE)
40             unless Role::Tiny::does_role($con, CON_ROLE);
41             }
42              
43              
44             1;
45              
46             __END__