File Coverage

blib/lib/Data/Sah/Compiler/human/TH/any.pm
Criterion Covered Total %
statement 49 49 100.0
branch 7 8 87.5
condition 2 3 66.6
subroutine 7 7 100.0
pod 0 2 0.0
total 65 69 94.2


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