File Coverage

blib/lib/Business/ISBN.pm
Criterion Covered Total %
statement 180 211 85.3
branch 46 66 69.7
condition 13 24 54.1
subroutine 61 72 84.7
pod 31 31 100.0
total 331 404 81.9


line stmt bran cond sub pod time code
1 12     12   2870038 use 5.008;
  12         40  
2              
3             package Business::ISBN;
4 12     12   52 use strict;
  12         15  
  12         604  
5              
6             =encoding utf8
7              
8             =head1 NAME
9              
10             Business::ISBN - work with International Standard Book Numbers
11              
12             =head1 SYNOPSIS
13              
14             use Business::ISBN;
15              
16             # 10 digit ISBNs
17             $isbn10 = Business::ISBN->new('1565922573');
18             $isbn10 = Business::ISBN->new('1-56592-257-3');
19              
20             # 13 digit ISBNs
21             $isbn13 = Business::ISBN->new('978-0-596-52724-2');
22              
23             # convert
24             $isbn10 = $isbn13->as_isbn10; # for the 978 prefixes
25              
26             $isbn13 = $isbn10->as_isbn13;
27              
28             # maybe you don't care what it is as long as everything works
29             $isbn = Business::ISBN->new( $ARGV[0] );
30              
31             #print the ISBN with hyphens at usual positions
32             print $isbn->as_string;
33              
34             #print the ISBN with hyphens at specified positions.
35             #this not does affect the default positions
36             print $isbn->as_string([]);
37              
38             #print the group code or publisher code
39             print $isbn->group_code;
40              
41             print $isbn->publisher_code;
42              
43             #check to see if the ISBN is valid
44             $isbn->is_valid;
45              
46             #fix the ISBN checksum. BEWARE: the error might not be
47             #in the checksum!
48             $isbn->fix_checksum;
49              
50             # create an EAN13 barcode in PNG format
51             $isbn->png_barcode;
52              
53             =head1 DESCRIPTION
54              
55             This modules handles International Standard Book Numbers, including
56             ISBN-10 and ISBN-13.
57              
58             The data come from L, which means you can update
59             the data separately from the code. Also, you can use L
60             with whatever F you like if you have updated data. See
61             that module for details.
62              
63             =cut
64              
65             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
66             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
67             # # Boring set up stuff
68 12         64 use subs qw(
69             _common_format
70             INVALID_GROUP_CODE
71             INVALID_PUBLISHER_CODE
72             BAD_CHECKSUM
73             GOOD_ISBN
74             BAD_ISBN
75             ARTICLE_CODE_OUT_OF_RANGE
76 12     12   4383 );
  12         2917  
77 12         782 use vars qw(
78             @EXPORT_OK
79             %EXPORT_TAGS
80             %group_data
81             $MAX_GROUP_CODE_LENGTH
82 12     12   926 );
  12         19  
83              
84 12     12   77 use Carp qw(carp croak cluck);
  12         18  
  12         810  
85 12     12   52 use Exporter qw(import);
  12         13  
  12         333  
86              
87 12     12   6299 use Business::ISBN::Data 20230322.001; # now a separate module
  12         426308  
  12         2651  
