File Coverage

blib/lib/Data/Sah/Coerce/perl/str/str_normalize_cryptoexchange_account.pm
Criterion Covered Total %
statement 16 16 100.0
branch n/a
condition 1 2 50.0
subroutine 5 5 100.0
pod 0 2 0.0
total 22 25 88.0


line stmt bran cond sub pod time code
1             package Data::Sah::Coerce::perl::str::str_normalize_cryptoexchange_account;
2              
3             our $DATE = '2019-07-26'; # DATE
4             our $VERSION = '0.007'; # VERSION
5              
6 1     1   2162 use 5.010001;
  1         4  
7 1     1   6 use strict;
  1         2  
  1         20  
8 1     1   5 use warnings;
  1         2  
  1         180  
9              
10             sub meta {
11             +{
12 1     1 0 46 v => 4,
13             might_fail => 1,
14             prio => 50,
15             };
16             }
17              
18             sub coerce {
19 1     1 0 19 my %args = @_;
20              
21 1         2 my $dt = $args{data_term};
22              
23 1         3 my $res = {};
24              
25 1         3 $res->{expr_match} = "!ref($dt)";
26 1   50     9 $res->{modules}{"CryptoExchange::Catalog"} //= 0;
27 1         6 $res->{expr_coerce} = join(
28             "",
29             "do { my (\$xch, \$acc); $dt =~ m!(.+)/(.+)! and (\$xch, \$acc) = (\$1, \$2) or (\$xch, \$acc) = ($dt, 'default'); ",
30             "if (\$acc !~ /\\A[A-Za-z0-9_-]+\\z/) { [qq(Invalid account syntax (\$acc), please only use letters/numbers/underscores/dashes)] } ",
31             "elsif (length \$acc > 64) { [qq(Account name too long (\$acc), please do not exceed 64 characters)] } ",
32             "else { my \$cat = CryptoExchange::Catalog->new; my \@data = \$cat->all_data; ",
33             " my \$lc = lc(\$xch); my \$rec; for (\@data) { if (defined(\$_->{code}) && \$lc eq lc(\$_->{code}) || \$lc eq lc(\$_->{name}) || \$lc eq \$_->{safename}) { \$rec = \$_; last } } ",
34             " if (!\$rec) { ['Unknown cryptoexchange code/name/safename: ' . \$lc] } else { [undef, qq(\$rec->{safename}/\$acc)] } ",
35             "} }",
36             );
37              
38 1         4 $res;
39             }
40              
41             1;
42             # ABSTRACT: Normalize cryptoexchange account
43              
44             __END__
45              
46             =pod
47              
48             =encoding UTF-8
49              
50             =head1 NAME
51              
52             Data::Sah::Coerce::perl::str::str_normalize_cryptoexchange_account - Normalize cryptoexchange account
53              
54             =head1 VERSION
55              
56             This document describes version 0.007 of Data::Sah::Coerce::perl::str::str_normalize_cryptoexchange_account (from Perl distribution Data-Sah-CoerceBundle-App-cryp), released on 2019-07-26.
57              
58             =head1 DESCRIPTION
59              
60             Cryptoexchange account is of the following format:
61              
62             cryptoexchange/account
63              
64             where C<cryptoexchange> is the name/code/safename of cryptoexchange as listed in
65             L<CryptoExchange::Catalog>. This coercion rule normalizes cryptoexchange into
66             safename and will die if name/code/safename is not listed in the catalog module.
67              
68             C<account> must also be [A-Za-z0-9_-]+ only and not exceed 64 characters in
69             length.
70              
71             The rule is not enabled by default. You can enable it in a schema using e.g.:
72              
73             ["str", "x.perl.coerce_rules"=>["str_normalize_cryptocurrency_account"]]
74              
75             =for Pod::Coverage ^(meta|coerce)$
76              
77             =head1 HOMEPAGE
78              
79             Please visit the project's homepage at L<https://metacpan.org/release/Data-Sah-CoerceBundle-App-cryp>.
80              
81             =head1 SOURCE
82              
83             Source repository is at L<https://github.com/perlancar/perl-Data-Sah-CoerceBundle-App-cryp>.
84              
85             =head1 BUGS
86              
87             Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Sah-CoerceBundle-App-cryp>
88              
89             When submitting a bug or request, please include a test-file or a
90             patch to an existing test-file that illustrates the bug or desired
91             feature.
92              
93             =head1 AUTHOR
94              
95             perlancar <perlancar@cpan.org>
96              
97             =head1 COPYRIGHT AND LICENSE
98              
99             This software is copyright (c) 2019, 2018 by perlancar@cpan.org.
100              
101             This is free software; you can redistribute it and/or modify it under
102             the same terms as the Perl 5 programming language system itself.
103              
104             =cut