File Coverage

blib/lib/Data/Sah/FilterCommon.pm
Criterion Covered Total %
statement 37 38 97.3
branch 5 6 83.3
condition 1 2 50.0
subroutine 4 4 100.0
pod 1 1 100.0
total 48 51 94.1


line stmt bran cond sub pod time code
1             package Data::Sah::FilterCommon;
2              
3 4     4   423703 use 5.010001;
  4         16  
4 4     4   27 use strict 'subs', 'vars';
  4         5  
  4         149  
5 4     4   25 use warnings;
  4         7  
  4         2726  
6              
7             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
8             our $DATE = '2024-07-17'; # DATE
9             our $DIST = 'Data-Sah-Filter'; # DIST
10             our $VERSION = '0.025'; # VERSION
11              
12             our %SPEC;
13              
14             our %common_args = (
15             filter_names => {
16             schema => ['array*', of=>'str*'],
17             req => 1,
18             },
19             );
20              
21             our %gen_filter_args = (
22             %common_args,
23             return_type => {
24             schema => ['str*', in=>['val', 'str_errmsg+val']],
25             default => 'val',
26             },
27             );
28              
29             $SPEC{get_filter_rules} = {
30             v => 1.1,
31             summary => 'Get filter rules from filter rule modules',
32             args => {
33             %common_args,
34             compiler => {
35             schema => 'str*',
36             req => 1,
37             },
38             data_term => {
39             schema => 'str*',
40             req => 1,
41             },
42             },
43             };
44             sub get_filter_rules {
45 7     7 1 27 my %args = @_;
46              
47 7         9 my $compiler = $args{compiler};
48 7         9 my $dt = $args{data_term};
49 7         12 my $prefix = "Data::Sah::Filter::$compiler\::";
50              
51 7         8 my @rules;
52 7         7 for my $entry (@{ $args{filter_names} }) {
  7         12  
53 9         10 my ($filter_name, $filter_gen_args);
54 9 100       18 if (ref $entry eq 'ARRAY') {
55 4         5 $filter_name = $entry->[0];
56 4         4 $filter_gen_args = $entry->[1];
57             } else {
58 5 100       35 if ($entry =~ /(.*?)=(.*)/) {
59 1         3 $filter_name = $1;
60 1         4 $filter_gen_args = {split /,/, $2};
61             } else {
62 4         7 $filter_name = $entry;
63 4         5 $filter_gen_args = undef;
64             }
65             }
66              
67 9         12 my $mod = $prefix . $filter_name;
68 9         40 (my $mod_pm = "$mod.pm") =~ s!::!/!g;
69 9         1017 require $mod_pm;
70 9         12 my $filter_meta = &{"$mod\::meta"};
  9         40  
71 9   50     20 my $filter_v = ($filter_meta->{v} // 1);
72 9 50       16 if ($filter_v != 1) {
73 0         0 die "Only filter module following metadata version 1 is ".
74             "supported, this filter module '$mod' follows metadata version ".
75             "$filter_v and cannot be used";
76             }
77 9         14 my $rule = &{"$mod\::filter"}(
  9         25  
78             data_term => $dt,
79             (args => $filter_gen_args) x !!$filter_gen_args,
80             );
81 9         15 $rule->{name} = $filter_name;
82 9         10 $rule->{meta} = $filter_meta;
83 9         20 push @rules, $rule;
84             }
85              
86 7         18 \@rules;
87             }
88              
89             1;
90             # ABSTRACT: Common stuffs for Data::Sah::Filter and Data::Sah::FilterJS
91              
92             __END__