—

              
package Data::Sah::Util::Role;
use 5.010;
use strict 'subs', 'vars';
use warnings;
#use Log::Any '$log';
require Exporter;
our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2024-02-16'; # DATE
our $DIST = 'Data-Sah'; # DIST
our $VERSION = '0.917'; # VERSION
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(
                       has_clause has_clause_alias
                       has_func   has_func_alias
               );
sub has_clause {
    my ($name, %args) = @_;
    my $caller = caller;
    my $into   = $args{into} // $caller;
    my $v = $args{v} // 1;
    if ($v != 2) {
        die "Declaration of clause '$name' still follows version $v ".
            "(2 expected), please make sure $caller is the latest version";
    }
    if ($args{code}) {
        *{"$into\::clause_$name"} = $args{code};
    } else {
        eval "package $into; use Role::Tiny; ". ## no critic: BuiltinFunctions::ProhibitStringyEval
            "requires 'clause_$name';";
    }
    *{"$into\::clausemeta_$name"} = sub {
        state $meta = {
            names        => [$name],
            tags         => $args{tags},
            prio         => $args{prio} // 50,
            schema       => $args{schema},
            allow_expr   => $args{allow_expr},
            attrs        => $args{attrs} // {},
            inspect_elem => $args{inspect_elem},
            subschema    => $args{subschema},
        };
        $meta;
    };
    has_clause_alias($name, $args{alias}  , $into);
    has_clause_alias($name, $args{aliases}, $into);
}
sub has_clause_alias {
    my ($name, $aliases, $into) = @_;
    my $caller   = caller;
    $into      //= $caller;
    my @aliases = !$aliases ? () :
        ref($aliases) eq 'ARRAY' ? @$aliases : $aliases;
    my $meta = $into->${\("clausemeta_$name")};
    for my $alias (@aliases) {
        push @{ $meta->{names} }, $alias;
        eval ## no critic: BuiltinFunctions::ProhibitStringyEval
            "package $into;".
            "sub clause_$alias { shift->clause_$name(\@_) } ".
            "sub clausemeta_$alias { shift->clausemeta_$name(\@_) } ";
        $@ and die "Can't make clause alias $alias -> $name: $@";
    }
}
sub has_func {
    my ($name, %args) = @_;
    my $caller = caller;
    my $into   = $args{into} // $caller;
    if ($args{code}) {
        *{"$into\::func_$name"} = $args{code};
    } else {
        eval "package $into; use Role::Tiny; requires 'func_$name';"; ## no critic: BuiltinFunctions::ProhibitStringyEval
    }
    *{"$into\::funcmeta_$name"} = sub {
        state $meta = {
            names => [$name],
            args  => $args{args},
        };
        $meta;
    };
    my @aliases =
        map { (!$args{$_} ? () :
                   ref($args{$_}) eq 'ARRAY' ? @{ $args{$_} } : $args{$_}) }
            qw/alias aliases/;
    has_func_alias($name, $args{alias}  , $into);
    has_func_alias($name, $args{aliases}, $into);
}
sub has_func_alias {
    my ($name, $aliases, $into) = @_;
    my $caller   = caller;
    $into      //= $caller;
    my @aliases = !$aliases ? () :
        ref($aliases) eq 'ARRAY' ? @$aliases : $aliases;
    my $meta = $into->${\("funcmeta_$name")};
    for my $alias (@aliases) {
        push @{ $meta->{names} }, $alias;
        eval ## no critic: BuiltinFunctions::ProhibitStringyEval
            "package $into;".
            "sub func_$alias { shift->func_$name(\@_) } ".
            "sub funcmeta_$alias { shift->funcmeta_$name(\@_) } ";
        $@ and die "Can't make func alias $alias -> $name: $@";
    }
}
1;
# ABSTRACT: Sah utility routines for roles
__END__
HideShow 169 lines of Pod
=pod
=encoding UTF-8
=head1 NAME
Data::Sah::Util::Role - Sah utility routines for roles
=head1 VERSION
This document describes version 0.917 of Data::Sah::Util::Role (from Perl distribution Data-Sah), released on 2024-02-16.
=head1 DESCRIPTION
This module provides some utility routines to be used in roles, e.g.
C<Data::Sah::Type::*> and C<Data::Sah::FuncSet::*>.
=head1 FUNCTIONS
=head2 has_clause($name, %opts)
Define a clause. Used in type roles (C<Data::Sah::Type::*>). Internally it adds
a L<Moo> C<requires> for C<clause_$name>.
Options:
=over 4
=item * v => int
Specify clause specification version. Must be 2 (the current version).
=item * schema => sah::schema
Define schema for clause value.
=item * prio => int {min=>0, max=>100, default=>50}
Optional. Default is 50. The higher the priority (the lower the number), the
earlier the clause will be processed.
=item * aliases => \@aliases OR $alias
Define aliases. Optional.
=item * inspect_elem => bool
If set to true, then this means clause inspect the element(s) of the data. This
is only relevant for types that has elements (see L<HasElems
role|Data::Sah::Type::HasElems>). An example of clause like this is C<has> or
C<each_elem>. When the value of C<inspect_elem> is true, a compiler must prepare
by coercing the elements of the data, if there are coercion rules applicable.
=item * subschema => coderef
If set, then declare that the clause value contains a subschema. The coderef
must provide a way to get the subschema from
=item * code => coderef
Optional. Define implementation for the clause. The code will be installed as
'clause_$name'.
=item * into => str $package
By default it is the caller package, but can be set to other package.
=back
Example:
 has_clause minimum => (arg => 'int*', aliases => 'min');
