view release on metacpan or  search on metacpan

lib/MooseX/Extended/Core.pm  view on Meta::CPAN

package MooseX::Extended::Core;

# ABSTRACT: Internal module for MooseX::Extended

use v5.20.0;
use warnings;
use parent 'Exporter';
use Moose::Util qw(
  add_method_modifier
  throw_exception
);
use MooseX::Extended::Types qw(
  ArrayRef
  Bool
  Dict
  Enum
  NonEmptyStr
  Optional
  Str
  Undef
  compile_named
);
use Module::Load 'load';
use feature qw(signatures postderef);
no warnings qw(experimental::signatures experimental::postderef);

use Storable 'dclone';
use Ref::Util qw(
  is_plain_arrayref
  is_coderef
);
use Carp 'croak';
#

our $VERSION = '0.35';

our @EXPORT_OK = qw(
  _assert_import_list_is_valid
  _debug
  _disabled_warnings
  _enabled_features
  _our_import
  _our_init_meta
  field
  param
);

# Core's use feature 'try' only supports 'finally' since 5.35.8
use constant HAVE_FEATURE_TRY => $] >= 5.035008;

sub _enabled_features  {qw/signatures postderef postderef_qq :5.20/}             # internal use only
sub _disabled_warnings {qw/experimental::signatures experimental::postderef/}    # internal use only

warnings::register_categories(
    'MooseX::Extended::naked_fields',
);

# Should this be in the metaclass? It feels like it should, but
# the MOP really doesn't support these edge cases.
my %CONFIG_FOR;

sub _config_for ($package) {
    return $CONFIG_FOR{$package};
}

sub _our_import {

    # don't use signatures for this import because we need @_ later. @_ is
    # intended to be removed for subs with signature
    my ( $class, $import, $target_class ) = @_;

    # Moose::Exporter uses Sub::Exporter to handle exporting, so it accepts an
    # { into =>> $target_class } to say where we're exporting this to. This is
    # used by our ::Custom modules to let people define their own versions
    @_ = ( $class, { into => $target_class } );    # anything else and $import blows up
    goto $import;
}

# asserts the import list is valid, rewrites the excludes and includes from
# arrays to hashes (if ( $args{excludes}{$feature} ) ...) and returns the
# target package that this code will be applied to. Yeah, it does too much.
sub _assert_import_list_is_valid {
    my ( $class, $args ) = @_;

    foreach my $features (qw/types excludes/) {
        if ( exists $args->{$features} && !ref $args->{$features} ) {
            $args->{$features} = [ $args->{$features} ];
        }