File Coverage

blib/lib/Data/Sah/DefaultValue.pm

Criterion	Covered	Total	%
statement	38	44	86.3
branch	6	14	42.8
condition			n/a
subroutine	8	8	100.0
pod	1	1	100.0
total	53	67	79.1

package Data::Sah::DefaultValue;

use 5.010001;
use strict;
use warnings;
no warnings 'once';
use Log::ger;

use Data::Sah::DefaultValueCommon;

use Exporter qw(import);

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2023-03-30'; # DATE
our $DIST = 'Data-Sah-DefaultValue'; # DIST
our $VERSION = '0.003'; # VERSION

our @EXPORT_OK = qw(gen_default_value_code);

our %SPEC;

our $Log_Default_Value_Code = $ENV{LOG_SAH_DEFAULT_VALUE_CODE} // 0;

$SPEC{gen_default_value_code} = {
    v => 1.1,
    summary => 'Generate code to set default value',
    description => <<'_',

This is mostly for testing. Normally the default value rules will be used from
 via the `x.perl.default_value_rules` or
`x.js.default_value_rules` or `x.default_value_rules` property.

_
    args => {
        %Data::Sah::DefaultValueCommon::gen_default_value_code_args,
    },
    result_naked => 1,
};
sub gen_default_value_code {
    my %args = @_;

    my $rules = Data::Sah::DefaultValueCommon::get_default_value_rules(
        %args,
        compiler=>'perl',
    );

    my $code;
    if (@$rules) {
        my $code_require = '';
        my %mem;
        for my $rule (@$rules) {
            next unless $rule->{modules};
            for my $mod (keys %{$rule->{modules}}) {
                next if $mem{$mod}++;
                $code_require .= "require $mod;\n";
            }
        }

        my $expr = '';
        for my $i (reverse 0..$#{$rules}) {
            $expr .= (length($expr) ? ' // ' : '') .
                "($rules->[$i]{expr_value})";
        }

        $code = join(
            "",
            $code_require,
            "sub { shift // $expr };\n",
        );
    } else {
        $code = 'sub { shift }';
    }

    if ($Log_Default_Value_Code) {
        log_trace("Default-value code (gen args: %s): %s", \%args, $code);
    }

    return $code if $args{source};

    my $default_value_code = eval $code; ## no critic: BuiltinFunctions::ProhibitStringyEval
    die if $@;
    $default_value_code;
}

1;
# ABSTRACT: Default-value rules for Data::Sah

__END__