initial import of MooseX-SlurpyConstructor 0.01 from CPAN

git-cpan-module:   MooseX-SlurpyConstructor
git-cpan-version:  0.01
git-cpan-authorid: MMORGAN
git-cpan-file:     authors/id/M/MM/MMORGAN/MooseX-SlurpyConstructor-0.01.tgz

Build.PL

@@ -0,0 +1,19 @@
+use strict;
+use warnings;
+
+require 5.008;
+
+use Module::Build;
+
+my $builder = Module::Build->new(
+    module_name         => 'MooseX::SlurpyConstructor',
+    license             => 'perl',
+    requires            => {
+        'Moose'             => '0.74',
+        'Test::More'        => '0',
+    },
+    create_makefile_pl  => 'passthrough',
+    create_readme       => 1,
+);
+
+$builder->create_build_script;

Changes

@@ -0,0 +1,3 @@
+0.01        2009-07-06
+
+- Initial version.

MANIFEST

@@ -0,0 +1,12 @@
+Build.PL
+Changes
+lib/MooseX/SlurpyConstructor/Role/Attribute.pm
+lib/MooseX/SlurpyConstructor/Role/Object.pm
+lib/MooseX/SlurpyConstructor.pm
+Makefile
+Makefile.PL
+MANIFEST
+t/01_usage.t
+t/02_usage_from_main.t
+t/03_normal_usage.t
+t/04_bad_usage.t

Makefile

@@ -0,0 +1,79 @@
+#     PREREQ_PM => { Test::More=>q[0], Moose=>q[0.74] }
+
+all : force_do_it
+	/usr/bin/perl.exe Build --makefile_env_macros 1
+realclean : force_do_it
+	/usr/bin/perl.exe Build --makefile_env_macros 1 realclean
+	/usr/bin/perl.exe -e unlink -e shift Makefile
+
+force_do_it :
+	@ true
+build : force_do_it
+	/usr/bin/perl.exe Build --makefile_env_macros 1 build
+clean : force_do_it
+	/usr/bin/perl.exe Build --makefile_env_macros 1 clean
+code : force_do_it
+	/usr/bin/perl.exe Build --makefile_env_macros 1 code
+config_data : force_do_it
+	/usr/bin/perl.exe Build --makefile_env_macros 1 config_data
+diff : force_do_it
+	/usr/bin/perl.exe Build --makefile_env_macros 1 diff
+dist : force_do_it
+	/usr/bin/perl.exe Build --makefile_env_macros 1 dist
+distcheck : force_do_it
+	/usr/bin/perl.exe Build --makefile_env_macros 1 distcheck
+distclean : force_do_it
+	/usr/bin/perl.exe Build --makefile_env_macros 1 distclean
+distdir : force_do_it
+	/usr/bin/perl.exe Build --makefile_env_macros 1 distdir
+distmeta : force_do_it
+	/usr/bin/perl.exe Build --makefile_env_macros 1 distmeta
+distsign : force_do_it
+	/usr/bin/perl.exe Build --makefile_env_macros 1 distsign
+disttest : force_do_it
+	/usr/bin/perl.exe Build --makefile_env_macros 1 disttest
+docs : force_do_it
+	/usr/bin/perl.exe Build --makefile_env_macros 1 docs
+fakeinstall : force_do_it
+	/usr/bin/perl.exe Build --makefile_env_macros 1 fakeinstall
+help : force_do_it
+	/usr/bin/perl.exe Build --makefile_env_macros 1 help
+html : force_do_it
+	/usr/bin/perl.exe Build --makefile_env_macros 1 html
+install : force_do_it
+	/usr/bin/perl.exe Build --makefile_env_macros 1 install
+manifest : force_do_it
+	/usr/bin/perl.exe Build --makefile_env_macros 1 manifest
+manpages : force_do_it
+	/usr/bin/perl.exe Build --makefile_env_macros 1 manpages
+pardist : force_do_it
+	/usr/bin/perl.exe Build --makefile_env_macros 1 pardist
+ppd : force_do_it
+	/usr/bin/perl.exe Build --makefile_env_macros 1 ppd
+ppmdist : force_do_it
+	/usr/bin/perl.exe Build --makefile_env_macros 1 ppmdist
+prereq_report : force_do_it
+	/usr/bin/perl.exe Build --makefile_env_macros 1 prereq_report
+pure_install : force_do_it
+	/usr/bin/perl.exe Build --makefile_env_macros 1 pure_install
+retest : force_do_it
+	/usr/bin/perl.exe Build --makefile_env_macros 1 retest
+skipcheck : force_do_it
+	/usr/bin/perl.exe Build --makefile_env_macros 1 skipcheck
+test : force_do_it
+	/usr/bin/perl.exe Build --makefile_env_macros 1 test
+testall : force_do_it
+	/usr/bin/perl.exe Build --makefile_env_macros 1 testall
+testcover : force_do_it
+	/usr/bin/perl.exe Build --makefile_env_macros 1 testcover
+testdb : force_do_it
+	/usr/bin/perl.exe Build --makefile_env_macros 1 testdb
+testpod : force_do_it
+	/usr/bin/perl.exe Build --makefile_env_macros 1 testpod
+testpodcoverage : force_do_it
+	/usr/bin/perl.exe Build --makefile_env_macros 1 testpodcoverage
+versioninstall : force_do_it
+	/usr/bin/perl.exe Build --makefile_env_macros 1 versioninstall
+
+.EXPORT : INC PREFIX DESTDIR VERBINST INSTALLDIRS TEST_VERBOSE LIB UNINST INSTALL_BASE POLLUTE
+

