File Coverage

blib/lib/Data/Sah/DefaultValueJS.pm
Criterion Covered Total %
statement 23 48 47.9
branch 0 10 0.0
condition n/a
subroutine 8 10 80.0
pod 1 1 100.0
total 32 69 46.3


line stmt bran cond sub pod time code
1             package Data::Sah::DefaultValueJS;
2              
3 1     1   509 use 5.010001;
  1         4  
4 1     1   5 use strict;
  1         2  
  1         20  
5 1     1   6 use warnings;
  1         13  
  1         21  
6 1     1   5 use Log::ger;
  1         2  
  1         7  
7              
8 1     1   213 use Data::Sah::DefaultValueCommon;
  1         2  
  1         39  
9 1     1   629 use IPC::System::Options;
  1         4272  
  1         7  
10 1     1   563 use Nodejs::Util qw(get_nodejs_path);
  1         1725  
  1         84  
11              
12 1     1   8 use Exporter qw(import);
  1         2  
  1         486  
13              
14             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
15             our $DATE = '2023-01-20'; # DATE
16             our $DIST = 'Data-Sah-DefaultValue'; # DIST
17             our $VERSION = '0.002'; # VERSION
18              
19             our @EXPORT_OK = qw(gen_default_value_code);
20              
21             our %SPEC;
22              
23             our $Log_Default_Value_Code = $ENV{LOG_SAH_DEFAULT_VALUE_CODE} // 0;
24              
25             $SPEC{gen_default_value_code} = {
26             v => 1.1,
27             summary => 'Generate code to set default value',
28             description => <<'_',
29              
30             This is mostly for testing. Normally the coercion rules will be used from
31             .
32              
33             _
34             args => {
35             %Data::Sah::DefaultValueCommon::gen_default_value_code_args,
36             },
37             result_naked => 1,
38             };
39             sub gen_default_value_code {
40 0     0 1   my %args = @_;
41              
42 0           my $rules = Data::Sah::DefaultValueCommon::get_default_value_rules(
43             %args,
44             compiler=>'js',
45             );
46              
47 0           my $code;
48 0 0         if (@$rules) {
49 0           my $expr = '';
50             $code = join(
51             "",
52             "function (res) {\n",
53             (map {
54 0           " if (res === undefined || res === null) { res = $rules->[$_]{expr_value} }\n"
55 0           } (reverse 0..$#{$rules})),
  0            
56             " return res\n",
57             "}",
58             );
59             } else {
60 0           $code = 'function (res) { return res }';
61             }
62              
63 0 0         if ($Log_Default_Value_Code) {
64 0           log_trace("Default-value code (gen args: %s): %s", \%args, $code);
65             }
66              
67 0 0         return $code if $args{source};
68              
69 0           state $nodejs_path = get_nodejs_path();
70 0 0         die "Can't find node.js in PATH" unless $nodejs_path;
71              
72             sub {
73 0     0     require File::Temp;
74 0           require JSON::MaybeXS;
75             #require String::ShellQuote;
76              
77 0           my $data = shift;
78              
79 0           state $json = JSON::MaybeXS->new->allow_nonref;
80              
81             # code to be sent to nodejs
82 0           my $src = "var default_value_code = $code;\n\n".
83             "console.log(JSON.stringify(default_value_code(".
84             $json->encode($data).")))";
85              
86 0           my ($jsh, $jsfn) = File::Temp::tempfile();
87 0           print $jsh $src;
88 0 0         close($jsh) or die "Can't write JS code to file $jsfn: $!";
89              
90 0           my $out = IPC::System::Options::readpipe($nodejs_path, $jsfn);
91 0           $json->decode($out);
92 0           };
93             }
94              
95             1;
96             # ABSTRACT: Generate code to set default value
97              
98             __END__