view release on metacpan or  search on metacpan

lib/Config/Strict.pm  view on Meta::CPAN

package Config::Strict;
use warnings;
use strict;
use Data::Dumper;
use Scalar::Util qw(blessed weaken);
$Data::Dumper::Indent = 0;
use Carp qw(confess croak);

our $VERSION = '0.07';

use Declare::Constraints::Simple -All;
use Config::Strict::UserConstraints;

my %type_registry = (
    Bool     => IsOneOf( 0, 1 ),
    Num      => IsNumber,
    Int      => IsInt,
    Str      => HasLength,
    ArrayRef => IsArrayRef,
    HashRef  => IsHashRef,
    CodeRef  => IsCodeRef,
    Regexp   => IsRegex,
#    Enum     => undef,
#    Anon => undef,
);

sub register_types {
    # Allow user type registration
    my $class = shift;
    croak "No class" unless $class and not ref $class;
    croak "Invalid name-constraint pairs args (@_)" unless @_ and @_ % 2 == 0;
    my %nc = @_;
    while ( my ( $name, $constraint ) = each %nc ) {
        croak "No name"       unless $name;
        croak "No constraint" unless $constraint;
        croak "$name is already a registered type"
            if exists $type_registry{ $name }
                or $name eq 'Enum'
                or $name eq 'Anon';
#        print "Creating user type $name...\n";
        if ( _check_is_profile( $constraint ) ) {
            # Already a profile
            $type_registry{ $name } = $constraint;
        }
        else {
            # Make a profile from a bare sub
            my $made = _make_constraint( $name => $constraint );
            $type_registry{ $name } = $made;
        }
    }
}

sub _create_profile {
    my $param = shift;

    # Check parameter hash structure
    _validate_params( $param );

    my %profile = (
        # Built-in types
        (
            map {
                my $type = $_;
                map { $_ => $type_registry{ $type } }
                    _flatten( $param->{ $_ } )