File Coverage

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