File Coverage

blib/lib/Data/Sah/Coerce/perl/duration/str_alami_id.pm
Criterion Covered Total %
statement 17 17 100.0
branch 3 4 75.0
condition 2 4 50.0
subroutine 5 5 100.0
pod 0 2 0.0
total 27 32 84.3


line stmt bran cond sub pod time code
1             package Data::Sah::Coerce::perl::duration::str_alami_id;
2              
3             our $DATE = '2019-07-26'; # DATE
4             our $VERSION = '0.005'; # VERSION
5              
6 1     1   432888 use 5.010001;
  1         4  
7 1     1   4 use strict;
  1         2  
  1         16  
8 1     1   4 use warnings;
  1         2  
  1         185  
9              
10             sub meta {
11             +{
12 2     2 0 7553 v => 4,
13             might_fail => 1,
14             prio => 60, # a bit lower than normal
15             precludes => [qr/\Astr_alami(_.+)?\z/, 'str_human'],
16             };
17             }
18              
19             sub coerce {
20 2     2 0 20 my %args = @_;
21              
22 2         4 my $dt = $args{data_term};
23 2   50     7 my $coerce_to = $args{coerce_to} // 'float(secs)';
24              
25 2         3 my $res = {};
26              
27 2         5 $res->{expr_match} = "!ref($dt)";
28 2   50     12 $res->{modules}{"DateTime::Format::Alami::ID"} //= 0;
29 2 50       11 $res->{expr_coerce} = join(
    100          
30             "",
31             "do { my \$res; eval { \$res = DateTime::Format::Alami::ID->new->parse_datetime_duration($dt, {format=>'combined'}) }; ",
32             ($coerce_to eq 'float(secs)' ? "if (\$@) { ['Invalid duration syntax'] } else { [undef, \$res->{seconds}] } " :
33             $coerce_to eq 'DateTime::Duration' ? "if (\$@) { ['Invalid duration syntax'] } else { [undef, \$res->{Duration}] } " :
34             (die "BUG: Unknown coerce_to '$coerce_to'")),
35             "}",
36             );
37 2         5 $res;
38             }
39              
40             1;
41             # ABSTRACT: Coerce duration from string parsed by DateTime::Format::Alami::ID
42              
43             __END__
44              
45             =pod
46              
47             =encoding UTF-8
48              
49             =head1 NAME
50              
51             Data::Sah::Coerce::perl::duration::str_alami_id - Coerce duration from string parsed by DateTime::Format::Alami::ID
52              
53             =head1 VERSION
54              
55             This document describes version 0.005 of Data::Sah::Coerce::perl::duration::str_alami_id (from Perl distribution Data-Sah-Coerce-perl-duration-str_alami_id), released on 2019-07-26.
56              
57             =head1 DESCRIPTION
58              
59             The rule is not enabled by default. You can enable it in a schema using e.g.:
60              
61             ["duration", "x.perl.coerce_rules"=>["str_alami_id"]]
62              
63             =for Pod::Coverage ^(meta|coerce)$
64              
65             =head1 HOMEPAGE
66              
67             Please visit the project's homepage at L<https://metacpan.org/release/Data-Sah-Coerce-perl-duration-str_alami_id>.
68              
69             =head1 SOURCE
70              
71             Source repository is at L<https://github.com/perlancar/perl-Data-Sah-Coerce-perl-duration-str_alami_id>.
72              
73             =head1 BUGS
74              
75             Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Sah-Coerce-perl-duration-str_alami_id>
76              
77             When submitting a bug or request, please include a test-file or a
78             patch to an existing test-file that illustrates the bug or desired
79             feature.
80              
81             =head1 AUTHOR
82              
83             perlancar <perlancar@cpan.org>
84              
85             =head1 COPYRIGHT AND LICENSE
86              
87             This software is copyright (c) 2019, 2018, 2016 by perlancar@cpan.org.
88              
89             This is free software; you can redistribute it and/or modify it under
90             the same terms as the Perl 5 programming language system itself.
91              
92             =cut