From: Dave Rolsky Date: Thu, 15 Nov 2007 05:35:54 +0000 (+0000) Subject: initial import X-Git-Tag: 0.01~3 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=32726d885ed56a2628ec0eccf18b2e898d1ca8ca;p=gitmo%2FMooseX-StrictConstructor.git initial import --- 32726d885ed56a2628ec0eccf18b2e898d1ca8ca diff --git a/Build.PL b/Build.PL new file mode 100644 index 0000000..b80eaa7 --- /dev/null +++ b/Build.PL @@ -0,0 +1,16 @@ +use strict; +use warnings; + +use Module::Build; + +my $builder = Module::Build->new + ( module_name => 'MooseX::StrictConstructor', + license => 'perl', + requires => { 'Test::More' => 0, + }, + create_makefile_pl => 'passthrough', + create_readme => 1, + sign => 1, + ); + +$builder->create_build_script(); diff --git a/Changes b/Changes new file mode 100644 index 0000000..cd710fd --- /dev/null +++ b/Changes @@ -0,0 +1,3 @@ +0.01 Date/time + +* First version, released on an unsuspecting world. diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..8b234c4 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,10 @@ +Build.PL +Changes +MANIFEST +MANIFEST.SKIP +META.yml # Will be created by "make dist" +README # Will be created by "make dist" +lib/MooseX/StrictConstructor.pm +t/perlcritic.t +t/pod-coverage.t +t/pod.t diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP new file mode 100644 index 0000000..a834675 --- /dev/null +++ b/MANIFEST.SKIP @@ -0,0 +1,27 @@ +# Avoid version control files. +\bRCS\b +\bCVS\b +,v$ +\B\.svn\b + +# Avoid Makemaker generated and utility files. +\bMakefile$ +\bblib +\bMakeMaker-\d +\bpm_to_blib$ +\bblibdirs$ +^MANIFEST\.SKIP$ + +# Avoid Module::Build generated and utility files. +\bBuild$ +\b_build + +# Avoid temp and backup files. +~$ +\.old$ +\.bak$ +\#$ +\b\.# + +# Avoid tarballs +\.(?:tar|tgz|tar\.gz)$ diff --git a/lib/MooseX/Object/StrictConstructor.pm b/lib/MooseX/Object/StrictConstructor.pm new file mode 100644 index 0000000..394c003 --- /dev/null +++ b/lib/MooseX/Object/StrictConstructor.pm @@ -0,0 +1,30 @@ +package MooseX::Object::StrictConstructor; + +use strict; +use warnings; + +use Moose; + +use Carp 'confess'; + +extends 'Moose::Object'; + +after 'BUILDALL' => sub +{ + my $self = shift; + my $params = shift; + + my %attrs = map { $_->name() => 1 } $self->meta()->compute_all_applicable_attributes(); + + my @bad = grep { ! $attrs{$_} } keys %{ $params }; + + if (@bad) + { + confess "Found unknown attribute(s) passed to the constructor: @bad"; + } + + return; +}; + + +1; diff --git a/lib/MooseX/StrictConstructor.pm b/lib/MooseX/StrictConstructor.pm new file mode 100644 index 0000000..3be669a --- /dev/null +++ b/lib/MooseX/StrictConstructor.pm @@ -0,0 +1,71 @@ +package MooseX::StrictConstructor; + +use strict; +use warnings; + +our $VERSION = '0.01'; + +use Moose; +use MooseX::Object::StrictConstructor; + + +sub import +{ + my $caller = caller(); + + return if $caller eq 'main'; + + Moose::init_meta( $caller, 'MooseX::Object::StrictConstructor', 'Moose::Meta::Class' ); + + Moose->import( { into => $caller } ); + + return; +} + + + +1; + +__END__ + +=pod + +=head1 NAME + +MooseX::StrictConstructor - The fantastic new MooseX::StrictConstructor! + +=head1 SYNOPSIS + +XXX - change this! + + use MooseX::StrictConstructor; + + my $foo = MooseX::StrictConstructor->new(); + + ... + +=head1 DESCRIPTION + +=head1 METHODS + +This class provides the following methods + +=head1 AUTHOR + +Dave Rolsky, C<< >> + +=head1 BUGS + +Please report any bugs or feature requests to C, +or through the web interface at L. I will be +notified, and then you'll automatically be notified of progress on +your bug as I make changes. + +=head1 COPYRIGHT & LICENSE + +Copyright 2007 Dave Rolsky, All Rights Reserved. + +This program is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/t/basic.t b/t/basic.t new file mode 100644 index 0000000..d91d3c9 --- /dev/null +++ b/t/basic.t @@ -0,0 +1,50 @@ +use strict; +use warnings; + +use Test::More tests => 4; + + +{ + package Standard; + + use Moose; + + has 'thing' => ( is => 'rw' ); +} + +{ + package Stricter; + + use MooseX::StrictConstructor; + + has 'thing' => ( is => 'rw' ); +} + +{ + package Tricky; + + use MooseX::StrictConstructor; + + has 'thing' => ( is => 'rw' ); + + sub BUILD + { + my $self = shift; + my $params = shift; + + delete $params->{spy}; + } +} + + +eval { Standard->new( thing => 1, bad => 99 ) }; +is( $@, '', 'standard Moose class ignores unknown params' ); + +eval { Stricter->new( thing => 1, bad => 99 ) }; +like( $@, qr/unknown attribute.+: bad/, 'strict constructor blows up on unknown params' ); + +eval { Tricky->new( thing => 1, spy => 99 ) }; +is( $@, '', 'can work around strict constructor by deleting params in BUILD()' ); + +eval { Tricky->new( thing => 1, agent => 99 ) }; +like( $@, qr/unknown attribute.+: agent/, 'Tricky still blows up on unknown params other than spy' ); diff --git a/t/perlcritic.t b/t/perlcritic.t new file mode 100644 index 0000000..491250c --- /dev/null +++ b/t/perlcritic.t @@ -0,0 +1,13 @@ +use strict; +use warnings; + +use Test::More; + + +plan skip_all => 'This test is only run for the module author' + unless -d '.svn' || $ENV{IS_MAINTAINER}; + +eval 'use Test::Perl::Critic ( -severity => 4 )'; +plan skip_all => 'Test::Perl::Critic required for testing POD' if $@; + +all_critic_ok(); diff --git a/t/pod-coverage.t b/t/pod-coverage.t new file mode 100644 index 0000000..aa1f35b --- /dev/null +++ b/t/pod-coverage.t @@ -0,0 +1,14 @@ +use strict; +use warnings; + +use Test::More; + + +plan skip_all => 'This test is only run for the module author' + unless -d '.svn' || $ENV{IS_MAINTAINER}; + +eval "use Test::Pod::Coverage 1.04"; +plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" + if $@; + +all_pod_coverage_ok(); diff --git a/t/pod.t b/t/pod.t new file mode 100644 index 0000000..3f86494 --- /dev/null +++ b/t/pod.t @@ -0,0 +1,13 @@ +use strict; +use warnings; + +use Test::More; + + +plan skip_all => 'This test is only run for the module author' + unless -d '.svn' || $ENV{IS_MAINTAINER}; + +eval "use Test::Pod 1.14"; +plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; + +all_pod_files_ok();