File Coverage

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