File Coverage

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