88             # ugh, hack
89             *group_data = *Business::ISBN::country_data;
90             sub _group_data {
91 431117 100   431117   754563 my $isbn_prefix
92             = ref $_[0] eq 'Business::ISBN13'
93             ? $_[0]->prefix
94             : "978";
95 431117         2693696 return $group_data{ $isbn_prefix }->{ $_[1] };
96             }
97              
98 4417     4417   8796 sub _max_group_code_length { $Business::ISBN::MAX_COUNTRY_CODE_LENGTH };
99             sub _max_publisher_code_length {
100 213347     213347   391534 $_[0]->_max_length
101              
102             - $_[0]->_prefix_length # prefix
103              
104             - $_[0]->_group_code_length # group
105             - 1 # article
106             - 1; # checksum
107             };
108              
109             sub _publisher_ranges {
110 213347     213347   218149 my $self = shift;
111 213347         222838 [ @{ $self->_group_data( $self->group_code )->[1] } ];
  213347         315448  
112             }
113              
114             my $debug = $ENV{BUSINESS_ISBN_DEBUG};
115              
116             BEGIN {
117 12     12   73 @EXPORT_OK = qw(
118             INVALID_GROUP_CODE INVALID_PUBLISHER_CODE
119             BAD_CHECKSUM GOOD_ISBN BAD_ISBN ARTICLE_CODE_OUT_OF_RANGE
120             INVALID_PREFIX
121             %ERROR_TEXT
122             normalize_isbn_string
123             valid_isbn_checksum
124             );
125              
126 12         1341 %EXPORT_TAGS = (
127             'all' => \@EXPORT_OK,
128             );
129             };
130              
131             our $VERSION = '3.015_02';
132              
133             sub ARTICLE_CODE_OUT_OF_RANGE () { -5 }
134             sub INVALID_PREFIX () { -4 };
135             sub INVALID_GROUP_CODE () { -2 };
136             sub INVALID_PUBLISHER_CODE () { -3 };
137             sub BAD_CHECKSUM () { -1 };
138             sub GOOD_ISBN () { 1 };
139             sub BAD_ISBN () { 0 };
140              
141             our %ERROR_TEXT = (
142             0 => "Bad ISBN",
143             1 => "Good ISBN",
144             -1 => "Bad ISBN checksum",
145             -2 => "Invalid group code",
146             -3 => "Invalid publisher code",
147             -4 => "Invalid prefix (must be 978 or 979)",
148             -5 => "Incremented article code would be out of range",
149             );
150              
151 12     12   4942 use Business::ISBN10;
  12         32  
  12         505  
152 12     12   4134 use Business::ISBN13;
  12         42  
  12         11609  
