File Coverage

blib/lib/Test/ISBN.pm
Criterion Covered Total %
statement 41 51 80.3
branch 12 18 66.6
condition 3 3 100.0
subroutine 9 10 90.0
pod 4 4 100.0
total 69 86 80.2


line stmt bran cond sub pod time code
1 2     2   71225 use 5.008;
  2         9  
2              
3             package Test::ISBN;
4 2     2   11 use strict;
  2         4  
  2         49  
5              
6 2     2   1150 use Business::ISBN 2.0;
  2         101138  
  2         158  
7 2     2   21 use Exporter qw(import);
  2         4  
  2         60  
8 2     2   10 use Test::Builder;
  2         4  
  2         1072  
9              
10             my $Test = Test::Builder->new();
11              
12             our $VERSION = '2.042';
13             our @EXPORT = qw(isbn_ok isbn_group_ok isbn_country_ok isbn_publisher_ok);
14              
15             =encoding utf8
16              
17             =head1 NAME
18              
19             Test::ISBN - Check International Standard Book Numbers
20              
21             =head1 SYNOPSIS
22              
23             use Test::More tests => 1;
24             use Test::ISBN;
25              
26             isbn_ok( $isbn );
27              
28             =head1 DESCRIPTION
29              
30             This is the 2.x version of Test::ISBN and works with Business::ISBN 2.x.
31              
32             =head2 Functions
33              
34             =over 4
35              
36             =item isbn_ok( STRING | ISBN )
37              
38             Ok is the STRING is a valid ISBN, in any format that Business::ISBN
39             accepts. This function only checks the checksum. The publisher and
40             country codes might be invalid even though the checksum is valid.
41              
42             If the first argument is an ISBN object, it checks that object.
43              
44             =cut
45              
46             sub isbn_ok {
47 11     11 1 28195 my $isbn = shift;
48              
49 11         25 my $object = _get_object( $isbn );
50              
51 11 50       2519 my $string = ref $isbn ? eval { $isbn->as_string } : $isbn;
  0         0  
52              
53 11   100     42 my $ok = ref $object &&
54             ( $object->is_valid_checksum( $string ) eq Business::ISBN::GOOD_ISBN );
55 11 100       333 $Test->diag( "The argument [$string] is not a valid ISBN" ) unless $ok;
56              
57 11         850 $Test->ok( $ok );
58             }
59              
60             =item isbn_group_ok( STRING | ISBN, COUNTRY )
61              
62             Ok is the STRING is a valid ISBN and its country code is the same as
63             COUNTRY. If the first argument is an ISBN object, it checks that
64             object.
65              
66             =cut
67              
68             sub isbn_group_ok {
69 2     2 1 5697 my $isbn = shift;
70 2         5 my $country = shift;
71              
72 2         5 my $object = _get_object( $isbn );
73              
74 2 50       512 my $string = ref $isbn ? eval { $isbn->as_string } : $isbn;
  0         0  
75              
76 2 100       10 unless( $object->is_valid ) {
    50          
77 0         0 $Test->diag("ISBN [$string] is not valid"),
78             $Test->ok(0);
79             }
80 0         0 elsif( $object->group_code eq $country ) {
81 1         13 $Test->ok(1);
82             }
83             else {
84 1         21 $Test->diag("ISBN [$string] group code is wrong\n",
85             "\tExpected [$country]\n",
86             "\tGot [" . $object->group_code . "]\n" );
87 1         254 $Test->ok(0);
88             }
89              
90             }
91              
92             =item isbn_country_ok( STRING | ISBN, COUNTRY )
93              
94             Deprecated. Use isbn_group_ok. This is still exported, though.
95              
96             For now it warns and redirects to isbn_group_ok.
97              
98             If the first argument is an ISBN object, it checks that
99             object.
100              
101             =cut
102              
103             sub isbn_country_ok {
104 0     0 1 0 $Test->diag( "isbn_country_ok is deprecated. Use isbn_group_ok" );
105              
106 0         0 &isbn_group_ok;
107             }
108              
109             =item isbn_publisher_ok( STRING | ISBN, PUBLISHER )
110              
111             Ok is the STRING is a valid ISBN and its publisher
112             code is the same as PUBLISHER.
113              
114             If the first argument is an ISBN object, it checks that
115             object.
116              
117             =cut
118              
119             sub isbn_publisher_ok {
120 2     2 1 3503 my $isbn = shift;
121 2         4 my $publisher = shift;
122              
123 2         6 my $object = _get_object( $isbn );
124              
125 2 50       508 my $string = ref $isbn ? eval { $isbn->as_string } : $isbn;
  0         0  
126              
127 2 100       16 unless( $object->is_valid ) {
    50          
128 0         0 $Test->diag("ISBN [$string] is not valid"),
129             $Test->ok(0);
130             }
131 0         0 elsif( $object->publisher_code eq $publisher ) {
132 1         17 $Test->ok(1);
133             }
134             else {
135 1         12 $Test->diag("ISBN [$string] publisher code is wrong\n",
136             "\tExpected [$publisher]\n",
137             "\tGot [" . $object->publisher_code . "]\n" );
138 1         254 $Test->ok(0);
139             }
140             }
141              
142             sub _get_object {
143 15     15   28 my( $arg ) = @_;
144              
145 15         22 my $object = do {
146 15 50       23 if( eval { $arg->isa( 'Business::ISBN' ) } ) { $arg }
  15         100  
  0         0  
147 15         93 else { Business::ISBN->new( $arg ) }
148             };
149             }
150              
151             =back
152              
153             =head1 SOURCE AVAILABILITY
154              
155             This source is in GitHub:
156              
157             https://github.com/briandfoy/test-isbn
158              
159             =head1 AUTHOR
160              
161             brian d foy, C<< >>
162              
163             =head1 COPYRIGHT AND LICENSE
164              
165             Copyright © 2002-2021, brian d foy . All rights reserved.
166              
167             This program is free software; you can redistribute it and/or modify
168             it under the terms of the Artistic License 2.0.
169              
170             =cut
171              
172              
173             1;