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

use strict;                     # redundant, but quiets perlcritic
package MooX::StrictConstructor;
$MooX::StrictConstructor::VERSION = '0.008';
# ABSTRACT: Make your Moo-based object constructors blow up on unknown attributes.


use Moo 1.001000 ();    # $Moo::MAKERS support
use Moo::Role ();

use Class::Method::Modifiers qw(install_modifier);

use strictures 1;

use constant
    CON_ROLE => 'Method::Generate::Constructor::Role::StrictConstructor';

#
# The gist of this code was copied directly from Graham Knop (HAARG)'s
# MooX::InsideOut, specifically its import sub.  It has diverged a bit to
# handle goal specific differences.
#
sub import {
    my $class  = shift;
    my $target = caller;
    unless ( $Moo::MAKERS{$target} && $Moo::MAKERS{$target}{is_class} ) {
        die "MooX::StrictConstructor can only be used on Moo classes.";
    }

    _apply_role($target);

    install_modifier($target, 'after', 'extends', sub {
        _apply_role($target);
    });
}

sub _apply_role {
    my $target = shift;
    my $con = Moo->_constructor_maker_for($target);
    Moo::Role->apply_roles_to_object($con, CON_ROLE)
        unless Role::Tiny::does_role($con, CON_ROLE);
}


1;

__END__