File Coverage

blib/lib/Data/Sah/FilterJS.pm
Criterion Covered Total %
statement 23 55 41.8
branch 0 16 0.0
condition 0 2 0.0
subroutine 8 10 80.0
pod 1 1 100.0
total 32 84 38.1


line stmt bran cond sub pod time code
1             package Data::Sah::FilterJS;
2              
3 1     1   495849 use 5.010001;
  1         3  
4 1     1   5 use strict;
  1         1  
  1         30  
5 1     1   3 use warnings;
  1         2  
  1         52  
6 1     1   1403 use Log::ger;
  1         43  
  1         5  
7              
8 1     1   561 use Data::Sah::FilterCommon;
  1         2  
  1         34  
9 1     1   5 use Exporter qw(import);
  1         1  
  1         28  
10 1     1   633 use IPC::System::Options;
  1         3827  
  1         6  
11 1     1   602 use Nodejs::Util qw(get_nodejs_path);
  1         1530  
  1         480  
12              
13             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
14             our $DATE = '2024-07-17'; # DATE
15             our $DIST = 'Data-Sah-Filter'; # DIST
16             our $VERSION = '0.025'; # VERSION
17              
18             our @EXPORT_OK = qw(gen_filter);
19              
20             our %SPEC;
21              
22             our $Log_Filter_Code = $ENV{LOG_SAH_FILTER_CODE} // 0;
23              
24             $SPEC{gen_filter} = {
25             v => 1.1,
26             summary => 'Generate filter code',
27             description => <<'_',
28              
29             This is mostly for testing. Normally the filter rules will be used from
30             .
31              
32             _
33             args => {
34             %Data::Sah::FilterCommon::gen_filter_args,
35             },
36             result_naked => 1,
37             };
38             sub gen_filter {
39 0     0 1   my %args = @_;
40              
41 0   0       my $rt = $args{return_type} // 'val';
42              
43 0           my $rules = Data::Sah::FilterCommon::get_filter_rules(
44             %args,
45             compiler=>'js',
46             data_term=>'data',
47             );
48              
49 0           my $code;
50 0 0         if (@$rules) {
51 0           $code = join(
52             "",
53             "function (data) {\n",
54             " if (data === undefined || data === null) {\n",
55             " return null;\n",
56             " }\n",
57             );
58 0           for my $rule (@$rules) {
59 0 0         if ($rule->{meta}{might_fail}) {
60 0 0         if ($rt eq 'val') {
61 0           $code .= " tmp = $rule->{expr_filter}; if (tmp[0]) { return null; } data = tmp[1]\n";
62             } else {
63 0           $code .= " tmp = $rule->{expr_filter}; if (tmp[0]) { return tmp; } data = tmp[1]\n";
64             }
65             } else {
66 0 0         if ($rt eq 'val') {
67 0           $code .= " data = $rule->{expr_filter}\n";
68             } else {
69 0           $code .= " data = [false, $rule->{expr_filter}]\n";
70             }
71             }
72             }
73 0           $code .= join(
74             '',
75             " return data;\n",
76             "}",
77             );
78             } else {
79 0           $code = 'function (data) { return data }';
80             }
81              
82 0 0         if ($Log_Filter_Code) {
83 0           log_trace("Filter code (gen args: %s): %s", \%args, $code);
84             }
85              
86 0 0         return $code if $args{source};
87              
88 0           state $nodejs_path = get_nodejs_path();
89 0 0         die "Can't find node.js in PATH" unless $nodejs_path;
90              
91             sub {
92 0     0     require File::Temp;
93 0           require JSON;
94             #require String::ShellQuote;
95              
96 0           my $data = shift;
97              
98 0           state $json = JSON->new->allow_nonref;
99              
100             # code to be sent to nodejs
101 0           my $src = "var filter = $code;\n\n".
102             "console.log(JSON.stringify(filter(".
103             $json->encode($data).")))";
104              
105 0           my ($jsh, $jsfn) = File::Temp::tempfile();
106 0           print $jsh $src;
107 0 0         close($jsh) or die "Can't write JS code to file $jsfn: $!";
108              
109 0           my $out = IPC::System::Options::readpipe($nodejs_path, $jsfn);
110 0           $json->decode($out);
111 0           };
112             }
113              
114             1;
115             # ABSTRACT: Generate filter code
116              
117             __END__