File Coverage

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