=head2 has_clause_alias TARGET => ALIAS | [ALIAS1, ...]
Specify that clause named ALIAS is an alias for TARGET.
You have to define TARGET clause first (see B<has_clause> above).
Example:
 has_clause max_length => ...;
 has_clause_alias max_length => "max_len";
=head2 has_func($name, %opts)
Define a Sah function. Used in function set roles (C<Data::Sah::FuncSet::*>).
Internally it adds a L<Moo> C<requires> for C<func_$name>.
Options:
=over 4
=item * aliases => \@aliases OR $alias
Optional. Declare aliases.
=item * code => $code
Supply implementation for the function. The code will be installed as
'func_$name'.
=item * into => $package
By default it is the caller package, but can be set to other package.
=back
Example:
 has_func abs => (args => 'num');
=head2 has_func_alias TARGET => ALIAS | [ALIASES...]
Specify that function named ALIAS is an alias for TARGET.
You have to specify TARGET function first (see B<has_func> above).
Example:
 has_func_alias 'atan' => 'arctan';
=head1 HOMEPAGE
Please visit the project's homepage at L<https://metacpan.org/release/Data-Sah>.
=head1 SOURCE
Source repository is at L<https://github.com/perlancar/perl-Data-Sah>.
=head1 AUTHOR
perlancar <perlancar@cpan.org>
=head1 CONTRIBUTING
To contribute, you can send patches by email/via RT, or send pull requests on
GitHub.
Most of the time, you don't need to build the distribution yourself. You can
simply modify the code, then test via:
 % prove -l
If you want to build the distribution (e.g. to try to install it locally on your
system), you can install L<Dist::Zilla>,
L<Dist::Zilla::PluginBundle::Author::PERLANCAR>,
L<Pod::Weaver::PluginBundle::Author::PERLANCAR>, and sometimes one or two other
Dist::Zilla- and/or Pod::Weaver plugins. Any additional steps required beyond
that are considered a bug and can be reported to me.
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2024, 2022, 2021, 2020, 2019, 2018, 2017, 2016, 2015, 2014, 2013, 2012 by perlancar <perlancar@cpan.org>.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=head1 BUGS
Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Sah>
When submitting a bug or request, please include a test-file or a
patch to an existing test-file that illustrates the bug or desired
feature.
=cut