File Coverage

blib/lib/Data/Sah/Coerce/perl/To_timeofday/From_str/hms.pm
Criterion Covered Total %
statement 19 22 86.3
branch 3 6 50.0
condition 1 4 25.0
subroutine 5 5 100.0
pod 0 2 0.0
total 28 39 71.7


line stmt bran cond sub pod time code
1             package Data::Sah::Coerce::perl::To_timeofday::From_str::hms;
2              
3 1     1   17 use 5.010001;
  1         3  
4 1     1   5 use strict;
  1         2  
  1         28  
5 1     1   5 use warnings;
  1         2  
  1         357  
6              
7             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
8             our $DATE = '2021-10-18'; # DATE
9             our $DIST = 'Data-Sah-Coerce'; # DIST
10             our $VERSION = '0.050'; # VERSION
11              
12             sub meta {
13             +{
14 2     2 0 8 v => 4,
15             summary => 'Coerce timeofday from string in the form of hh:mm:ss',
16             might_fail => 1, # we match any (hh:mm:ss string, so the conversion might fail on invalid value)
17             prio => 50,
18             };
19             }
20              
21             sub coerce {
22 2     2 0 7 my %args = @_;
23              
24 2         3 my $dt = $args{data_term};
25 2   50     6 my $coerce_to = $args{coerce_to} // 'str_hms';
26              
27 2         3 my $res = {};
28              
29 2         7 $res->{expr_match} = join(
30             " && ",
31             "$dt =~ /\\A([0-9]{1,2}):([0-9]{1,2})(?::([0-9]{1,2})(\.[0-9]{1,9})?)?\\z/",
32             );
33              
34 2         3 my $code_check = qq(if (\$1 > 23) { ["Invalid hour '\$1', must be between 0-23"] } elsif (\$2 > 59) { ["Invalid minute '\$2', must be between 0-59"] } elsif (defined \$3 && \$3 > 59) { ["Invalid second '\$3', must be between 0-59"] });
35              
36 2 100       7 if ($coerce_to eq 'float') {
    50          
    0          
37 1         3 $res->{expr_coerce} = qq(do { $code_check else { [undef, \$1*3600 + \$2*60 + (defined \$3 ? \$3 : 0) + (defined \$4 ? \$4 : 0)] } });
38             } elsif ($coerce_to eq 'str_hms') {
39 1         3 $res->{expr_coerce} = qq(do { $code_check else { [undef, defined(\$4) && \$4 > 0 ? sprintf("%02d:%02d:%s%.11g", \$1, \$2, (!defined(\$3) || \$3 < 10 ? "0":""), (defined \$3 ? \$3:0)+\$4) : sprintf("%02d:%02d:%02d", \$1, \$2, (defined \$3 ? \$3 : 0))] } });
40             } elsif ($coerce_to eq 'Date::TimeOfDay') {
41 0   0     0 $res->{modules}{"Date::TimeOfDay"} //= 0.002;
42 0         0 $res->{expr_coerce} = qq([undef, Date::TimeOfDay->new(hour=>\$1, minute=>\$2, second=>(defined \$3 ? \$3 : 0), nanosecond=>(defined \$4 ? \$4*1e9 : 0))]);
43             } else {
44 0         0 die "BUG: Unknown coerce_to value '$coerce_to', ".
45             "please use float, str_hms, or Date::TimeOfDay";
46             }
47              
48 2         7 $res;
49             }
50              
51             1;
52             # ABSTRACT: Coerce timeofday from string in the form of hh:mm:ss
53              
54             __END__
55              
56             =pod
57              
58             =encoding UTF-8
59              
60             =head1 NAME
61              
62             Data::Sah::Coerce::perl::To_timeofday::From_str::hms - Coerce timeofday from string in the form of hh:mm:ss
63              
64             =head1 VERSION
65              
66             This document describes version 0.050 of Data::Sah::Coerce::perl::To_timeofday::From_str::hms (from Perl distribution Data-Sah-Coerce), released on 2021-10-18.
67              
68             =head1 SYNOPSIS
69              
70             To use in a Sah schema:
71              
72             ["timeofday",{"x.perl.coerce_rules"=>["From_str::hms"]}]
73              
74             =head1 DESCRIPTION
75              
76             Timeofday can be coerced into one of: C<float> (seconds after midnight, e.g.
77             86399 is 23:59:59), C<str_hms> (string in the form of hh:mm:ss), or
78             C<Date::TimeOfDay> (an instance of L<Date::TimeOfDay> class).
79              
80             =for Pod::Coverage ^(meta|coerce)$
81              
82             =head1 HOMEPAGE
83              
84             Please visit the project's homepage at L<https://metacpan.org/release/Data-Sah-Coerce>.
85              
86             =head1 SOURCE
87              
88             Source repository is at L<https://github.com/perlancar/perl-Data-Sah-Coerce>.
89              
90             =head1 AUTHOR
91              
92             perlancar <perlancar@cpan.org>
93              
94             =head1 CONTRIBUTING
95              
96              
97             To contribute, you can send patches by email/via RT, or send pull requests on
98             GitHub.
99              
100             Most of the time, you don't need to build the distribution yourself. You can
101             simply modify the code, then test via:
102              
103             % prove -l
104              
105             If you want to build the distribution (e.g. to try to install it locally on your
106             system), you can install L<Dist::Zilla>,
107             L<Dist::Zilla::PluginBundle::Author::PERLANCAR>, and sometimes one or two other
108             Dist::Zilla plugin and/or Pod::Weaver::Plugin. Any additional steps required
109             beyond that are considered a bug and can be reported to me.
110              
111             =head1 COPYRIGHT AND LICENSE
112              
113             This software is copyright (c) 2021, 2020, 2019, 2018, 2017, 2016 by perlancar <perlancar@cpan.org>.
114              
115             This is free software; you can redistribute it and/or modify it under
116             the same terms as the Perl 5 programming language system itself.
117              
118             =head1 BUGS
119              
120             Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Sah-Coerce>
121              
122             When submitting a bug or request, please include a test-file or a
123             patch to an existing test-file that illustrates the bug or desired
124             feature.
125              
126             =cut