File Coverage

blib/lib/MooX/SugarFactory.pm

Criterion	Covered	Total	%
statement	35	35	100.0
branch			n/a
condition	1	2	50.0
subroutine	10	10	100.0
pod			n/a
total	46	47	97.8

package MooX::SugarFactory;

use strictures 2;
use Import::Into;
use MooX::BuildClass;
use MooX::BuildRole;
use Constructor::SugarLibrary ();
use Throwable::SugarFactory::Utils '_getglob';

our $VERSION = '0.213360'; # VERSION

# ABSTRACT: build a library of syntax-sugared Moo classes

#
# This file is part of Throwable-SugarFactory
#
#
# Christian Walde has dedicated the work to the Commons by waiving all of his
# or her rights to the work worldwide under copyright law and all related or
# neighboring legal rights he or she had in the work, to the extent allowable by
# law.
#
# Works under CC0 do not require attribution. When citing the work, you should
# not imply endorsement by the author.
#


sub import {
    my ( $class ) = @_;
    Constructor::SugarLibrary->import::into( scalar caller );    # I::I 1.001000
    my $factory = caller;
    *{ _getglob $factory, $_ } = $class->_creator_with( $factory, $_ )
      for qw( class role );
}

sub _creator_with {
    my ( $class, $factory, $type ) = @_;

    # put MooX::Build's Build<> into sub ::
    # haarg says this working is a perl bug that ignores strict 'refs'
    my $create = \&{ "Build" . ucfirst $type };
    sub {
        my ( $spec, @args ) = @_;
        my ( $class ) = split /->/, $spec;

        # BUILDARGS can be defined in the factory and munges all class/role's
        # args, unsure what to do about this yet, need to ask haarg
        my $build = $factory->can( "BUILDARGS" ) || sub { shift; @_ };
        $create->( $class, $build->( $class, @args ) );
        $factory->sweeten_meth( $spec );
        return;
    };
}

1;

__END__