File Coverage

blib/lib/Data/Sah/Coerce/perl/To_duration/From_str/human.pm
Criterion Covered Total %
statement 20 21 95.2
branch 3 4 75.0
condition 3 6 50.0
subroutine 5 5 100.0
pod 0 2 0.0
total 31 38 81.5


line stmt bran cond sub pod time code
1             package Data::Sah::Coerce::perl::To_duration::From_str::human;
2              
3 2     2   36 use 5.010001;
  2         8  
4 2     2   10 use strict;
  2         6  
  2         41  
5 2     2   9 use warnings;
  2         4  
  2         652  
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 duration from human notation string (e.g. "2 days 10 hours", "3h")',
16             might_fail => 1, # we feed most string to Time::Duration::Parse::AsHash which might croak when fed invalid string
17             prio => 60,
18             };
19             }
20              
21             sub coerce {
22 3     3 0 15 my %args = @_;
23              
24 3         10 my $dt = $args{data_term};
25 3   50     15 my $coerce_to = $args{coerce_to} // 'float(secs)';
26              
27 3         7 my $res = {};
28              
29 3         18 $res->{expr_match} = join(
30             " && ",
31             "!ref($dt)",
32             "$dt =~ /\\d.*[a-z]/",
33             );
34              
35 3   50     20 $res->{modules}{"Time::Duration::Parse::AsHash"} //= 0;
36 3 100       12 if ($coerce_to eq 'float(secs)') {
    50          
37             # approximation
38 2         10 $res->{expr_coerce} = qq(do { my \$p; eval { \$p = Time::Duration::Parse::AsHash::parse_duration($dt) }; my \$err = \$@; if (\$err) { \$err =~ s/ at .+//s; ["Invalid duration: \$err"] } else { [undef, (\$p->{years}||0) * 365.25*86400 + (\$p->{months}||0) * 30.4375*86400 + (\$p->{weeks}||0) * 7*86400 + (\$p->{days}||0) * 86400 + (\$p->{hours}||0) * 3600 + (\$p->{minutes}||0) * 60 + (\$p->{seconds}||0)] } });
39             } elsif ($coerce_to eq 'DateTime::Duration') {
40 1   50     7 $res->{modules}{"DateTime::Duration"} //= 0;
41 1         5 $res->{expr_coerce} = qq(do { my \$p; eval { \$p = Time::Duration::Parse::AsHash::parse_duration($dt) }; my \$err = \$@; if (\$err) { \$err =~ s/ at .+//s; ["Invalid duration: \$err"] } else { [undef, DateTime::Duration->new( (years=>\$p->{years}) x !!defined(\$p->{years}), (months=>\$p->{months}) x !!defined(\$p->{months}), (weeks=>\$p->{weeks}) x !!defined(\$p->{weeks}), (days=>\$p->{days}) x !!defined(\$p->{days}), (hours=>\$p->{hours}) x !!defined(\$p->{hours}), (minutes=>\$p->{minutes}) x !!defined(\$p->{minutes}), (seconds=>\$p->{seconds}) x !!defined(\$p->{seconds}))] } });
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         11 $res;
48             }
49              
50             1;
51             # ABSTRACT: Coerce duration from human notation string (e.g. "2 days 10 hours", "3h")
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::human - Coerce duration from human notation string (e.g. "2 days 10 hours", "3h")
62              
63             =head1 VERSION
64              
65             This document describes version 0.052 of Data::Sah::Coerce::perl::To_duration::From_str::human (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::human"]}]
72              
73             =head1 DESCRIPTION
74              
75             The human notation is parsed using L<Time::Duration::Parse::AsHash>.
76              
77             =for Pod::Coverage ^(meta|coerce)$
78              
79             =head1 HOMEPAGE
80              
81             Please visit the project's homepage at L<https://metacpan.org/release/Data-Sah-Coerce>.
82              
83             =head1 SOURCE
84              
85             Source repository is at L<https://github.com/perlancar/perl-Data-Sah-Coerce>.
86              
87             =head1 AUTHOR
88              
89             perlancar <perlancar@cpan.org>
90              
91             =head1 CONTRIBUTING
92              
93              
94             To contribute, you can send patches by email/via RT, or send pull requests on
95             GitHub.
96              
97             Most of the time, you don't need to build the distribution yourself. You can
98             simply modify the code, then test via:
99              
100             % prove -l
101              
102             If you want to build the distribution (e.g. to try to install it locally on your
103             system), you can install L<Dist::Zilla>,
104             L<Dist::Zilla::PluginBundle::Author::PERLANCAR>, and sometimes one or two other
105             Dist::Zilla plugin and/or Pod::Weaver::Plugin. Any additional steps required
106             beyond that are considered a bug and can be reported to me.
107              
108             =head1 COPYRIGHT AND LICENSE
109              
110             This software is copyright (c) 2021, 2020, 2019, 2018, 2017, 2016 by perlancar <perlancar@cpan.org>.
111              
112             This is free software; you can redistribute it and/or modify it under
113             the same terms as the Perl 5 programming language system itself.
114              
115             =head1 BUGS
116              
117             Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Sah-Coerce>
118              
119             When submitting a bug or request, please include a test-file or a
120             patch to an existing test-file that illustrates the bug or desired
121             feature.
122              
123             =cut