customize constructor sugar name with array spec

wchristian · Jul 26, 2015 · 2a86b3f · 2a86b3f
1 parent 63ef277
commit 2a86b3f
Show file tree

Hide file tree

Showing 9 changed files with 32 additions and 17 deletions.
diff --git a/lib/Constructor/Sugar.pm b/lib/Constructor/Sugar.pm
@@ -3,7 +3,7 @@ package Constructor::Sugar;
 use strictures 2;
 
 use String::CamelCase 'decamelize';
-use Throwable::SugarFactory::_Utils '_getglob';
+use Throwable::SugarFactory::_Utils qw'_array _getglob';
 
 # VERSION
 
@@ -26,6 +26,7 @@ use Throwable::SugarFactory::_Utils '_getglob';
     {
         package ConstructorWrapper;
         use Constructor::Sugar 'My::Moo::Object';
+        use Constructor::Sugar [ 'My::Custom', "make" ];
         
         my $o = object plus => "some", more => "data";
         die if !$o->isa( Object );
@@ -46,16 +47,18 @@ sub _export {
 
 sub import {
     my ( undef, @specs ) = @_;
+    @specs = map { _array $_ } @specs;
     my $target = caller;
     my ( @constructors, @iders );
 
     for my $spec ( @specs ) {
-        my ( $class, $method ) = split /->/, $spec;
-        $method ||= "new";
+        my ( $call, $ct ) = @{$spec};
+        my ( $class, $ctmeth ) = split /->/, $call;
+        $ctmeth ||= "new";
         my $id = ( reverse split /::/, $class )[0];
-        my $ct = decamelize $id;
+        $ct ||= decamelize $id;
 
-        push @constructors, _export $target, $ct, sub { $class->$method( @_ ) };
+        push @constructors, _export $target, $ct, sub { $class->$ctmeth( @_ ) };
         push @iders,        _export $target, $id, sub { $class };
     }
 

diff --git a/lib/Constructor/SugarLibrary.pm b/lib/Constructor/SugarLibrary.pm
@@ -3,7 +3,7 @@ package Constructor::SugarLibrary;
 use strictures 2;
 use Import::Into;
 use Constructor::Sugar ();
-use Throwable::SugarFactory::_Utils '_getglob';
+use Throwable::SugarFactory::_Utils qw'_array _getglob';
 
 # VERSION
 
@@ -19,6 +19,7 @@ use Throwable::SugarFactory::_Utils '_getglob';
     
     sweeten "My::Moo::Object";
     sweeten "My::Moose::Thing";
+    sweeten [ "My::Custom", "make" ];
 
 And now these do the same:
 
@@ -53,8 +54,9 @@ sub import {
     base->import::into( 1, "Exporter" );
     my $library      = caller;
     my $sweeten_func = sub {
-        for my $spec ( @_ ) {
-            my ( $class ) = split /->/, $spec;
+        for ( @_ ) {
+            my $spec = _array $_;
+            my ( $class ) = split /->/, $spec->[0];
             my ( $id ) = ( reverse split /::/, $class )[0];
             my ( $ctors, $ids ) =
               Constructor::Sugar->import::into( $library, $spec );

diff --git a/lib/MooX/SugarFactory.pm b/lib/MooX/SugarFactory.pm
@@ -4,7 +4,7 @@ use strictures 2;
 use Import::Into;
 use MooX::BuildClass;
 use Constructor::SugarLibrary ();
-use Throwable::SugarFactory::_Utils '_getglob';
+use Throwable::SugarFactory::_Utils qw'_array _getglob';
 
 # VERSION
 
@@ -27,6 +27,8 @@ use Throwable::SugarFactory::_Utils '_getglob';
         has     => [ meta     => ( is => 'ro' ) ],
         extends => Object(),
     );
+    
+    class [ "My::Custom", "make" ];
 
     package My::Code;
     use My::SugarLib;
@@ -53,7 +55,8 @@ sub import {
     my $factory = caller;
     *{ _getglob $factory, "class" } = sub {
         my ( $spec, @args ) = @_;
-        my ( $class ) = split /->/, $spec;
+        $spec = _array $spec;
+        my ( $class ) = split /->/, $spec->[0];
         my $build = $factory->can( "BUILDARGS" ) || sub { shift; @_ };
         BuildClass $class, $build->( $class, @args );
         $factory->sweeten_meth( $spec );

diff --git a/lib/Throwable/SugarFactory.pm b/lib/Throwable/SugarFactory.pm
@@ -3,7 +3,7 @@ package Throwable::SugarFactory;
 use strictures 2;
 use Import::Into;
 use MooX::SugarFactory ();
-use Throwable::SugarFactory::_Utils '_getglob';
+use Throwable::SugarFactory::_Utils qw'_array _getglob';
 
 # VERSION
 
@@ -19,6 +19,7 @@ use Throwable::SugarFactory::_Utils '_getglob';
     exception PlainError => "a generic error without metadata";
     exception DataError  => "data description" =>
       has => [ flub => ( is => 'ro' ) ];
+    exception [ Custom => "make" ] => "has a custom constructor";
 
     package My::Code;
     use My::SugarLib;
@@ -62,11 +63,11 @@ sub import {
     MooX::SugarFactory->import::into( 1 );
     my $factory = caller;
     *{ _getglob $factory, "exception" } = sub {
-        my ( $id, $description, @args ) = @_;
-        my $class = "${factory}::$id";
-        $factory->can( "class" )->(
-            "$class->throw", _base_args( $factory, $id, $description ), @args
-        );
+        my ( $spec, $description, @args ) = @_;
+        $spec = _array $spec;
+        my @defaults = _base_args( $factory, $spec->[0], $description );
+        $spec->[0] = "${factory}::$spec->[0]->throw";
+        $factory->can( "class" )->( $spec, @defaults, @args );
     };
 }
 

diff --git a/lib/Throwable/SugarFactory/_Utils.pm b/lib/Throwable/SugarFactory/_Utils.pm
@@ -2,7 +2,9 @@ package Throwable::SugarFactory::_Utils;
 
 use parent 'Exporter';
 
-our @EXPORT_OK = qw( _getglob );
+our @EXPORT_OK = qw( _array _getglob );
+
+sub _array { ref $_[0] eq "ARRAY" ? $_[0] : [ $_[0] ] }
 
 sub _getglob { no strict 'refs'; \*{join '::', @_} }
 

diff --git a/t/01_constructor_sugar.t b/t/01_constructor_sugar.t
@@ -39,6 +39,7 @@ use Test::More;
 
     package Test3;
     use Test::More;
+    use Constructor::Sugar [ "My::Moo::Object->cons", "make" ];
 
     ok my $obj = make plus => "some", more => "data";
     ok $obj->isa( Object );

diff --git a/t/02_constructor_sugarlibrary.t b/t/02_constructor_sugarlibrary.t
@@ -26,6 +26,7 @@ BEGIN {
     use Constructor::SugarLibrary;
     sweeten "My::Moo::Object";
     sweeten "My::Moo::Object2->cons";
+    sweeten [ "My::Custom", "make" ];
     ok exception { sweeten "My::Moose::Object" };
     $INC{"Sugar/Library.pm"}++;
 }

diff --git a/t/05_moox_sugarfactory.t b/t/05_moox_sugarfactory.t
@@ -19,6 +19,7 @@ BEGIN {
         has     => [ meta     => ( is => 'ro' ) ],
         install => [ cons     => sub  { My::Moo::CustomCons->new } ],
     );
+    class [ "My::Custom", "make" ];
     $INC{"My/SugarFactory.pm"}++;
 }
 

diff --git a/t/06_throwable_sugarfactory.t b/t/06_throwable_sugarfactory.t
@@ -16,6 +16,7 @@ BEGIN {
     exception PLAIN_ERROR => "plain description";
     exception DATA_ERROR  => "data description" =>
       ( has => [ flub => ( is => 'ro' ) ] );
+    exception [ Custom => "make" ] => "has custom constructor sugar";
 
     $INC{"TestExLib.pm"} = 1;
 }