view release on metacpan or  search on metacpan

lib/kura.pm  view on Meta::CPAN

package kura;
use strict;
use warnings;

our $VERSION = "0.10";

use Carp ();
use Sub::Util ();
use Scalar::Util ();

my %FORBIDDEN_NAME = map { $_ => 1 } qw{
    BEGIN CHECK DESTROY END INIT UNITCHECK
    AUTOLOAD STDIN STDOUT STDERR ARGV ARGVOUT ENV INC SIG
};

my @ALLOWED_CONSTRAINT_CLASSES = qw(
    Data::Validator
    Poz::Types
);

sub import {
    my $pkg = shift;
    my $caller = caller;

    $pkg->import_into($caller, @_);
}

# Import into the caller package.
sub import_into {
    my $pkg = shift;
    my ($caller, $name, $constraint) = @_;

    my ($kura_item, $err) = _new_kura_item($caller, $name, $constraint);
    Carp::croak $err if $err;

    _save_kura_item($kura_item, $caller);
    _save_inc($caller);
}

# Create a constraint object.
#
# @param $constraint Defined. Following `create_constraint` function allows these types: Object, CodeRef, HashRef.
# @param $opts Dict[name => Str, caller => Str]
# @return ($constraint, undef) | (undef, $error_message)
#
# NOTE: This function is a hook point. If you want to customize the constraint object, you can override this function.
sub create_constraint {
    my ($constraint, $opts) = @_;

    if (my $blessed = Scalar::Util::blessed($constraint)) {
        return _create_constraint_from_typetiny($constraint, $opts) if $constraint->isa('Type::Tiny');
        return ($constraint, undef) if $constraint->can('check');
        return ($constraint, undef) if grep { $constraint->isa($_) } @ALLOWED_CONSTRAINT_CLASSES;
        return (undef, "Invalid constraint. Object must have a `check` method or allowed constraint class: $blessed");
    }
    elsif (my $reftype = Scalar::Util::reftype($constraint)) {
        if ($reftype eq 'CODE') {
            return _create_constraint_from_coderef($constraint, $opts);
        }
        elsif ($reftype eq 'HASH') {
            return _create_constraint_from_hashref($constraint, $opts);
        }
    }

    return (undef, 'Invalid constraint');
}

# Create a constraint object from a Type::Tiny object.
sub _create_constraint_from_typetiny {
    my ($type, $opts) = @_;

    $type->{name} = $opts->{name} if $type->is_anon;