File Coverage

blib/lib/Constructor/SugarLibrary.pm

Criterion	Covered	Total	%
statement	49	49	100.0
branch			n/a
condition			n/a
subroutine	10	10	100.0
pod			n/a
total	59	59	100.0

package Constructor::SugarLibrary;

use strictures 2;
use Import::Into;
use Constructor::Sugar ();
use Throwable::SugarFactory::Utils '_getglob';

our $VERSION = '0.152700'; # VERSION

# ABSTRACT: build a library of generic 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.
#


{
    ## no critic (ProhibitNoStrict)
    no strict 'refs';
    sub _getexport      { \@{"$_[0]::EXPORT"} }
    sub _getexport_tags { \%{"$_[0]::EXPORT_TAGS"} }
    ## use critic
}

sub import {
    base->import::into( scalar caller, "Exporter" );    # I::I 1.001000 syntax
    my $library      = caller;
    my $sweeten_func = sub {
        for my $spec ( @_ ) {
            my ( $class ) = split /->/, $spec;
            my ( $id ) = ( reverse split /::/, $class )[0];
            my ( $ctors, $ids ) =
              Constructor::Sugar->import::into( $library, $spec );
            push @{ _getexport $library}, @{$ctors}, @{$ids};
            my $tags = _getexport_tags $library;
            push @{ $tags->{$id} }, @{$ctors}, @{$ids};
            push @{ $tags->{ctors} }, @{$ctors};
            push @{ $tags->{ids} },   @{$ids};
        }
    };
    my $sweeten_meth = sub {
        shift;
        $sweeten_func->( @_ );
    };
    *{ _getglob $library, "sweeten" }      = $sweeten_func;
    *{ _getglob $library, "sweeten_meth" } = $sweeten_meth;
    return;
}

1;

__END__