File Coverage

blib/lib/Data/Sah/FilterCommon.pm
Criterion Covered Total %
statement 30 31 96.7
branch 5 6 83.3
condition 1 2 50.0
subroutine 4 4 100.0
pod 1 1 100.0
total 41 44 93.1


line stmt bran cond sub pod time code
1             package Data::Sah::FilterCommon;
2              
3 1     1   37 use 5.010001;
  1         3  
4 1     1   5 use strict 'subs', 'vars';
  1         2  
  1         26  
5 1     1   4 use warnings;
  1         2  
  1         490  
6              
7             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
8             our $DATE = '2023-04-25'; # DATE
9             our $DIST = 'Data-Sah-Filter'; # DIST
10             our $VERSION = '0.020'; # 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 6     6 1 20 my %args = @_;
46              
47 6         12 my $compiler = $args{compiler};
48 6         10 my $dt = $args{data_term};
49 6         16 my $prefix = "Data::Sah::Filter::$compiler\::";
50              
51 6         9 my @rules;
52 6         8 for my $entry (@{ $args{filter_names} }) {
  6         13  
53 8 100       25 my $filter_name = ref $entry eq 'ARRAY' ? $entry->[0] : $entry;
54 8 100       18 my $filter_gen_args = ref $entry eq 'ARRAY' ? $entry->[1] : undef;
55              
56 8         15 my $mod = $prefix . $filter_name;
57 8         45 (my $mod_pm = "$mod.pm") =~ s!::!/!g;
58 8         1007 require $mod_pm;
59 8         14 my $filter_meta = &{"$mod\::meta"};
  8         39  
60 8   50     23 my $filter_v = ($filter_meta->{v} // 1);
61 8 50       17 if ($filter_v != 1) {
62 0         0 die "Only filter module following metadata version 1 is ".
63             "supported, this filter module '$mod' follows metadata version ".
64             "$filter_v and cannot be used";
65             }
66 8         17 my $rule = &{"$mod\::filter"}(
  8         30  
67             data_term => $dt,
68             (args => $filter_gen_args) x !!$filter_gen_args,
69             );
70 8         16 $rule->{name} = $filter_name;
71 8         11 $rule->{meta} = $filter_meta;
72 8         24 push @rules, $rule;
73             }
74              
75 6         18 \@rules;
76             }
77              
78             1;
79             # ABSTRACT: Common stuffs for Data::Sah::Filter and Data::Sah::FilterJS
80              
81             __END__