File Coverage

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