Makefile.PL

@@ -0,0 +1,32 @@
+# Note: this file was auto-generated by Module::Build::Compat version 0.32
+
+    unless (eval "use Module::Build::Compat 0.02; 1" ) {
+      print "This module requires Module::Build to install itself.\n";
+
+      require ExtUtils::MakeMaker;
+      my $yn = ExtUtils::MakeMaker::prompt
+	('  Install Module::Build now from CPAN?', 'y');
+
+      unless ($yn =~ /^y/i) {
+	die " *** Cannot install without Module::Build.  Exiting ...\n";
+      }
+
+      require Cwd;
+      require File::Spec;
+      require CPAN;
+
+      # Save this 'cause CPAN will chdir all over the place.
+      my $cwd = Cwd::cwd();
+
+      CPAN::Shell->install('Module::Build::Compat');
+      CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate
+	or die "Couldn't install Module::Build, giving up.\n";
+
+      chdir $cwd or die "Cannot chdir() back to $cwd: $!";
+    }
+    eval "use Module::Build::Compat 0.02; 1" or die $@;
+
+    Module::Build::Compat->run_build_pl(args => \@ARGV);
+    exit(0) unless(-e 'Build'); # cpantesters convention
+    require Module::Build;
+    Module::Build::Compat->write_makefile(build_class => 'Module::Build');

lib/MooseX/SlurpyConstructor.pm

@@ -0,0 +1,125 @@
+package MooseX::SlurpyConstructor;
+
+our $VERSION = '0.01';
+
+use Moose;
+use Moose::Exporter;
+use Moose::Util::MetaRole;
+use MooseX::SlurpyConstructor::Role::Object;
+use MooseX::SlurpyConstructor::Role::Attribute;
+
+Moose::Exporter->setup_import_methods;
+
+sub init_meta {
+    my ( undef, %args ) = @_;
+
+    Moose->init_meta( %args );
+
+    my $for_class = $args{ for_class };
+
+    Moose::Util::MetaRole::apply_metaclass_roles(
+        for_class               => $for_class,
+        attribute_metaclass_roles   => [
+            qw( MooseX::SlurpyConstructor::Role::Attribute ),
+        ],
+    );
+
+    Moose::Util::MetaRole::apply_base_class_roles(
+        for_class               => $for_class,
+        roles                   => [
+            qw( MooseX::SlurpyConstructor::Role::Object )
+        ],
+    );
+    return $for_class->meta;
+}
+
+no Moose;
+
+__PACKAGE__->meta->make_immutable;
+
+=pod
+
+=head1 NAME
+
+MooseX::SlurpyConstructor - Assign all unknown attributes to attribute in object constructor.
+
+=head1 SYNOPSIS
+
+    package ASDF;
+
+    use Moose;
+    use MooseX::SlurpyConstructor;
+
+    has fixed => (
+        is      => 'ro',
+    );
+
+    has slurpy => (
+        is      => 'ro',
+        slurpy  => 1,
+    );
+
+    package main;
+
+    ASDF->new({
+        fixed => 100, unknown1 => "a", unknown2 => [ 1..3 ]
+    })->dump;
+
+    # returns:
+    #   $VAR1 = bless( {
+    #       'slurpy' => {
+    #           'unknown2' => [
+    #               1,
+    #               2,
+    #               3
+    #           ],
+    #           'unknown1' => 'a'
+    #       },
+    #       'fixed' => 100
+    #   }, 'ASDF' );
+
+=head1 DESCRIPTION
+
+Including this module within Moose-based classes, and declaring an
+attribute as 'slurpy' will allow capturing of all unknown constructor
+arguments in the given attribute.
+
+When composing a class, an error will be raised if more than one
+attribute of the class is marked as 'slurpy'.  Also, at object
+instatiation time, an error will be raised if the class being
+instantiated uses this one, but does not declare a slurpy attribute.
+
+=head1 SEE ALSO
+
+=over 4
+
+=item MooseX::StrictConstructor
+
+The opposite of this module, making constructors die on unknown attributes.
+Note that if both of these are used together, SlurpyConstructor will take
+precedence and strict constructor explosions will never occour.
+
+=back
+
+=head1 AUTHOR
+
+Mark Morgan C<< <makk384@gmail.com> >>
+
+Thanks to the folks from moose mailing list and IRC channels for
+helping me find my way around some of the Moose bits I didn't
+know of before writing this module.
+
+=head1 BUGS
+
+As usual, send bugs or feature requests to
+C<bug-moosex-slurpyconstructor@rt.cpan.org> or through web interface
+L<http://rt.cpan.org>.
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2009 Mark Morgan, All Rights Reserved.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut

