File Coverage

blib/lib/Data/Sah/Compiler/human/TH.pm
Criterion Covered Total %
statement 30 36 83.3
branch 1 2 50.0
condition 2 6 33.3
subroutine 19 24 79.1
pod 0 19 0.0
total 52 87 59.7


line stmt bran cond sub pod time code
1              
2             use 5.010;
3 24     24   9934 use strict;
  24         113  
4 24     24   103 use warnings;
  24         50  
  24         416  
5 24     24   96 #use Log::Any '$log';
  24         47  
  24         661  
6              
7             use Mo qw(build default);
8 24     24   125 use Role::Tiny::With;
  24         56  
  24         120  
9 24     24   5512  
  24         53  
  24         12287  
10             extends 'Data::Sah::Compiler::TH';
11              
12             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
13             our $DATE = '2022-08-20'; # DATE
14             our $DIST = 'Data-Sah'; # DIST
15             our $VERSION = '0.912'; # VERSION
16              
17              
18 1175     1175 0 5376 my ($self, $cd) = @_;
19             my $c = $self->compiler;
20              
21 0     0 0 0 # give the class name
22 0         0 my $pkg = ref($self);
23             $pkg =~ s/^Data::Sah::Compiler::human::TH:://;
24              
25 0         0 $c->add_ccl($cd, {type=>'noun', fmt=>$pkg});
26 0         0 }
27              
28 0         0 # not translated
29              
30              
31              
32             # ignored
33       27 0    
34       27 0    
35       27 0   # handled in after_all_clauses
36       0 0    
37       27 0    
38       0 0   # default implementation
39       0 0    
40             my ($self, $cd) = @_;
41       6 0   my $c = $self->compiler;
42       0 0    
43             $c->add_ccl($cd, {expr=>1,
44             fmt => 'default value %s'});
45             }
46       54 0    
47             my ($self, $cd) = @_;
48             $cd->{CLAUSE_DO_MULTI} = 0;
49             }
50       486 0    
51       54 0   my ($self, $cd) = @_;
52             $cd->{CLAUSE_DO_MULTI} = 0;
53             }
54              
55             my ($self, $cd) = @_;
56 90     90 0 150 $cd->{CLAUSE_DO_MULTI} = 0;
57 90         278 }
58              
59 90         574 my ($self, $cd) = @_;
60             my $c = $self->compiler;
61             my $cv = $cd->{cl_value};
62              
63             my ($cond, $then, $else) = @$cv;
64 81     81 0 192  
65 81         157 unless (!ref($cond) && ref($then) eq 'ARRAY' && !$else) {
66             $c->_die($cd, "Sorry, for 'if' clause, I currently can only handle COND=str (expr), THEN=array (schema), and no ELSE");
67             }
68              
69 192     192 0 340 # temporary. currently it sucks because it plasters schema and expr directly
70 192         361 $c->add_ccl($cd, {
71             expr => 0,
72             vals => [$cond, $then],
73             fmt => 'if the expression %s is true then the schema %s must be followed',
74 8     8 0 14 });
75 8         15 }
76              
77             1;
78             # ABSTRACT: Base class for human type handlers
79 13     13 0 22  
80 13         33  
81 13         48 =pod
82              
83 13         24 =encoding UTF-8
84              
85 13 50 33     65 =head1 NAME
      33        
86 0         0  
87             Data::Sah::Compiler::human::TH - Base class for human type handlers
88              
89             =head1 VERSION
90 13         53  
91             This document describes version 0.912 of Data::Sah::Compiler::human::TH (from Perl distribution Data-Sah), released on 2022-08-20.
92              
93             =for Pod::Coverage ^(name|compiler|clause_.+|handle_.+|before_.+|after_.+)$
94              
95             =head1 HOMEPAGE
96              
97             Please visit the project's homepage at L<https://metacpan.org/release/Data-Sah>.
98              
99             =head1 SOURCE
100              
101             Source repository is at L<https://github.com/perlancar/perl-Data-Sah>.
102              
103             =head1 AUTHOR
104              
105             perlancar <perlancar@cpan.org>
106              
107             =head1 CONTRIBUTING
108              
109              
110             To contribute, you can send patches by email/via RT, or send pull requests on
111             GitHub.
112              
113             Most of the time, you don't need to build the distribution yourself. You can
114             simply modify the code, then test via:
115              
116             % prove -l
117              
118             If you want to build the distribution (e.g. to try to install it locally on your
119             system), you can install L<Dist::Zilla>,
120             L<Dist::Zilla::PluginBundle::Author::PERLANCAR>,
121             L<Pod::Weaver::PluginBundle::Author::PERLANCAR>, and sometimes one or two other
122             Dist::Zilla- and/or Pod::Weaver plugins. Any additional steps required beyond
123             that are considered a bug and can be reported to me.
124              
125             =head1 COPYRIGHT AND LICENSE
126              
127             This software is copyright (c) 2022, 2021, 2020, 2019, 2018, 2017, 2016, 2015, 2014, 2013, 2012 by perlancar <perlancar@cpan.org>.
128              
129             This is free software; you can redistribute it and/or modify it under
130             the same terms as the Perl 5 programming language system itself.
131              
132             =head1 BUGS
133              
134             Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Sah>
135              
136             When submitting a bug or request, please include a test-file or a
137             patch to an existing test-file that illustrates the bug or desired
138             feature.
139              
140             =cut