File Coverage

blib/lib/Data/Sah/Coerce/perl/To_date/From_str/flexible.pm
Criterion Covered Total %
statement 17 17 100.0
branch 5 6 83.3
condition 3 4 75.0
subroutine 5 5 100.0
pod 0 2 0.0
total 30 34 88.2


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