view release on metacpan or  search on metacpan

lib/Validation/Class/Prototype.pm  view on Meta::CPAN

        }

        $documents->{$name} = $ref;

    }

    else {

        $name = $ref;

    }

    my $fields = { map { $_ => 1 } ($self->fields->keys) };

    confess "Please supply a registered document name to validate against"
        unless $name
    ;

    confess "The ($name) document is not registered and cannot be validated against"
        unless $name && exists $documents->{$name}
    ;

    my $document = $documents->{$name};

    confess "The ($name) document does not contain any mappings and cannot ".
          "be validated against" unless keys %{$documents}
    ;

    $options ||= {};

    # handle sub-document references

    for my $key (keys %{$document}) {

        $document->{$key} = $documents->{$document->{$key}} if
            $document->{$key} && exists $documents->{$document->{$key}} &&
            ! $self->fields->has($document->{$key})
        ;

    }

    $document = flatten $document;

    my $signature = clone $document;

    # create document signature

    for my $key (keys %{$signature}) {

        (my $new = $key) =~ s/\\//g;

        $new =~ s/\*/???/g;
        $new =~ s/\.@/:0/g;

        $signature->{$new} = '???';

        delete $signature->{$key} unless $new eq $key;

    }

    my $overlay = clone $signature;

    $_ = undef for values %{$overlay};

    # handle regex expansions

    for my $key (keys %{$document}) {

        my  $value = delete $document->{$key};

        my  $token;
        my  $regex;

            $token  = '\.\@';
            $regex  = ':\d+';
            $key    =~ s/$token/$regex/g;

            $token  = '\*';
            $regex  = '[^\.]+';
            $key    =~ s/$token/$regex/g;

        $document->{$key} = $value;

    }

    my $_dmap = {};
    my $_pmap = {};
    my $_xmap = {};

    my $_zata = flatten $data;
    my $_data = merge $overlay, $_zata;

    # remove overlaid patterns if matching nodes exist

    for my $key (keys %{$_data}) {

        if ($key =~ /\?{3}/) {

            (my $regex = $key) =~ s/\?{3}/\\w+/g;

            delete $_data->{$key}
                if grep { $_ =~ /$regex/ && $_ ne $key } keys %{$_data};

        }

    }

    # generate validation rules

    for my $key (keys %{$_data}) {

        my  $point = $key;
            $point =~ s/\W/_/g;
        my  $label = $key;
            $label =~ s/\:/./g;

        my  $match = 0;

        my  $switch;

        for my $regex (keys %{$document}) {

            if (exists $_data->{$key}) {

                my  $field  = $document->{$regex};

                if ($key =~ /^$regex$/) {

                    $switch = $1 if $field =~ s/^([+-])//;

                    my $config = {label => $label};

                    $config->{mixin} = $self->fields->get($field)->mixin
                        if $self->fields->get($field)->can('mixin')
                    ;

                    $self->clone_field($field, $point => $config);

                    $self->apply_mixin($point => $config->{mixin})
                        if $config->{mixin}
                    ;

                    $_dmap->{$key}   = 1;
                    $_pmap->{$point} = $key;

                    $match = 1;

                }

            }