File Coverage

blib/lib/Constructor/Sugar.pm

Criterion	Covered	Total	%
statement	27	27	100.0
branch	2	2	100.0
condition	2	2	100.0
subroutine	7	7	100.0
pod			n/a
total	38	38	100.0

package Constructor::Sugar;

use strictures 2;

use String::CamelCase 'decamelize';
use Throwable::SugarFactory::Utils '_getglob';

our $VERSION = '0.152700'; # VERSION

# ABSTRACT: export constructor syntax sugar

#
# 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 _export {
    my ( $pkg, $func, $code ) = @_;
    *{ _getglob $pkg, $func } = $code;
    return $func;
}

sub import {
    my ( undef, @specs ) = @_;
    my $target = caller;
    my ( @constructors, @iders );

    for my $spec ( @specs ) {
        my ( $class, $method ) = split /->/, $spec;
        $method ||= "new";
        my $id = ( reverse split /::/, $class )[0];
        my $ct = decamelize $id;
        die "Converting '$id' into a snake_case constructor did not result in"
          . " a different string."
          if $ct eq $id;

        push @constructors, _export $target, $ct, sub { $class->$method( @_ ) };
        push @iders,        _export $target, $id, sub { $class };
    }

    return ( \@constructors, \@iders );
}

1;

__END__