From: Jesse Luehrs Date: Thu, 10 Feb 2011 22:51:11 +0000 (-0600) Subject: make this work with old and new moose X-Git-Tag: v0.13~8 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMooseX-StrictConstructor.git;a=commitdiff_plain;h=c8a39fc4c1fd5da3a1262cee50e9fe65dc30d221;hp=b5016cad6dca424b409328322cccada040ecf45a make this work with old and new moose --- diff --git a/dist.ini b/dist.ini index 2fc3613..57e8669 100644 --- a/dist.ini +++ b/dist.ini @@ -31,7 +31,7 @@ repository.type = git [CheckChangeLog] [Prereqs] -Moose = 1.9900 +Moose = 0.94 [Prereqs / TestRequires] Test::Fatal = 0 diff --git a/lib/MooseX/StrictConstructor.pm b/lib/MooseX/StrictConstructor.pm index 2f2367a..e024686 100644 --- a/lib/MooseX/StrictConstructor.pm +++ b/lib/MooseX/StrictConstructor.pm @@ -8,11 +8,13 @@ use Moose::Exporter; use Moose::Util::MetaRole; use MooseX::StrictConstructor::Role::Object; use MooseX::StrictConstructor::Role::Meta::Class; +use MooseX::StrictConstructor::Role::Meta::Method::Constructor; Moose::Exporter->setup_import_methods( class_metaroles => { - class => - ['MooseX::StrictConstructor::Role::Meta::Class'] + ($Moose::VERSION >= 1.9900 + ? (class => ['MooseX::StrictConstructor::Role::Meta::Class']) + : (constructor => ['MooseX::StrictConstructor::Role::Meta::Method::Constructor'])), }, base_class_roles => ['MooseX::StrictConstructor::Role::Object'], ); diff --git a/lib/MooseX/StrictConstructor/Role/Meta/Method/Constructor.pm b/lib/MooseX/StrictConstructor/Role/Meta/Method/Constructor.pm new file mode 100644 index 0000000..43b2aa2 --- /dev/null +++ b/lib/MooseX/StrictConstructor/Role/Meta/Method/Constructor.pm @@ -0,0 +1,65 @@ +package MooseX::StrictConstructor::Role::Meta::Method::Constructor; + +use strict; +use warnings; + +use B (); +use Carp (); + +use Moose::Role; + +around '_generate_BUILDALL' => sub { + my $orig = shift; + my $self = shift; + + my $source = $self->$orig(); + $source .= ";\n" if $source; + + my @attrs = ( + '__INSTANCE__ => 1,', + map { B::perlstring($_) . ' => 1,' } + grep {defined} + map { $_->init_arg() } @{ $self->_attributes() } + ); + + $source .= <<"EOF"; +my \%attrs = (@attrs); + +my \@bad = sort grep { ! \$attrs{\$_} } keys \%{ \$params }; + +if (\@bad) { + Carp::confess "Found unknown attribute(s) passed to the constructor: \@bad"; +} +EOF + + return $source; +}; + +no Moose::Role; + +1; + +# ABSTRACT: A role to make immutable constructors strict + +__END__ + +=pod + +=head1 SYNOPSIS + + Moose::Util::MetaRole::apply_metaroles( + for_class => $caller, + class => { + constructor => + ['MooseX::StrictConstructor::Role::Meta::Method::Constructor'], + }, + ); + +=head1 DESCRIPTION + +This role simply wraps C<_generate_BUILDALL()> (from +C) so that immutable classes have a +strict constructor. + +=cut +