lib/MooseX/SlurpyConstructor/Role/Attribute.pm

@@ -0,0 +1,28 @@
+package MooseX::SlurpyConstructor::Role::Attribute;
+
+use Moose::Role;
+
+has slurpy => (
+    is          => 'ro',
+    isa         => 'Bool',
+    default     => 0,
+);
+
+before attach_to_class => sub {
+    my ( $self, $meta ) = @_;
+
+    return if not $self->slurpy;
+
+    my @slurpy =
+      map { $_->name }
+      grep { $_->slurpy }
+      $meta->get_all_attributes;
+
+    if ( scalar @slurpy ) {
+        die "Can't add multiple slurpy attributes to a class";
+    }
+};
+
+no Moose::Role;
+
+1;

lib/MooseX/SlurpyConstructor/Role/Object.pm

@@ -0,0 +1,48 @@
+package MooseX::SlurpyConstructor::Role::Object;
+
+use Moose::Role;
+
+around BUILDARGS => sub {
+    my ( $orig, $class, @incoming ) = @_;
+
+    my $args;
+    if ( scalar @incoming == 1 and ref $incoming[ 0 ] eq 'HASH' ) {
+        $args = shift @incoming;
+    } else {
+        $args = { @incoming };
+    }
+
+    my @init_args =
+      grep { defined }
+      map { $_->init_arg }
+      $class->meta->get_all_attributes;
+
+    my %slurpy_args = %$args;
+
+    delete @slurpy_args{ @init_args };
+
+    my %init_args = map { $_ => $args->{ $_ } } @init_args;
+
+    my @slurpy_attrs =
+      map { $_->name }
+      grep { $_->slurpy }
+      $class->meta->get_all_attributes;
+
+    my $slurpy_attr = shift @slurpy_attrs;
+    if ( not defined $slurpy_attr ) {
+        die "No parameters marked 'slurpy', do you need this module?";
+    }
+
+    if ( defined $init_args{ $slurpy_attr } ) {
+        die "Can't assign to '$slurpy_attr', as it's marked slurpy";
+    }
+
+    return $class->$orig({
+        %init_args,
+        $slurpy_attr    => \%slurpy_args,
+    });
+};
+
+no Moose::Role;
+
+1;

t/01_usage.t

@@ -0,0 +1,12 @@
+#!/usr/bin/perl
+
+package X;
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+
+use_ok( "MooseX::SlurpyConstructor" );
+
+1;

t/02_usage_from_main.t

@@ -0,0 +1,24 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 2;
+
+my $warning;
+
+{
+    local $SIG{ __WARN__ } = sub { $warning = shift() };
+
+    eval "use MooseX::SlurpyConstructor";
+
+    ok( defined $warning,
+        "warning returned when trying to export into main"
+    );
+    like( $warning,
+        qr/MooseX::SlurpyConstructor does not export .*'main'/,
+        "expected warning when trying to use from 'main' package"
+    );
+}
+
+1;