initial import

diff --git a/Build.PL b/Build.PL
new file mode 100644 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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<< <autarch@urth.org> >>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-moosex-strictconstructor@rt.cpan.org>,
+or through the web interface at L<http://rt.cpan.org>.  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 (file)
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 (file)
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 (file)
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 (file)
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();