diff --git a/lib/Constructor/Sugar.pm b/lib/Constructor/Sugar.pm index cad452c..a002aa0 100644 --- 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 index 7840730..27a5290 100644 --- 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 index 7e795e9..3ebf603 100644 --- 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 index 5454f4a..5daa2f1 100644 --- 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 index b163bab..f0d2cbc 100644 --- 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 index af91e0f..a33248b 100644 --- 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 index 217a08a..e7391f7 100644 --- 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 index 5f10cc5..2f79ffa 100644 --- 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 index 3101c28..df6c3d2 100644 --- 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; }