File Coverage

blib/lib/Data/Sah/Coerce/perl/To_datenotime/From_str/iso8601.pm
Criterion Covered Total %
statement 22 23 95.6
branch 5 6 83.3
condition 4 8 50.0
subroutine 5 5 100.0
pod 0 2 0.0
total 36 44 81.8


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