File Coverage

blib/lib/Valiemon.pm

Criterion	Covered	Total	%
statement	52	53	98.1
branch	13	16	81.2
condition	5	9	55.5
subroutine	14	14	100.0
pod	0	5	0.0
total	84	97	86.6

package Valiemon;
use 5.012;
use strict;
use warnings;
use utf8;

use Carp qw(croak);
use Valiemon::Primitives;
use Valiemon::Context;
use Valiemon::Attributes qw(attr);

use Class::Accessor::Lite (
    ro => [qw(schema options pos schema_cache)],
);

our $VERSION = "0.03";

sub new {
    my ($class, $schema, $options) = @_;

    # TODO should validate own schema
    if ($options->{validate_schema}) {}
    croak 'schema must be a hashref' unless ref $schema eq 'HASH';

    return bless {
        schema       => $schema,
        options      => $options,
        schema_cache => +{},
    }, $class;
}

sub validate {
    my ($self, $data, $context) = @_;
    my $schema = $self->schema;

    $context //= Valiemon::Context->new($self, $schema);

    for my $key (keys %{$schema}) {
        my $attr = attr($key);
        if ($attr) {
            my ($is_valid, $error) = $attr->is_valid($context, $schema, $data);
            unless ($is_valid) {
                $error->set_detail(
                    expected => $schema,
                    actual => $data,
                );
                $context->push_error($error);
                next;
            }
        }
    }

    my $errors = $context->errors;
    my $is_valid = scalar @$errors ? 0 : 1;
    return wantarray ? ($is_valid, $errors->[0]) : $is_valid;
}

sub prims {
    my ($self) = @_;
    return $self->{prims} //= Valiemon::Primitives->new(
        $self->options
    );
}

sub ref_schema_cache {
    my ($self, $ref, $schema) = @_;
    return defined $schema
        ? $self->schema_cache->{$ref} = $schema
        : $self->{schema_cache}->{ref};
}

sub resolve_ref {
    my ($self, $ref) = @_;

    # TODO follow the standard referencing
    unless ($ref =~ qr|^#/|) {
        croak 'This package support only single scope and `#/` referencing';
    }

    return $self->ref_schema_cache($ref) || do {
        my $paths = do {
            my @p = split '/', $ref;
            [ splice @p, 1 ]; # remove '#'
        };
        my $sub_schema = $self->schema;
        {
            eval { $sub_schema = $sub_schema->{$_} for @$paths };
            croak sprintf 'referencing `%s` cause error', $ref if $@;
            croak sprintf 'schema `%s` not found', $ref unless $sub_schema;
        }
        $self->ref_schema_cache($ref, $sub_schema); # caching
        $sub_schema;
    };
}


1;

__END__