view release on metacpan or  search on metacpan

lib/Marlin/Antlers.pm  view on Meta::CPAN

use v5.20;
use experimental qw( signatures postderef lexical_subs );
use feature ();
use strict;
use warnings;

package Marlin::Antlers;

our $AUTHORITY = 'cpan:TOBYINK';
our $VERSION   = '0.003001';

BEGIN {
	my @funcs = qw( at_runtime after_runtime );
	if ( eval 'require B::Hooks::AtRuntime; B::Hooks::AtRuntime->VERSION( 8 ) ' ) {
		B::Hooks::AtRuntime->import( @funcs );
	}
	else {
		require B::Hooks::AtRuntime::OnlyCoreDependencies;
		B::Hooks::AtRuntime::OnlyCoreDependencies->import( @funcs );
	}
};

use Class::Method::Modifiers qw( install_modifier );
use Exporter::Tiny;
use Import::Into;
use Marlin ();
use Marlin::Role ();
use Marlin::Util -lexical, qw( true false );
use Types::Common -lexical, -all;

use namespace::autoclean;

our @ISA    = qw( Exporter::Tiny );
our @EXPORT = qw( has extends with before after around fresh signature signature_for __FINALIZE__ );

my %PACKAGES;

sub _exporter_validate_opts ( $me, $globals ) {
	
	my $pkg  = $globals->{into};
	my $kind = $globals->{__role} ? 'Marlin::Role' : 'Marlin';
	if ( $PACKAGES{$pkg} ) {
		Marlin::Util::_croak "$pkg already uses $kind\::Antlers";
	}
	elsif ( my $meta = Marlin->find_meta($pkg) ) {
		Marlin::Util::_croak "$pkg already uses " . ( $meta->inhaled_from // ref $meta );
	}
	else {
		$PACKAGES{$pkg} = $kind;
	}

	$globals->{installer} ||= $me->_exporter_lexical_installer( $globals );
	
	experimental->import::into( $pkg, qw( signatures postderef lexical_subs ) );
	feature->import::into( $pkg, qw( current_sub evalbytes fc say state unicode_eval unicode_strings ) );
	strict->import::into( $pkg );
	warnings->import::into( $pkg );
	Marlin::Util->import::into( $pkg, -lexical, -all );
	Types::Common->import::into( $pkg, -lexical, -all, qw( !signature !signature_for ) );
	namespace::autoclean->import::into( $pkg );
	
	my @plugins = do {
		my $tmp = Exporter::Tiny::mkopt(
			is_ArrayRef( $globals->{x} ) ? $globals->{x} :
			is_Str( $globals->{x} )      ? [ $globals->{x} ] :
			is_Defined( $globals->{x} )  ? Marlin::Util::_croak("Invalid value for 'x'") : []
		);
		$_->[0] =~ s/^:/Marlin::X::/s for $tmp->@*;
		$tmp->@*;
	};
	
	my $args = $globals->{MARLIN} = {
		caller      => $pkg,
		this        => $pkg,
		parents     => [],
		roles       => [],
		attributes  => [],
		plugins     => \@plugins,
		delayed     => [],
		strict      => !( $globals->{sloppy} ),
		constructor => $globals->{constructor} // 'new',
		modifiers   => false, # export our own versions!
	};
	my $mods = $globals->{MODIFY} = [];
	
	my $finalize = $globals->{FINALIZE} = sub () {
		state $finalized = 0;
		return if $finalized++;
		my $marlin = $kind->new( $args );
		$marlin->store_meta;
		$marlin->do_setup;
		install_modifier( $pkg, $_->@* ) for $mods->@*;
	};
	
	&after_runtime( $finalize );
}

sub _generate_has ( $me, $name, $value, $globals ) {
	return sub ( $names, @spec ) {
		
		is_ArrayRef $names
			or $names = [ $names ];
		assert_Str $_ for $names->@*;
		
		my $spec = ( @spec == 0 ) ? {} : ( @spec == 1 ) ? $spec[0] : { @spec };
		if ( is_Object $spec and $spec->DOES('Type::API::Constraint') ) {
			my $tc = $spec;
			$spec = {
				isa      => $tc,
				coerce   => !!( $tc->DOES('Type::API::Constraint::Coercible') and $tc->has_coercion ),
			};
		}
		elsif ( is_CodeRef $spec ) {
			$spec = {
				lazy     => !!1,
				builder  => $spec,