1package MooseX::StrictConstructor::Trait::Class; 2 3use strict; 4use warnings; 5use namespace::autoclean; 6 7our $VERSION = '0.21'; 8 9use Moose::Role; 10 11use B (); 12 13around new_object => sub { 14 my $orig = shift; 15 my $self = shift; 16 my $params = @_ == 1 ? $_[0] : {@_}; 17 my $instance = $self->$orig(@_); 18 19 my %attrs = ( 20 __INSTANCE__ => 1, 21 __no_BUILD__ => 1, 22 ( 23 map { $_ => 1 } 24 grep {defined} 25 map { $_->init_arg() } $self->get_all_attributes() 26 ), 27 ); 28 29 my @bad = sort grep { !$attrs{$_} } keys %$params; 30 31 if (@bad) { 32 $self->throw_error( 33 "Found unknown attribute(s) init_arg passed to the constructor: @bad" 34 ); 35 } 36 37 return $instance; 38}; 39 40around _inline_BUILDALL => sub { 41 my $orig = shift; 42 my $self = shift; 43 44 my @source = $self->$orig(); 45 46 my @attrs = ( 47 '__INSTANCE__ => 1,', 48 '__no_BUILD__ => 1,', 49 ( 50 map { B::perlstring($_) . ' => 1,' } 51 grep {defined} 52 map { $_->init_arg() } $self->get_all_attributes() 53 ), 54 ); 55 56 return ( 57 @source, 58 'my @bad = sort grep { !$allowed_attrs{$_} } keys %{ $params };', 59 'if (@bad) {', 60 'Moose->throw_error("Found unknown attribute(s) passed to the constructor: @bad");', 61 '}', 62 ); 63 } 64 if $Moose::VERSION >= 1.9900; 65 66around _eval_environment => sub { 67 my $orig = shift; 68 my $self = shift; 69 70 my $env = $self->$orig(); 71 72 my %attrs = map { $_ => 1 } 73 grep {defined} 74 map { $_->init_arg() } $self->get_all_attributes(); 75 76 $attrs{__INSTANCE__} = 1; 77 $attrs{__no_BUILD__} = 1; 78 79 $env->{'%allowed_attrs'} = \%attrs; 80 81 return $env; 82 } 83 if $Moose::VERSION >= 1.9900; 84 851; 86 87# ABSTRACT: A role to make immutable constructors strict 88 89__END__ 90 91=pod 92 93=encoding UTF-8 94 95=head1 NAME 96 97MooseX::StrictConstructor::Trait::Class - A role to make immutable constructors strict 98 99=head1 VERSION 100 101version 0.21 102 103=head1 DESCRIPTION 104 105This role simply wraps C<_inline_BUILDALL()> (from 106C<Moose::Meta::Class>) so that immutable classes have a 107strict constructor. 108 109=head1 SUPPORT 110 111Bugs may be submitted at L<https://github.com/moose/MooseX-StrictConstructor/issues>. 112 113I am also usually active on IRC as 'autarch' on C<irc://irc.perl.org>. 114 115=head1 SOURCE 116 117The source code repository for MooseX-StrictConstructor can be found at L<https://github.com/moose/MooseX-StrictConstructor>. 118 119=head1 AUTHOR 120 121Dave Rolsky <autarch@urth.org> 122 123=head1 COPYRIGHT AND LICENSE 124 125This software is Copyright (c) 2007 - 2017 by Dave Rolsky. 126 127This is free software, licensed under: 128 129 The Artistic License 2.0 (GPL Compatible) 130 131The full text of the license can be found in the 132F<LICENSE> file included with this distribution. 133 134=cut 135