File Coverage

blib/lib/Data/Sah/Coerce/perl/To_duration/From_str/iso8601.pm
Criterion Covered Total %
statement 20 21 95.2
branch 3 4 75.0
condition 2 4 50.0
subroutine 5 5 100.0
pod 0 2 0.0
total 30 36 83.3


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