153              
154             =head2 Function interface
155              
156             =over 4
157              
158             =item normalize_isbn_string( STRING )
159              
160             This differs from the module default transformation which removes all
161             characters that can't be part of a valid ISBN. This does a targeted
162             transformation that removes fewer types of characters to a string such as
163             C<123456789ABC...XYZ> doesn't accidentally look like the ISBN
164             C<123456789X>.
165              
166             The C function is much more targeted. It strips out
167             the characters that might be there accidentally from a data import or
168             export problem (the main reason this module was created). This include
169             horizontal whitespace within the string, vertical whitespace around the
170             string, and various forms of dashes (e.g. from too-helpful word
171             processors).
172              
173             =over 4
174              
175             =item 1. remove all horizontal space
176              
177             =item 2. remove vertical whitespace from the beginning and end of the string
178              
179             =item 3. remove dash (U+002D) and dash-type characters (U+2010 to U+2015, and U+2212)
180              
181             =back
182              
183             If the result looks like the format of an ISBN-10 or ISBN-13, it returns
184             the string. Otherwise, it returns the empty list.
185              
186             You could use this as a filter to catch bad input since C is too forgiving:
187              
188             use Business::ISBN qw(normalize_isbn_string);
189              
190             while( my $candidate = <> ) {
191             next unless $candidate = normlize_isbn_string($candidate);
192             my $isbn = Business::ISBN->new($candidate);
193             ...
194             }
195              
196             But, 3.016 will do this for you with with the C option:
197              
198             my $isbn = Business::ISBN->new( $candidate, { strict => 1 } );
199              
200             =cut
201              
202             sub normalize_isbn_string {
203 106687     106687 1 186425 my($string) = @_;
204              
205 106687         231712 $string =~ s/ [\t\x{180E}\p{Space_Separator}] //xg;
206 106687         223229 $string =~ s/\A [\x0A-\x0D\x{0085}\x{2028}\x{2029}]+ //x;
207 106687         193918 $string =~ s/ [\x0A-\x0D\x{0085}\x{2028}\x{2029}]+ \z//x;
208              
209 106687         167325 $string =~ s/[\x{2010}-\x{2015}\x{2212}-]//g;
210 106687         171937 $string = uc($string);
211              
212 106687         155619 return $string;
213             }
214              
215             =item valid_isbn_checksum( ISBN10 | ISBN13 )
216              
217             This function is exportable on demand, and works for either 10
218             or 13 character ISBNs).
219              
220             use Business::ISBN qw( valid_isbn_checksum );
221              
222             Returns 1 if the ISBN is a valid ISBN with the right checksum.
223              
224             Returns 0 if the ISBN has valid prefix and publisher codes, but an
225             invalid checksum.
226              
227             Returns undef if the ISBN does not validate for any other reason.
228              
229             =back
230              
231             =cut
232              
233             sub valid_isbn_checksum {
234 4     4 1 1030 my $isbn = shift;
235              
236 4         35 my $obj = Business::ISBN->new( $isbn );
237 4 50       6 return unless defined $obj;
238              
239 4 100       7 return 1 if $obj->is_valid_checksum == GOOD_ISBN;
240 2 50       24 return 0 if $obj->is_valid_checksum == BAD_CHECKSUM;
241 0         0 return;
242             }
243              
244             =head2 Object interface
245              
246             =over 4
247              
248             =item new($isbn)
249              
250             The constructor accepts a scalar representing the ISBN, and an optional
251             options hash reference (new in 3.016).
252              
253             Prior to 3.016, C would fix up it argument by removing anything that
254             wasn't an ASCII digit or an C (see C<_common_format>). However, that can
255             accidentally make a string that isn't an ISBN into one after all the other
256             characters are removed (e.g. C<123456789ABCD...XYZ>).
257              
258             use Business::ISBN;
259              
260             my $isbn = Business::ISBN->new($input_string);
261             unless( defined $isbn ) {
262             ... handle error ...
263             }
264              
265             With 3.016, C can take an optional hash reference as a second
266             argument. Set the hash key C to true to use a more restrictive way
267             to prepare the string. The stricter method uses C,
268             which only strips whitespace and dashes. Any extra letters will remain,
269             causing C to fail:
270              
271             use Business::ISBN 3.016;
272             my $isbn = Business::ISBN->new($input_string, { strict => 1 });
273             unless( defined $isbn ) {
274             ... handle error ...
275             }
276              
277             If that's not good enough for you, 3.016 also lets you use your own code
278             reference to decide how to handle the string-to-ISBN conversion. Use the
279             C option to fix-up the ISBN argument based on your source. The
280             code ref should return the string that the parser should use:
281              
282             use Business::ISBN 3.016;
283              
284             my $code_ref = sub {
285             my $input = shift;
286             my $candidate = ...;
287             return $candidate;
288             };
289              
290             my $isbn = Business::ISBN->new($input_string, { normalizer => $code_ref });
291             unless( defined $isbn ) {
292             ... handle error ...
293             }
294              
295             For example, if you get ISBN strings like C<< <123456789X> >>, you can do
296             something like this:
297              
298             my $code_ref = sub { $_[0] =~ m/<(.*?)>/ ? $1 : () };
299              
300             No matter which method you choose (legacy, strict, or custom), the result,
301             in the case of a valid ISBN, should match C<(?:[0-9]{3})?[0-9]{9}[0-9X]>.
302             If the string does not match, C returns the empty list immediately.
303              
304             The parsing uses L to determine the group code and
305             the publisher code. If these data cannot be determined, it sets C<<
306             $obj->error >> to something other than C. An object is still
307             returned and it is up to the program to check the C<< error >> method for
308             one of five values or one of the C<< error_* >> methods to check for a
309             particular error. The actual values of these symbolic versions are the same
310             as those from previous versions of this module which used literal values:
311              
312              
313             Business::ISBN::INVALID_PUBLISHER_CODE
314             Business::ISBN::INVALID_GROUP_CODE
315             Business::ISBN::BAD_CHECKSUM
316             Business::ISBN::GOOD_ISBN
317             Business::ISBN::BAD_ISBN
318              
319             If you have one of these values and want to turn it into a string, you
320             can use the C<%Business::ISBN::ERROR_TEXT> hash, which is exportable
321             by asking for it explicitly in the import list:
322              
323             use Business::ISBN qw(%ERROR_TEXT);
324              
325             As of version 2.010_01, you can get this text from C<< error_text >>
326             so you don't have to import anything or look in package variables.
327              
328             The string passed as the ISBN need not be valid as long as it superficially
329             looks like one. This allows one to use the C method.
330             Despite the disclaimer in the discussion of that method, the author has
331             found it extremely useful. One should check the validity of the ISBN with
332             C rather than relying on the return value of the constructor.
333             If all one wants to do is check the validity of an ISBN, one can skip the
334             object-oriented interface and use the C function
335             which is exportable on demand.
336              
337             If the constructor decides it cannot create an object, it returns C.
338             It may do this if the string passed as the ISBN cannot be munged to the
339             internal format, meaning that it does not even come close to looking like
340             an ISBN.
341              
342             =cut
343              
344             sub new {
345 213394     213394 1 1619581 my( $class, $input_data, $opts ) = @_;
346              
347             # since this adds a new feature to code that has existed for
348             # decades, I want this to ignore goofy situations that might
349             # be out there. new() never used the third argument, but didn't
350             # forbid it either.
351 213394 100       375500 $opts = {} unless defined $opts;
352 213394 100       448410 $opts->{'strict'} = 0 unless defined $opts->{'strict'};
353              
354 213394 100 66 0   431718 unless( defined $opts->{'normalizer'} and ref $opts->{'normalizer'} eq ref sub {} ) {
355 213391 100       357880 my $method_name = $opts->{'strict'} ? 'normalize_isbn_string' : '_common_format';
356 213391         707506 $opts->{'normalizer'} = $class->can($method_name);
357             }
358              
359 213394         390606 my $common_data = $opts->{'normalizer'}->($input_data);
360 213394 100       370985 $common_data = '' unless defined $common_data;
361              
362 213394 100       731844 return unless $common_data =~ /\A ([0-9]{3})? [0-9]{9} [0-9X] \z/x;
363              
364 213355         449914 my $self = {
365             input_isbn => $input_data,
366             common_data => $common_data
367             };
368              
369 213355         278745 my $isbn = do {
370 213355 100       349951 if( length( $common_data ) == 10 ) {
    50          
371 213305         356637 bless $self, 'Business::ISBN10';
372             }
373             elsif( length( $common_data ) == 13 ) {
374 50         87 bless $self, 'Business::ISBN13';
375             }
376             else {
377 0         0 return BAD_ISBN;
378             }
379             };
380              
381 213355         461307 $self->_init( $common_data );
382 213355         435089 $self->_parse_isbn( $common_data );
383              
384 213355         514748 return $isbn;
385             }
386              
387             =back
388              
389             =head2 Instance methods
390              
391             =over 4
392              
393             =item input_isbn
394              
395             Returns the starting ISBN. Since you may insert hyphens or fix
396             checksums, you might want to see the original data.
397              
398             =cut
399              
400 2     2 1 14 sub input_isbn { $_[0]->{'input_isbn'} }
401              
402             =item common_data
403              
404             Returns the starting ISBN after normalization, which removes anything
405             that isn't a digit or a valid checksum character.
406              
407             =cut
408              
409 1     1 1 5 sub common_data { $_[0]->{'common_data'} }
410              
411              
412             =item isbn
413              
414             Returns the current value of ISBN, even if it has an invalid checksum.
415             This is the raw data so it doesn't have the hyphens. If you want
416             hyphenation, try C.
417              
418             The C method should be the same as C.
419              
420             =cut
421              
422 1284648     1284648 1 2149888 sub isbn { $_[0]->{'isbn'} }
423              
424             =item error
425              
426             Return the error code for the reason the ISBN isn't valid. The return
427             value is a key in %ERROR_TEXT.
428              
429             =cut
430              
431 13 100   13 1 3900 sub error { $_[0]->{'valid'} < 1 and $_[0]->{'valid'} }
432              
433             =item error_is_bad_group
434              
435             =item error_is_bad_publisher
436              
437             =item error_is_article_out_of_range
438              
439             =item error_is_bad_checksum
440              
441             Returns true if the ISBN error is that type.
442              
443             =cut
444              
445             sub error_is_bad_group {
446 2     2 1 26 return $_[0]->error == INVALID_GROUP_CODE;
447             }
448              
449             sub error_is_bad_publisher {
450 1     1 1 3 return $_[0]->error == INVALID_PUBLISHER_CODE;
451             }
452              
453             sub error_is_article_out_of_range {
454 0     0 1 0 return $_[0]->error == ARTICLE_CODE_OUT_OF_RANGE;
455             }
456              
457             sub error_is_bad_checksum {
458 0     0 1 0 return $_[0]->error == BAD_CHECKSUM;
459             }
460              
461             =item error_text
462              
463             Returns a text version of the error text
464              
465             =cut
466              
467 3     3 1 22 sub error_text { $ERROR_TEXT{$_[0]->{'valid'}} }
468              
469             =item is_valid
470              
471             Return true if the ISBN is valid, meaning that it has a valid prefix
472             (for ISBN-13), group code, and publisher code; and its checksum
473             validates.
474              
475             =cut
476              
477 213332     213332 1 779295 sub is_valid { $_[0]->{'valid'} eq GOOD_ISBN }
478              
479             =item type
480              
481             Returns either C or C.
482              
483             =cut
484              
485 3     3 1 38 sub type { $_[0]->{'type'} }
486              
487              
488             =item prefix
489              
490             Returns the prefix for the ISBN. This is currently either 978 or 979
491             for ISBN-13. It returns the empty string (so, a defined value) for
492             ISBN-10.
493              
494             =cut
495              
496 135     135 1 225 sub prefix { $_[0]->{'prefix'} }
497 857826     857826   1534870 sub _prefix_length { length $_[0]->{'prefix'} }
498              
499             =item group_code
500              
501             Returns the group code for the ISBN. This is the numerical version,
502             for example, '0' for the English group. The valid group codes come
503             from C.
504              
505             =cut
506              
507 213376     213376 1 382660 sub group_code { $_[0]->{'group_code'} }
508              
509             =item group
510              
511             Returns the group name for the ISBN. This is the string version. For
512             instance, 'English' for the '0' group. The names come from
513             C.
514              
515             =cut
516              
517 7     7 1 26 sub group { $_[0]->_group_data( $_[0]->group_code )->[0] }
518              
519             sub _group_code_length {
520             length(
521 640060 50   640060   1475828 defined $_[0]->{'group_code'} ? $_[0]->{'group_code'} : ''
522             );
523             }
524              
525             =item publisher_code
526              
527             Returns the publisher code for the ISBN. This is the numeric version,
528             for instance '596' for O'Reilly Media.
529              
530             =cut
531              
532 22     22 1 85 sub publisher_code { $_[0]->{'publisher_code'} }
533             sub _publisher_code_length {
534             length(
535 213354 50   213354   368085 defined $_[0]->{'publisher_code'} ? $_[0]->{'publisher_code'} : ''
536             );
537             }
538              
539             =item article_code
540              
541             Returns the article code for the ISBN. This is the numeric version that
542             uniquely identifies the item.
543              
544             =cut
545              
546 7     7 1 37 sub article_code { $_[0]->{'article_code'} }
547              
548             =item article_code_length
549              
550             Returns the article code length for the ISBN.
551              
552             =cut
553              
554 5     5 1 23 sub article_code_length { length $_[0]->{'article_code'} }
555              
556             =item article_code_min
557              
558             Returns the minimum article code length for the publisher code.
559              
560             =cut
561              
562 4     4 1 23 sub article_code_min { 0 }
563              
564             =item article_code_max
565              
566             Returns the max article code length for the publisher code.
567              
568             =cut
569              
570 3     3 1 7 sub article_code_max { '9' x $_[0]->article_code_length }
571              
572             =item checksum
573              
574             Returns the checksum code for the ISBN. This checksum may not be valid since
575             you can create an object an fix the checksum later with C.
576              
577             =cut
578              
579 213364     213364 1 476675 sub checksum { $_[0]->{'checksum'} }
580 35     35   60 sub _checksum_pos { length( $_[0]->isbn ) - 1 }
581              
582              
583             =item is_valid_checksum
584              
585             Returns C for valid checksums and
586             C otherwise. This does not guarantee
587             that the rest of the ISBN is actually assigned to a book.
588              
589             =cut
590              
591             sub is_valid_checksum {
592 213361     213361 1 225224 my $self = shift;
593              
594 213361 50       317663 cluck "is_valid_checksum: Didn't get object!" unless ref $self;
595              
596 12     12   83 no warnings 'uninitialized';
  12         44  
  12         9568  
597 213361 100       319828 return GOOD_ISBN if $self->checksum eq $self->_checksum;
598              
599 64         145 return BAD_CHECKSUM;
600             }
601              
602             =item fix_checksum
603              
604             Checks the checksum and modifies the ISBN to set it correctly if needed.
605              
606             =cut
607              
608             sub fix_checksum {
609 13     13 1 28 my $self = shift;
610              
611 13         24 my $last_char = substr($self->isbn, $self->_checksum_pos, 1);
612 13         27 my $checksum = $self->_checksum;
613              
614 13         21 my $isbn = $self->isbn;
615 13         24 substr($isbn, $self->_checksum_pos, 1) = $checksum;
616              
617 13         30 $self->_set_isbn( $isbn );
618 13         28 $self->_set_checksum( $checksum );
619              
620 13         36 $self->_check_validity;
621              
622 13 100       31 return 0 if $last_char eq $checksum;
623 9         17 return 1;
624             }
625              
626              
627             =item as_string(), as_string([])
628              
629             Return the ISBN as a string. This function takes an
630             optional anonymous array (or array reference) that specifies
631             the placement of hyphens in the string. An empty anonymous array
632             produces a string with no hyphens. An empty argument list
633             automatically hyphenates the ISBN based on the discovered
634             group and publisher codes. An ISBN that is not valid may
635             produce strange results.
636              
637             The positions specified in the passed anonymous array
638             are only used for one method use and do not replace
639             the values specified by the constructor. The method
640             assumes that you know what you are doing and will attempt
641             to use the least three positions specified. If you pass
642             an anonymous array of several positions, the list will
643             be sorted and the lowest three positions will be used.
644             Positions less than 1 and greater than 12 are silently
645             ignored.
646              
647             A terminating 'x' is changed to 'X'.
648              
649             =cut
650              
651             sub as_string {
652 22     22 1 756 my $self = shift;
653 22         36 my $array_ref = shift;
654              
655             #this allows one to override the positions settings from the
656             #constructor
657 22 100       93 $array_ref = $self->_hyphen_positions unless ref $array_ref eq ref [];
658              
659             # print STDERR Data::Dumper->Dump( [$array_ref], [qw(array_ref)] );
660             # print STDERR Data::Dumper->Dump( [$self], [qw(self)] );
661              
662 22 50       52 return unless $self->is_valid eq GOOD_ISBN;
663 22         65 my $isbn = $self->isbn;
664              
665 22         72 foreach my $position ( sort { $b <=> $a } @$array_ref ) {
  42         75  
666 45 50 33     149 next if $position > 12 or $position < 1;
667 45         81 substr($isbn, $position, 0) = '-';
668             }
669              
670 22         118 return $isbn;
671             }
672              
673             =item as_isbn10
674              
675             Returns a new ISBN object. If the object is already ISBN-10, this method
676             clones it. If it is an ISBN-13 with the prefix 978, it returns the ISBN-10
677             equivalent. For all other cases it returns undef.
678              
679             =cut
680              
681             sub as_isbn10 {
682 0     0 1 0 croak "as_isbn10() must be implemented in Business::ISBN subclass"
683             }
684              
685             =item as_isbn13
686              
687             Returns a new ISBN object. If the object is already ISBN-13, this method
688             clones it. If it is an ISBN-10, it returns the ISBN-13 equivalent with the
689             978 prefix.
690              
691             =cut
692              
693             sub as_isbn13 {
694 0     0 1 0 croak "as_isbn13() must be implemented in Business::ISBN subclass"
695             }
696              
697             =item increment
698              
699             Returns the next C by incrementing the article code of
700             the specified ISBN (object or scalar).
701              
702             Returns undef, if the parameter is invalid or equals the maximum
703             possible ISBN for the publisher.
704              
705             $isbn = Business::ISBN->new('1565922573'); # 1-56592-257-3
706             $next_isbn = $isbn->increment; # 1-56592-258-1
707              
708             If the next article code would exceed the maximum possible article
709             code (such as incrementing 999 to 1000), this returns ARTICLE_CODE_OUT_OF_RANGE
710             as the error.
711              
712             =cut
713              
714 2     2 1 701 sub increment { $_[0]->_step_article_code( +1 ) }
715              
716             =item decrement
717              
718             Returns the previous C by decrementing the article
719             code of the specified ISBN (object or scalar).
720              
721             Returns undef, if the parameter is invalid or equals the minimum
722             possible ISBN for the publisher.
723              
724             $isbn = Business::ISBN->new('1565922573'); # 1-56592-257-3
725             $prev_isbn = $isbn->decrement; # 1-56592-256-5
726              
727             If the next article code would exceed the maximum possible article
728             code (such as incrementing 000 to -1), this returns ARTICLE_CODE_OUT_OF_RANGE
729             as the error.
730              
731             =cut
732              
733 2     2 1 701 sub decrement { $_[0]->_step_article_code( -1 ) }
734              
735             sub _step_article_code {
736 4     4   5 my( $self, $step ) = @_;
737 4 50 33     17 carp "The step for _step_isbn must be an integer"
738             unless( $step == int $step and $step != 0 );
739              
740 4         10 my $next_article_code = int $self->article_code + $step;
741              
742 4 100 100     6 return ARTICLE_CODE_OUT_OF_RANGE unless
743             $next_article_code >= $self->article_code_min
744             &&
745             $next_article_code <= $self->article_code_max
746             ;
747              
748 2         4 my $next_isbn = Business::ISBN->new(
749             join('',
750             $self->prefix,
751             $self->group_code,
752             $self->publisher_code,
753             sprintf( "%0*d", $self->article_code_length, $next_article_code ),
754             '0'
755             )
756             );
757              
758 2         5 $next_isbn->fix_checksum;
759              
760 2         5 $next_isbn;
761             }
762              
763             =item png_barcode
764              
765             Returns image data in PNG format for the barcode for the ISBN. This
766             works with ISBN-10 and ISBN-13. The ISBN-10s are automatically converted
767             to ISBN-13.
768              
769             This requires C.
770              
771             =cut
772              
773             sub png_barcode {
774 0     0 1 0 my $self = shift;
775              
776 0         0 my $ean = $self->as_isbn13->as_string([]);
777              
778 0         0 eval { require GD::Barcode::EAN13 };
  0         0  
779 0 0       0 if( $@ ) {
780 0         0 carp "Need GD::Barcode::EAN13 to use png_barcode!";
781 0         0 return;
782             }
783              
784 0         0 my $gd_image = GD::Barcode::EAN13->new($ean)->plot;
785 0         0 my $image;
786 0 0       0 if( $gd_image->can('png') ) {
787 0         0 $image = GD::Barcode::EAN13->new($ean)->plot->png;
788             }
789             else {
790 0         0 carp "Your GD module does not have PNG support";
791 0         0 return;
792             }
793              
794 0         0 return $image;
795             }
796              
797             =back
798              
799             =cut
800              
801 213368     213368   299755 sub _set_isbn { $_[0]->{'isbn'} = $_[1]; }
802              
803 426723     426723   783230 sub _set_is_valid { $_[0]->{'valid'} = $_[1]; }
804              
805             sub _set_prefix
806             {
807 0     0   0 croak "_set_prefix() must be implemented in Business::ISBN subclass"
808             }
809              
810 213347     213347   382161 sub _set_group_code { $_[0]->{'group_code'} = $_[1]; }
811              
812 0     0   0 sub _set_group_code_string { $_[0]->{'group_code_string'} = $_[1]; }
813              
814 213342     213342   471163 sub _set_publisher_code { $_[0]->{'publisher_code'} = $_[1]; }
815              
816 0     0   0 sub _set_publisher_code_string { $_[0]->{'publisher_code_string'} = $_[1]; }
817              
818 213342     213342   382010 sub _set_article_code { $_[0]->{'article_code'} = $_[1]; }
819              
820 213355     213355   385063 sub _set_checksum { $_[0]->{'checksum'} = $_[1]; }
821              
822             sub _set_type {
823 0     0   0 croak "_set_type() must be implemented in Business::ISBN subclass"
824             }
825              
826              
827             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
828             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
829             # # internal methods. you don't get to use this one.
830             sub _common_format {
831 12     12   82 no warnings qw(uninitialized);
  12         25  
  12         8635  
832 106717     106717   160582 my $data = uc shift; # we want uppercase X's
833 106717         225666 $data =~ s/[^0-9X]//g;
834 106717         154550 return $data;
835             }
836              
837             sub _init {
838 213355     213355   273431 my $self = shift;
839 213355         273601 my $common_data = shift;
840              
841 213355         793073 my $class = ref $self =~ m/.*::(.*)/g;
842              
843 213355         512793 $self->_set_type;
844 213355         434535 $self->_set_isbn( $common_data );
845              
846             # we don't know if we have a valid group code yet
847             # so let's assume that we don't
848 213355         329002 $self->_set_is_valid( INVALID_GROUP_CODE );
849             }
850              
851             {
852             my @methods = (
853             [ qw( prefix ), INVALID_PREFIX ],
854             [ qw( group_code ), INVALID_GROUP_CODE ],
855             [ qw( publisher_code ), INVALID_PUBLISHER_CODE ],
856             [ qw( article_code ), BAD_ISBN ],
857             [ qw( checksum ), BAD_CHECKSUM ],
858             );
859              
860             sub _parse_isbn {
861 213355     213355   240666 my $self = shift;
862              
863 213355         304028 foreach my $pair ( @methods ) {
864 1066739         1519706 my( $method, $error_code ) = @$pair;
865              
866 1066739         1208333 my $parser = "_parse_$method";
867 1066739         1802972 my $result = $self->$parser;
868              
869 1066739 100       1674973 unless( defined $result ) {
870 13         25 $self->_set_is_valid( $error_code );
871             #print STDERR "Got bad result for $method [$$self{isbn}]\n";
872 13         16 return;
873             }
874              
875 1066726         1201573 $method = "_set_$method";
876 1066726         1858940 $self->$method( $result );
877             }
878              
879 213342         315810 $self->_set_is_valid( $self->is_valid_checksum );
880              
881 213342         295701 return $self;
882             }
883             }
884              
885             sub _parse_group_code {
886 213353     213353   235021 my $self = shift;
887              
888 213353         224829 my $trial; # try this to see what we get
889 213353         230886 my $group_code_length = 0;
890              
891 213353         247136 my $count = 1;
892              
893             GROUP_CODE:
894 213353         343481 while( defined( $trial= substr($self->isbn, $self->_prefix_length, $count++) ) ) {
895 217763 100       441555 if( defined $self->_group_data( $trial ) ) {
896 213347         412316 return $trial;
897 0         0 last GROUP_CODE;
898             }
899              
900             # if we've past the point of finding a group
901             # code we're pretty much stuffed.
902 4416 100       6208 return if $count > $self->_max_group_code_length;
903             }
904              
905 0         0 return; #failed if I got this far
906             }
907              
908             sub _parse_publisher_code {
909 213347     213347   235122 my $self = shift;
910              
911 213347         329687 my $pairs = $self->_publisher_ranges;
912              
913             # get the longest possible publisher code
914             # I'll try substrs of this to get the real one
915 213347         391261 my $longest = substr(
916             $self->isbn,
917             $self->_prefix_length + $self->_group_code_length,
918             $self->_max_publisher_code_length,
919             );
920              
921             #print STDERR "Trying to parse publisher: longest [$longest]\n";
922 213347         399847 while( @$pairs ) {
923 2645511         2910015 my $lower = shift @$pairs;
924 2645511         2947047 my $upper = shift @$pairs;
925              
926 2645511         3015856 my $trial = substr( $longest, 0, length $lower );
927             #print STDERR "Trying [$trial] with $lower <-> $upper [$$self{isbn}]\n";
928              
929             # this has to be a sring comparison because there are
930             # possibly leading 0s
931 2645511 100 100     6327398 if( $trial ge $lower and $trial le $upper )
932             {
933             #print STDERR "Returning $trial\n";
934 213342         745919 return $trial;
935             }
936              
937             }
938              
939 5         9 return; #failed if I got this far
940             }
941              
942             sub _parse_article_code {
943 213342     213342   238418 my $self = shift;
944              
945 213342         304988 my $head = $self->_prefix_length +
946             $self->_group_code_length +
947             $self->_publisher_code_length;
948 213342         360083 my $length = length( $self->isbn ) - $head - 1;
949              
950 213342         309612 substr( $self->isbn, $head, $length );
951             }
952              
953             sub _parse_checksum {
954 213342     213342   256150 my $self = shift;
955              
956 213342         294514 substr( $self->isbn, -1, 1 );
957             }
958              
959             sub _check_validity {
960 13     13   16 my $self = shift;
961              
962 13 50 33     21 if( $self->is_valid_checksum eq GOOD_ISBN and
      33        
      33        
963             defined $self->group_code and
964             defined $self->publisher_code and
965             defined $self->prefix
966             ) {
967 13         32 $self->_set_is_valid( GOOD_ISBN );
968 13         18 return GOOD_ISBN;
969             }
970             else {
971 0 0         $self->_set_is_valid( INVALID_PUBLISHER_CODE )
972             unless defined $self->publisher_code;
973 0 0         $self->_set_is_valid( INVALID_GROUP_CODE )
974             unless defined $self->group_code;
975 0 0         $self->_set_is_valid( INVALID_PREFIX )
976             unless defined $self->prefix;
977 0           return;
978             }
979             }
980              
981             sub _hyphen_positions {
982 0     0     croak "hyphen_positions() must be implemented in Business::ISBN subclass"
983             }
984              
985              
986             1;
987              
988             __END__