File Coverage

blib/lib/Data/Sah/Coerce/perl/To_str/From_str/ToFiatOrCryptoCurrencyCode.pm
Criterion Covered Total %
statement 17 17 100.0
branch n/a
condition 2 4 50.0
subroutine 5 5 100.0
pod 0 2 0.0
total 24 28 85.7


line stmt bran cond sub pod time code
1             package Data::Sah::Coerce::perl::To_str::From_str::ToFiatOrCryptoCurrencyCode;
2              
3             # AUTHOR
4             our $DATE = '2019-11-28'; # DATE
5             our $DIST = 'Data-Sah-Coerce-perl-To_str-From_str-ToFiatOrCryptoCurrencyCode'; # DIST
6             our $VERSION = '0.004'; # VERSION
7              
8 1     1   1815 use 5.010001;
  1         4  
9 1     1   5 use strict;
  1         2  
  1         18  
10 1     1   4 use warnings;
  1         2  
  1         191  
11              
12             sub meta {
13             +{
14 1     1 0 13 v => 4,
15             summary => 'Coerce string containing fiat/cryptocurrency code/name/safename to uppercase code',
16             might_fail => 1,
17             prio => 50,
18             };
19             }
20              
21             sub coerce {
22 1     1 0 14 my %args = @_;
23              
24 1         2 my $dt = $args{data_term};
25              
26 1         2 my $res = {};
27              
28 1         3 $res->{expr_match} = "!ref($dt)";
29 1   50     9 $res->{modules}{"CryptoCurrency::Catalog"} //= 0;
30 1   50     5 $res->{modules}{"Locale::Codes::Currency_Codes"} //= 0;
31 1         6 $res->{expr_coerce} = join(
32             "",
33             "do { my \$res; ",
34             " my \$uc = uc($dt); ",
35             " if (\$Locale::Codes::Data{currency}{code2id}{alpha}{\$uc}) { \$res = [undef, \$uc]; goto RETURN_RES } ",
36             " my \$cat = CryptoCurrency::Catalog->new; ",
37             " my \$rec; eval { \$rec = \$cat->by_code($dt) }; if (\$@) { eval { \$rec = \$cat->by_name($dt) } } if (\$@) { eval { \$rec = \$cat->by_safename($dt) } } ",
38             " if (\$@) { \$res = ['Unknown fiat/cryptocurrency code/name/safename: ' . $dt] } else { \$res = [undef, \$rec->{code}] } ",
39             " RETURN_RES: \$res; ",
40             "}",
41             );
42              
43 1         3 $res;
44             }
45              
46             1;
47             # ABSTRACT: Coerce string containing fiat/cryptocurrency code/name/safename to uppercase code
48              
49             __END__
50              
51             =pod
52              
53             =encoding UTF-8
54              
55             =head1 NAME
56              
57             Data::Sah::Coerce::perl::To_str::From_str::ToFiatOrCryptoCurrencyCode - Coerce string containing fiat/cryptocurrency code/name/safename to uppercase code
58              
59             =head1 VERSION
60              
61             This document describes version 0.004 of Data::Sah::Coerce::perl::To_str::From_str::ToFiatOrCryptoCurrencyCode (from Perl distribution Data-Sah-Coerce-perl-To_str-From_str-ToFiatOrCryptoCurrencyCode), released on 2019-11-28.
62              
63             =head1 SYNOPSIS
64              
65             To use in a Sah schema:
66              
67             ["str",{"x.perl.coerce_rules"=>["From_str::ToFiatOrCryptoCurrencyCode"]}]
68              
69             =for Pod::Coverage ^(meta|coerce)$
70              
71             =head1 HOMEPAGE
72              
73             Please visit the project's homepage at L<https://metacpan.org/release/Data-Sah-Coerce-perl-To_str-From_str-ToFiatOrCryptoCurrencyCode>.
74              
75             =head1 SOURCE
76              
77             Source repository is at L<https://github.com/perlancar/perl-Data-Sah-Coerce-perl-To_str-From_str_ToFiatOrCryptoCurrencyCode>.
78              
79             =head1 BUGS
80              
81             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_str-From_str-ToFiatOrCryptoCurrencyCode>
82              
83             When submitting a bug or request, please include a test-file or a
84             patch to an existing test-file that illustrates the bug or desired
85             feature.
86              
87             =head1 AUTHOR
88              
89             perlancar <perlancar@cpan.org>
90              
91             =head1 COPYRIGHT AND LICENSE
92              
93             This software is copyright (c) 2019, 2018 by perlancar@cpan.org.
94              
95             This is free software; you can redistribute it and/or modify it under
96             the same terms as the Perl 5 programming language system itself.
97              
98             =cut