File Coverage

blib/lib/Data/Sah/Coerce/perl/date/str_alami.pm
Criterion Covered Total %
statement 21 21 100.0
branch 5 6 83.3
condition 4 6 66.6
subroutine 6 6 100.0
pod 0 2 0.0
total 36 41 87.8


line stmt bran cond sub pod time code
1             package Data::Sah::Coerce::perl::date::str_alami;
2              
3             our $DATE = '2019-07-26'; # DATE
4             our $VERSION = '0.010'; # VERSION
5              
6 1     1   20679 use 5.010001;
  1         4  
7 1     1   6 use strict;
  1         2  
  1         19  
8 1     1   5 use warnings;
  1         2  
  1         24  
9              
10 1     1   452 use Data::Dmp;
  1         1797  
  1         278  
11              
12             # TMP
13             our $time_zone;
14              
15             sub meta {
16             +{
17 4     4 0 484300 v => 4,
18             might_fail => 1,
19             prio => 60, # a bit lower than normal
20             precludes => [qr/\Astr_alami(_.+)?\z/, 'str_natural'],
21             };
22             }
23              
24             sub coerce {
25 4     4 0 51 my %args = @_;
26              
27 4         12 my $dt = $args{data_term};
28 4   100     22 my $coerce_to = $args{coerce_to} // 'float(epoch)';
29              
30 4         10 my $res = {};
31              
32 4         14 $res->{expr_match} = "!ref($dt)";
33 4   50     33 $res->{modules}{"DateTime::Format::Alami::EN"} //= 0;
34 4   50     23 $res->{modules}{"DateTime::Format::Alami::ID"} //= 0;
35 4 50       22 $res->{expr_coerce} = join(
    100          
    100          
36             "",
37             "do { my \$datetime; eval { \$datetime = ((\$ENV{LANG} // '') =~ /id_ID/ ? 'DateTime::Format::Alami::ID' : 'DateTime::Format::Alami::EN')->new->parse_datetime($dt, {_time_zone => ".dmp($time_zone)."}) }; my \$err = \$@; ",
38             ($coerce_to eq 'float(epoch)' ? "if (\$err) { \$err =~ s/ at .+//s; [\$err] } else { [undef, \$datetime->epoch] } " :
39             $coerce_to eq 'Time::Moment' ? "if (\$err) { \$err =~ s/ at .+//s; [\$err] } else { [undef, Time::Moment->from_object(\$datetime)] } " :
40             $coerce_to eq 'DateTime' ? "if (\$err) { \$err =~ s/ at .+//s; [\$err] } else { [undef, \$datetime] } " :
41             (die "BUG: Unknown coerce_to '$coerce_to'")),
42             "}",
43             );
44              
45 4         162 $res;
46             }
47              
48             1;
49             # ABSTRACT: Coerce date from string parsed by DateTime::Format::Alami
50              
51             __END__
52              
53             =pod
54              
55             =encoding UTF-8
56              
57             =head1 NAME
58              
59             Data::Sah::Coerce::perl::date::str_alami - Coerce date from string parsed by DateTime::Format::Alami
60              
61             =head1 VERSION
62              
63             This document describes version 0.010 of Data::Sah::Coerce::perl::date::str_alami (from Perl distribution Data-Sah-Coerce-perl-date-str_alami), 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_alami"]]
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_alami>.
76              
77             =head1 SOURCE
78              
79             Source repository is at L<https://github.com/perlancar/perl-Data-Sah-Coerce-perl-date-str_alami>.
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_alami>
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, 2017, 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