File Coverage

blib/lib/Data/Sah/Compiler/perl/TH/timeofday.pm
Criterion Covered Total %
statement 35 79 44.3
branch 8 70 11.4
condition 1 2 50.0
subroutine 8 9 88.8
pod 0 3 0.0
total 52 163 31.9


line stmt bran cond sub pod time code
1              
2             use 5.010;
3 1     1   15 use strict;
  1         3  
4 1     1   4 use warnings;
  1         1  
  1         17  
5 1     1   3 #use Log::Any '$log';
  1         1  
  1         33  
6              
7             use Mo qw(build default);
8 1     1   5 use Role::Tiny::With;
  1         2  
  1         4  
9 1     1   247 use Scalar::Util qw(blessed looks_like_number);
  1         2  
  1         49  
10 1     1   6  
  1         1  
  1         913  
11             extends 'Data::Sah::Compiler::perl::TH';
12             with 'Data::Sah::Type::timeofday';
13              
14             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
15             our $DATE = '2022-08-20'; # DATE
16             our $DIST = 'Data-Sah'; # DIST
17             our $VERSION = '0.912'; # VERSION
18              
19             my ($self, $cd) = @_;
20             my $c = $self->compiler;
21 8     8 0 13 my $dt = $cd->{data_term};
22 8         22  
23 8         34 $cd->{coerce_to} = $cd->{nschema}[1]{"x.perl.coerce_to"} // 'str_hms';
24              
25 8   50     27 my $coerce_to = $cd->{coerce_to};
26              
27 8         22 if ($coerce_to eq 'float') {
28             $cd->{_ccl_check_type} = "!ref($dt) && $dt >= 0 && $dt < 86400";
29 8 50       19 } elsif ($coerce_to eq 'str_hms') {
    50          
    0          
30 0         0 $cd->{_ccl_check_type} = "$dt =~ /\\A([0-9]{1,2}):([0-9]{1,2}):([0-9]{1,2})(?:\\.[0-9]{1,9})?\\z/";
31             } elsif ($coerce_to eq 'Date::TimeOfDay') {
32 8         24 $c->add_runtime_module($cd, 'Scalar::Util');
33             $cd->{_ccl_check_type} = "Scalar::Util::blessed($dt) && $dt\->isa('Date::TimeOfDay')";
34 0         0 } else {
35 0         0 die "BUG: Unknown coerce_to value '$coerce_to', use either ".
36             "float, str_hms, or Date::TimeOfDay";
37 0         0 }
38             }
39              
40             my ($self, $which, $cd) = @_;
41             my $c = $self->compiler;
42             my $cv = $cd->{cl_value};
43 0     0 0 0 my $ct = $cd->{cl_term};
44 0         0 my $dt = $cd->{data_term};
45 0         0  
46 0         0 if ($cd->{cl_is_expr}) {
47 0         0 # i'm lazy, technical debt
48             $c->_die($cd, "timeofday's comparison with expression not yet supported");
49 0 0       0 }
50              
51 0         0 my $coerce_to = $cd->{coerce_to};
52             if ($coerce_to eq 'float') {
53             if ($which eq 'is') {
54 0         0 $c->add_ccl($cd, "$dt == $ct");
55 0 0       0 } elsif ($which eq 'in') {
    0          
    0          
56 0 0       0 $c->add_runtime_module($cd, 'List::Util');
    0          
57 0         0 $c->add_ccl($cd, "List::Util::first(sub{$dt == \$_}, $ct)");
58             }
59 0         0 } elsif ($coerce_to eq 'str_hms') {
60 0         0 if ($which eq 'is') {
61             $c->add_ccl($cd, "$dt eq $ct");
62             } elsif ($which eq 'in') {
63 0 0       0 $c->add_runtime_module($cd, 'List::Util');
    0          
64 0         0 $c->add_ccl($cd, "List::Util::first(sub{$dt eq \$_}, $ct)");
65             }
66 0         0 } elsif ($coerce_to eq 'Date::TimeOfDay') {
67 0         0 if ($which eq 'is') {
68             $c->add_ccl($cd, "Date::TimeOfDay->compare($dt, $ct)==0");
69             } elsif ($which eq 'in') {
70 0 0       0 $c->add_runtime_module($cd, 'List::Util');
    0          
71 0         0 $c->add_ccl($cd, "List::Util::first(sub{Date::TimeOfDay->compare($dt, \$_)==0}, $ct)");
72             }
73 0         0 }
74 0         0 }
75              
76             my ($self, $which, $cd) = @_;
77             my $c = $self->compiler;
78             my $cv = $cd->{cl_value};
79             my $ct = $cd->{cl_term};
80 4     4 0 8 my $dt = $cd->{data_term};
81 4         11  
82 4         16 if ($cd->{cl_is_expr}) {
83 4         6 # i'm lazy, technical debt
84 4         7 $c->_die($cd, "timeofday's comparison with expression not yet supported");
85             }
86 4 50       6  
87             my $coerce_to = $cd->{coerce_to};
88 0         0 if ($coerce_to eq 'float') {
89             if ($which eq 'min') {
90             $c->add_ccl($cd, "$dt >= $cv");
91 4         8 } elsif ($which eq 'xmin') {
92 4 50       10 $c->add_ccl($cd, "$dt > $cv");
    50          
    0          
93 0 0       0 } elsif ($which eq 'max') {
    0          
    0          
    0          
    0          
    0          
94 0         0 $c->add_ccl($cd, "$dt <= $cv");
95             } elsif ($which eq 'xmax') {
96 0         0 $c->add_ccl($cd, "$dt < $cv");
97             } elsif ($which eq 'between') {
98 0         0 $c->add_ccl($cd, "$dt >= $cv->[0] && $dt <= $cv->[1]");
99             } elsif ($which eq 'xbetween') {
100 0         0 $c->add_ccl($cd, "$dt > $cv->[0] && $dt < $cv->[1]");
101             }
102 0         0 } elsif ($coerce_to eq 'str_hms') {
103             if ($which eq 'min') {
104 0         0 $c->add_ccl($cd, "$dt ge '$cv'");
105             } elsif ($which eq 'xmin') {
106             $c->add_ccl($cd, "$dt gt '$cv'");
107 4 100       9 } elsif ($which eq 'max') {
    50          
    0          
    0          
    0          
    0          
108 3         11 $c->add_ccl($cd, "$dt le '$cv'");
109             } elsif ($which eq 'xmax') {
110 1         4 $c->add_ccl($cd, "$dt lt '$cv'");
111             } elsif ($which eq 'between') {
112 0           $c->add_ccl($cd, "$dt ge '$cv->[0]' && $dt le '$cv->[1]'");
113             } elsif ($which eq 'xbetween') {
114 0           $c->add_ccl($cd, "$dt gt '$cv->[0]' && $dt lt '$cv->[1]'");
115             }
116 0           } elsif ($coerce_to eq 'Date::TimeOfDay') {
117             if ($which eq 'min') {
118 0           $c->add_ccl($cd, "Date::TimeOfDay->compare($dt, $cv) >= 0");
119             } elsif ($which eq 'xmin') {
120             $c->add_ccl($cd, "Date::TimeOfDay->compare($dt, $cv) > 0");
121 0 0         } elsif ($which eq 'max') {
    0          
    0          
    0          
    0          
    0          
122 0           $c->add_ccl($cd, "Date::TimeOfDay->compare($dt, $cv) <= 0");
123             } elsif ($which eq 'xmax') {
124 0           $c->add_ccl($cd, "Date::TimeOfDay->compare($dt, $cv) < 0");
125             } elsif ($which eq 'between') {
126 0           $c->add_ccl($cd, "Date::TimeOfDay->compare($dt, $cv\->[0]) >= 0 && Date::TimeOfDay->compare($dt, $ct\->[1]) <= 0");
127             } elsif ($which eq 'xbetween') {
128 0           $c->add_ccl($cd, "Date::TimeOfDay->compare($dt, $cv\->[0]) > 0 && Date::TimeOfDay->compare($dt, $ct\->[1]) < 0");
129             }
130 0           }
131             }
132 0            
133             1;
134             # ABSTRACT: perl's type handler for type "timeofday"
135              
136              
137             =pod
138              
139             =encoding UTF-8
140              
141             =head1 NAME
142              
143             Data::Sah::Compiler::perl::TH::timeofday - perl's type handler for type "timeofday"
144              
145             =head1 VERSION
146              
147             This document describes version 0.912 of Data::Sah::Compiler::perl::TH::timeofday (from Perl distribution Data-Sah), released on 2022-08-20.
148              
149             =head1 DESCRIPTION
150              
151             The C<timeofday> type can be represented using one of three choices: C<float>
152             (seconds after midnight), C<str_hms> (string in the form of hh:mm:ss), or
153             C<Date::TimeOfDay> (instance of L<Date::TimeOfDay> class). This choice can be
154             specified in the schema using clause attribute C<x.perl.coerce_to>, e.g.:
155              
156             ["date", "x.perl.coerce_to"=>"float"]
157             ["date", "x.perl.coerce_to"=>"str_hms"]
158             ["date", "x.perl.coerce_to"=>"Date::TimeOfDay"]
159              
160             =for Pod::Coverage ^(clause_.+|superclause_.+|handle_.+|before_.+|after_.+)$
161              
162             =head1 COMPILATION DATA KEYS
163              
164             =over
165              
166             =item * B<coerce_to> => str
167              
168             By default will be set to C<str_hms>.
169              
170             =back
171              
172             =head1 HOMEPAGE
173              
174             Please visit the project's homepage at L<https://metacpan.org/release/Data-Sah>.
175              
176             =head1 SOURCE
177              
178             Source repository is at L<https://github.com/perlancar/perl-Data-Sah>.
179              
180             =head1 AUTHOR
181              
182             perlancar <perlancar@cpan.org>
183              
184             =head1 CONTRIBUTING
185              
186              
187             To contribute, you can send patches by email/via RT, or send pull requests on
188             GitHub.
189              
190             Most of the time, you don't need to build the distribution yourself. You can
191             simply modify the code, then test via:
192              
193             % prove -l
194              
195             If you want to build the distribution (e.g. to try to install it locally on your
196             system), you can install L<Dist::Zilla>,
197             L<Dist::Zilla::PluginBundle::Author::PERLANCAR>,
198             L<Pod::Weaver::PluginBundle::Author::PERLANCAR>, and sometimes one or two other
199             Dist::Zilla- and/or Pod::Weaver plugins. Any additional steps required beyond
200             that are considered a bug and can be reported to me.
201              
202             =head1 COPYRIGHT AND LICENSE
203              
204             This software is copyright (c) 2022, 2021, 2020, 2019, 2018, 2017, 2016, 2015, 2014, 2013, 2012 by perlancar <perlancar@cpan.org>.
205              
206             This is free software; you can redistribute it and/or modify it under
207             the same terms as the Perl 5 programming language system itself.
208              
209             =head1 BUGS
210              
211             Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Sah>
212              
213             When submitting a bug or request, please include a test-file or a
214             patch to an existing test-file that illustrates the bug or desired
215             feature.
216              
217             =cut