File Coverage

blib/lib/Data/Sah/Coerce/perl/To_str/From_str/to_isbn10.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::To_str::From_str::to_isbn10;
2              
3             # AUTHOR
4             our $DATE = '2019-11-29'; # DATE
5             our $DIST = 'Sah-Schemas-ISBN'; # DIST
6             our $VERSION = '0.007'; # VERSION
7              
8 1     1   1675 use 5.010001;
  1         3  
9 1     1   5 use strict;
  1         1  
  1         18  
10 1     1   3 use warnings;
  1         2  
  1         164  
11              
12             sub meta {
13             +{
14 1     1 0 12 v => 4,
15             summary => 'Check and format ISBN 10 number from string',
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         2 $res->{modules}{"Algorithm::CheckDigits"} = 0;
30 1         1 $res->{modules}{"Algorithm::CheckDigits::M10_004"} = 0;
31 1         2 $res->{modules}{"Algorithm::CheckDigits::M11_001"} = 0;
32 1         4 $res->{expr_coerce} = join(
33             "",
34             "do { my \$digits = $dt; \$digits =~ s/[^0-9Xx]//g; \$digits = uc \$digits; ",
35             "my \$res; ",
36             "{ ",
37             " if (length \$digits == 13) { if (substr(\$digits, 0, 3) ne '978') { \$res = ['Can only convert from ISBN 13 with 978 prefix']; last } \$digits = Algorithm::CheckDigits::CheckDigits('ISBN')->complete(substr(\$digits, 3, 9)); \$res = [undef, \$digits]; last } ", # convert from ISBN 13
38             " if (length \$digits != 10) { \$res = ['ISBN 10 must have 10 digits']; last } ",
39             " unless (Algorithm::CheckDigits::CheckDigits('ISBN')->is_valid(\$digits)) { \$res = ['Invalid checksum digit']; last } ",
40             " \$res = [undef, \$digits]; ",
41             "} ",
42             "\$res }",
43             );
44              
45 1         3 $res;
46             }
47              
48             1;
49             # ABSTRACT: Check and format ISBN 10 number from string
50              
51             __END__
52              
53             =pod
54              
55             =encoding UTF-8
56              
57             =head1 NAME
58              
59             Data::Sah::Coerce::perl::To_str::From_str::to_isbn10 - Check and format ISBN 10 number from string
60              
61             =head1 VERSION
62              
63             This document describes version 0.007 of Data::Sah::Coerce::perl::To_str::From_str::to_isbn10 (from Perl distribution Sah-Schemas-ISBN), released on 2019-11-29.
64              
65             =head1 SYNOPSIS
66              
67             To use in a Sah schema:
68              
69             ["str",{"x.perl.coerce_rules"=>["From_str::to_isbn10"]}]
70              
71             =for Pod::Coverage ^(meta|coerce)$
72              
73             =head1 HOMEPAGE
74              
75             Please visit the project's homepage at L<https://metacpan.org/release/Sah-Schemas-ISBN>.
76              
77             =head1 SOURCE
78              
79             Source repository is at L<https://github.com/perlancar/perl-Sah-Schemas-ISBN>.
80              
81             =head1 BUGS
82              
83             Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Sah-Schemas-ISBN>
84              
85             When submitting a bug or request, please include a test-file or a
86             patch to an existing test-file that illustrates the bug or desired
87             feature.
88              
89             =head1 AUTHOR
90              
91             perlancar <perlancar@cpan.org>
92              
93             =head1 COPYRIGHT AND LICENSE
94              
95             This software is copyright (c) 2019, 2018 by perlancar@cpan.org.
96              
97             This is free software; you can redistribute it and/or modify it under
98             the same terms as the Perl 5 programming language system itself.
99              
100             =cut