File Coverage

blib/lib/Data/Sah/Compiler/human/TH/array.pm
Criterion Covered Total %
statement 65 65 100.0
branch 4 6 66.6
condition 4 12 33.3
subroutine 9 9 100.0
pod 0 4 0.0
total 82 96 85.4


line stmt bran cond sub pod time code
1              
2             use 5.010;
3 8     8   134 use strict;
  8         24  
4 8     8   45 use warnings;
  8         12  
  8         134  
5 8     8   31 #use Log::Any '$log';
  8         10  
  8         249  
6              
7             use Mo qw(build default);
8 8     8   40 use Role::Tiny::With;
  8         23  
  8         36  
9 8     8   2251  
  8         15  
  8         5534  
10             extends 'Data::Sah::Compiler::human::TH';
11             with 'Data::Sah::Compiler::human::TH::Comparable';
12             with 'Data::Sah::Compiler::human::TH::HasElems';
13             with 'Data::Sah::Type::array';
14              
15             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
16             our $DATE = '2022-09-30'; # DATE
17             our $DIST = 'Data-Sah'; # DIST
18             our $VERSION = '0.913'; # VERSION
19              
20             my ($self, $cd) = @_;
21             my $c = $self->compiler;
22 407     407 0 748  
23 407         1189 $c->add_ccl($cd, {
24             fmt => ["array", "arrays"],
25 407         2797 type => 'noun',
26             });
27             }
28              
29             my ($self, $cd) = @_;
30             my $c = $self->compiler;
31             my $cv = $cd->{cl_value};
32 6     6 0 18  
33 6         18 my %iargs = %{$cd->{args}};
34 6         26 $iargs{outer_cd} = $cd;
35             $iargs{schema} = $cv;
36 6         10 $iargs{schema_is_normalized} = 0;
  6         88  
37 6         23 $iargs{cache} = $cd->{args}{cache};
38 6         11 my $icd = $c->compile(%iargs);
39 6         10  
40 6         11 $c->add_ccl($cd, {
41 6         32 type => 'list',
42             fmt => 'each array subscript %(modal_verb)s be',
43             items => [
44             $icd->{ccls},
45             ],
46             vals => [],
47             });
48 6         36 }
49              
50             my ($self, $cd) = @_;
51             my $c = $self->compiler;
52             my $cv = $cd->{cl_value};
53              
54 33     33 0 66 my %iargs = %{$cd->{args}};
55 33         90 $iargs{outer_cd} = $cd;
56 33         135 $iargs{schema} = $cv;
57             $iargs{schema_is_normalized} = 0;
58 33         54 $iargs{cache} = $cd->{args}{cache};
  33         450  
59 33         106 my $icd = $c->compile(%iargs);
60 33         64  
61 33         47 # can we say 'array of INOUNS', e.g. 'array of integers'?
62 33         72 if (@{$icd->{ccls}} == 1) {
63 33         250 my $c0 = $icd->{ccls}[0];
64             if ($c0->{type} eq 'noun' && ref($c0->{text}) eq 'ARRAY' &&
65             @{$c0->{text}} > 1 && @{$cd->{ccls}} &&
66 33 100       88 $cd->{ccls}[0]{type} eq 'noun') {
  33         112  
67 26         46 for (ref($cd->{ccls}[0]{text}) eq 'ARRAY' ?
68 26 50 33     117 @{$cd->{ccls}[0]{text}} : ($cd->{ccls}[0]{text})) {
      33        
      33        
      33        
69 26         70 my $fmt = $c->_xlt($cd, '%s of %s');
  26         105  
70             $_ = sprintf $fmt, $_, $c0->{text}[1];
71 26 50       58 }
72 26         68 return;
73 52         108 }
74 52         183 }
75              
76 26         267 # nope, we can't
77             $c->add_ccl($cd, {
78             type => 'list',
79             fmt => 'each array element %(modal_verb)s be',
80             items => [
81             $icd->{ccls},
82             ],
83             vals => [],
84             });
85             }
86 7         36  
87             my ($self, $cd) = @_;
88             my $c = $self->compiler;
89             my $cv = $cd->{cl_value};
90              
91             for my $i (0..@$cv-1) {
92 32     32 0 72 local $cd->{spath} = [@{$cd->{spath}}, $i];
93 32         95 my $v = $cv->[$i];
94 32         135 my %iargs = %{$cd->{args}};
95             $iargs{outer_cd} = $cd;
96 32         92 $iargs{schema} = $v;
97 62         96 $iargs{schema_is_normalized} = 0;
  62         179  
98 62         111 $iargs{cache} = $cd->{args}{cache};
99 62         73 my $icd = $c->compile(%iargs);
  62         776  
100 62         197 $c->add_ccl($cd, {
101 62         110 type => 'list',
102 62         97 fmt => '%s %(modal_verb)s be',
103 62         116 vals => [
104 62         366 $c->_ordinate($cd, $i+1, $c->_xlt($cd, "element")),
105             ],
106             items => [ $icd->{ccls} ],
107             });
108             }
109             }
110              
111 62         230 1;
112             # ABSTRACT: human's type handler for type "array"
113              
114              
115             =pod
116              
117             =encoding UTF-8
118              
119             =head1 NAME
120              
121             Data::Sah::Compiler::human::TH::array - human's type handler for type "array"
122              
123             =head1 VERSION
124              
125             This document describes version 0.913 of Data::Sah::Compiler::human::TH::array (from Perl distribution Data-Sah), released on 2022-09-30.
126              
127             =for Pod::Coverage ^(clause_.+|superclause_.+)$
128              
129             =head1 HOMEPAGE
130              
131             Please visit the project's homepage at L<https://metacpan.org/release/Data-Sah>.
132              
133             =head1 SOURCE
134              
135             Source repository is at L<https://github.com/perlancar/perl-Data-Sah>.
136              
137             =head1 AUTHOR
138              
139             perlancar <perlancar@cpan.org>
140              
141             =head1 CONTRIBUTING
142              
143              
144             To contribute, you can send patches by email/via RT, or send pull requests on
145             GitHub.
146              
147             Most of the time, you don't need to build the distribution yourself. You can
148             simply modify the code, then test via:
149              
150             % prove -l
151              
152             If you want to build the distribution (e.g. to try to install it locally on your
153             system), you can install L<Dist::Zilla>,
154             L<Dist::Zilla::PluginBundle::Author::PERLANCAR>,
155             L<Pod::Weaver::PluginBundle::Author::PERLANCAR>, and sometimes one or two other
156             Dist::Zilla- and/or Pod::Weaver plugins. Any additional steps required beyond
157             that are considered a bug and can be reported to me.
158              
159             =head1 COPYRIGHT AND LICENSE
160              
161             This software is copyright (c) 2022, 2021, 2020, 2019, 2018, 2017, 2016, 2015, 2014, 2013, 2012 by perlancar <perlancar@cpan.org>.
162              
163             This is free software; you can redistribute it and/or modify it under
164             the same terms as the Perl 5 programming language system itself.
165              
166             =head1 BUGS
167              
168             Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Sah>
169              
170             When submitting a bug or request, please include a test-file or a
171             patch to an existing test-file that illustrates the bug or desired
172             feature.
173              
174             =cut