File Coverage

blib/lib/Data/Sah/Coerce/perl/str/str_to_isbn.pm
Criterion Covered Total %
statement 18 18 100.0
branch n/a
condition n/a
subroutine 5 5 100.0
pod 0 2 0.0
total 23 25 92.0


line stmt bran cond sub pod time code
1             package Data::Sah::Coerce::perl::str::str_to_isbn;
2              
3             our $DATE = '2019-07-25'; # DATE
4             our $VERSION = '0.006'; # VERSION
5              
6 1     1   1715 use 5.010001;
  1         3  
7 1     1   4 use strict;
  1         1  
  1         17  
8 1     1   3 use warnings;
  1         2  
  1         173  
9              
10             sub meta {
11             +{
12 1     1 0 11 v => 4,
13             might_fail => 1,
14             prio => 50,
15             };
16             }
17              
18             sub coerce {
19 1     1 0 15 my %args = @_;
20              
21 1         2 my $dt = $args{data_term};
22              
23 1         2 my $res = {};
24              
25 1         3 $res->{expr_match} = "!ref($dt)";
26 1         2 $res->{modules}{"Algorithm::CheckDigits"} = 0;
27 1         1 $res->{modules}{"Algorithm::CheckDigits::M10_004"} = 0;
28 1         2 $res->{modules}{"Algorithm::CheckDigits::M11_001"} = 0;
29 1         4 $res->{expr_coerce} = join(
30             "",
31             "do { my \$digits = $dt; \$digits =~ s/[^0-9Xx]//g; \$digits = uc \$digits; ",
32             "my \$res; ",
33             "{ ",
34             " if (length \$digits == 10) { unless (Algorithm::CheckDigits::CheckDigits('ISBN')->is_valid(\$digits)) { \$res = ['Invalid ISBN 10 checksum digit']; last } \$res = [undef, \$digits] } ",
35             " elsif (length \$digits == 13) { unless (Algorithm::CheckDigits::CheckDigits('ean') ->is_valid(\$digits)) { \$res = ['Invalid ISBN 13 checksum digit']; last } \$res = [undef, \$digits] } ",
36             " else { \$res = ['ISBN must be 10 or 13 digits']; last } ",
37             "} ",
38             "\$res }",
39             );
40              
41 1         3 $res;
42             }
43              
44             1;
45             # ABSTRACT: Check and format ISBN 10 or ISBN 13 number from string
46              
47             __END__
48              
49             =pod
50              
51             =encoding UTF-8
52              
53             =head1 NAME
54              
55             Data::Sah::Coerce::perl::str::str_to_isbn - Check and format ISBN 10 or ISBN 13 number from string
56              
57             =head1 VERSION
58              
59             This document describes version 0.006 of Data::Sah::Coerce::perl::str::str_to_isbn (from Perl distribution Sah-Schemas-ISBN), released on 2019-07-25.
60              
61             =head1 DESCRIPTION
62              
63             The rule is not enabled by default. You can enable it in a schema using e.g.:
64              
65             ["str", "x.perl.coerce_rules"=>["str_to_isbn"]]
66              
67             =for Pod::Coverage ^(meta|coerce)$
68              
69             =head1 HOMEPAGE
70              
71             Please visit the project's homepage at L<https://metacpan.org/release/Sah-Schemas-ISBN>.
72              
73             =head1 SOURCE
74              
75             Source repository is at L<https://github.com/perlancar/perl-Sah-Schemas-ISBN>.
76              
77             =head1 BUGS
78              
79             Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Sah-Schemas-ISBN>
80              
81             When submitting a bug or request, please include a test-file or a
82             patch to an existing test-file that illustrates the bug or desired
83             feature.
84              
85             =head1 AUTHOR
86              
87             perlancar <perlancar@cpan.org>
88              
89             =head1 COPYRIGHT AND LICENSE
90              
91             This software is copyright (c) 2019, 2018 by perlancar@cpan.org.
92              
93             This is free software; you can redistribute it and/or modify it under
94             the same terms as the Perl 5 programming language system itself.
95              
96             =cut