view release on metacpan or  search on metacpan

script/_finddo  view on Meta::CPAN

#                $clset0 = $s->[1];
#                $extras = $s->[2];
#                die "For array form, there should not be more than 3 elements"
#                    if @$s > 3;
#            } else {
#                die "For array in the form of [t, c1=>1, ...], there must be ".
#                    "3 elements (or 5, 7, ...)"
#                        unless @$s % 2;
#                $clset0 = { @{$s}[1..@$s-1] };
#            }
#        } else {
#            $clset0 = {};
#        }
#
#        my $clset = normalize_clset($clset0, {has_req=>$has_req});
#        if (defined $extras) {
#            die "For array form with 3 elements, extras must be hash"
#                unless ref($extras) eq 'HASH';
#            die "'def' in extras must be a hash"
#                if exists $extras->{def} && ref($extras->{def}) ne 'HASH';
#            return [$t, $clset, { %{$extras} }];
#        } else {
#            return [$t, $clset, {}];
#        }
#    }
#
#    die "Schema must be a string or arrayref (not $ref)";
#}
#
#1;
#
#__END__
#
### Data/Sah/Resolve.pm ###
#package Data::Sah::Resolve;
#
#our $DATE = '2017-04-19'; 
#our $VERSION = '0.007'; 
#
#use 5.010001;
#use strict;
#use warnings;
#
#use Exporter qw(import);
#our @EXPORT_OK = qw(resolve_schema);
#
#sub _resolve {
#    my ($opts, $type, $clsets, $seen) = @_;
#
#    die "Recursive schema definition: ".join(" -> ", @$seen, $type)
#        if grep { $type eq $_ } @$seen;
#    push @$seen, $type;
#
#    (my $typemod_pm = "Data/Sah/Type/$type.pm") =~ s!::!/!g;
#    eval { require $typemod_pm; 1 };
#    my $err = $@;
#    return [$type, $clsets] unless $err;
#    die "Can't check whether $type is a builtin Sah type: $err"
#        unless $err =~ /\ACan't locate/;
#
#    my $schmod = "Sah::Schema::$type";
#    (my $schmod_pm = "$schmod.pm") =~ s!::!/!g;
#    eval { require $schmod_pm; 1 };
#    die "Not a known built-in Sah type '$type' (can't locate ".
#        "Data::Sah::Type::$type) and not a known schema name '$type' ($@)"
#            if $@;
#    no strict 'refs';
#    my $sch2 = ${"$schmod\::schema"};
#    die "BUG: Schema module $schmod doesn't contain \$schema" unless $sch2;
#    unshift @$clsets, $sch2->[1];
#    _resolve($opts, $sch2->[0], $clsets, $seen);
#}
#
#sub resolve_schema {
#    my $opts = ref($_[0]) eq 'HASH' ? shift : {};
#    my $sch = shift;
#
#    unless ($opts->{schema_is_normalized}) {
#        require Data::Sah::Normalize;
#        $sch =  Data::Sah::Normalize::normalize_schema($sch);
#    }
#    $opts->{merge_clause_sets} //= 1;
#
#    my $seen = [];
#    my $res = _resolve($opts, $sch->[0], keys(%{$sch->[1]}) ? [$sch->[1]] : [], $seen);
#
#  MERGE:
#    {
#        last unless $opts->{merge_clause_sets};
#        last if @{ $res->[1] } < 2;
#
#        my @clsets = (shift @{ $res->[1] });
#        for my $clset (@{ $res->[1] }) {
#            my $has_merge_mode_keys;
#            for (keys %$clset) {
#                if (/\Amerge\./) {
#                    $has_merge_mode_keys = 1;
#                    last;
#                }
#            }
#            if ($has_merge_mode_keys) {
#                state $merger = do {
#                    require Data::ModeMerge;
#                    my $mm = Data::ModeMerge->new(config => {
#                        recurse_array => 1,
#                    });
#                    $mm->modes->{NORMAL}  ->prefix   ('merge.normal.');
#                    $mm->modes->{NORMAL}  ->prefix_re(qr/\Amerge\.normal\./);
#                    $mm->modes->{ADD}     ->prefix   ('merge.add.');
#                    $mm->modes->{ADD}     ->prefix_re(qr/\Amerge\.add\./);
#                    $mm->modes->{CONCAT}  ->prefix   ('merge.concat.');
#                    $mm->modes->{CONCAT}  ->prefix_re(qr/\Amerge\.concat\./);
#                    $mm->modes->{SUBTRACT}->prefix   ('merge.subtract.');
#                    $mm->modes->{SUBTRACT}->prefix_re(qr/\Amerge\.subtract\./);
#                    $mm->modes->{DELETE}  ->prefix   ('merge.delete.');
#                    $mm->modes->{DELETE}  ->prefix_re(qr/\Amerge\.delete\./);
#                    $mm->modes->{KEEP}    ->prefix   ('merge.keep.');
#                    $mm->modes->{KEEP}    ->prefix_re(qr/\Amerge\.keep\./);
#                    $mm;
#                };
#                my $merge_res = $merger->merge($clsets[-1], $clset);
#                unless ($merge_res->{success}) {
#                    die "Can't merge clause set: $merge_res->{error}";
#                }
#                $clsets[-1] = $merge_res->{result};
#            } else {
#                push @clsets, $clset;
#            }
#        }