File Coverage

blib/lib/Data/Sah/Coerce/perl/date/str_natural.pm
Criterion Covered Total %
statement 20 20 100.0
branch 5 6 83.3
condition 3 4 75.0
subroutine 6 6 100.0
pod 0 2 0.0
total 34 38 89.4


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