File Coverage

blib/lib/Business/ISMN.pm

Criterion	Covered	Total	%
statement	122	153	79.7
branch	26	46	56.5
condition	8	18	44.4
subroutine	28	36	77.7
pod	17	17	100.0
total	201	270	74.4

use 5.008;

package Business::ISMN;
use strict;

use subs qw(
	_common_format _checksum is_valid_checksum
	INVALID_PUBLISHER_CODE
	BAD_CHECKSUM
	GOOD_ISMN
	BAD_ISMN
	);
use vars qw( $debug %country_data $MAX_COUNTRY_CODE_LENGTH );

use Carp qw(carp);
use Exporter qw(import);
use List::Util qw(sum);
use Tie::Cycle;
use Business::ISMN::Data;

my $debug = 0;

our @EXPORT_OK = qw(is_valid_checksum ean_to_ismn ismn_to_ean
	INVALID_PUBLISHER_CODE BAD_CHECKSUM GOOD_ISMN BAD_ISMN);

our $VERSION = '1.202';

sub INVALID_PUBLISHER_CODE { -3 };
sub BAD_CHECKSUM           { -1 };
sub GOOD_ISMN              {  1 };
sub BAD_ISMN               {  0 };

my %Lengths = qw(
	0 3
	1 4
	2 4
	3 4
	4 5
	5 5
	6 5
	7 6
	8 6
	9 7
	);

sub new {
	my $class       = shift;
	my $common_data = _common_format shift;

	return unless defined $common_data;

	my $self  = {};
	bless $self, $class;

	$self->{'ismn'}      = $common_data;
	$self->{'positions'} = [1,undef,9];

	# we don't know if we have a valid publisher code,
	# so let's assume we don't
	$self->{'valid'} = INVALID_PUBLISHER_CODE;

	# let's check the publisher code.
	my $code_length = $Lengths{ substr( $self->{'ismn'}, 1, 1 ) };
	$self->{publisher_code} = substr(
		$self->{'ismn'},
		1,
		$code_length
		);

	my $code_end = $code_length + 1;

	$self->{'positions'}[1] = $code_end;

	return $self unless $self->is_valid_country_code;

	# we have a good publisher code, so
	# assume we have a bad checksum until we check
	$self->{'valid'} = BAD_CHECKSUM;

	$self->{'article_code'} = substr( $self->{'ismn'}, $code_end, 9 - $code_end );
	$self->{'checksum'}     = substr( $self->{'ismn'}, -1, 1 );

	$self->{'valid'} = is_valid_checksum( $self->{'ismn'} );

	return $self;
	}


#it's your fault if you muck with the internals yourself
# none of these take arguments
sub ismn ()             { my $self = shift; return $self->{'ismn'} }
sub is_valid ()         { my $self = shift; return $self->{'valid'} }
sub country ()          { my $self = shift; return $self->{'country'} }
sub publisher ()        { carp "publisher is deprecated. Use country instead."; &country }
sub publisher_code ()   { my $self = shift; return $self->{'publisher_code'} }
sub article_code ()     { my $self = shift; return $self->{'article_code'} }
sub checksum ()         { my $self = shift; return $self->{'checksum'} }
sub hyphen_positions () { my $self = shift; return @{$self->{'positions'}} }


sub fix_checksum {
	my $self = shift;

	my $last_char = substr($self->{'ismn'}, 9, 1);
	my $checksum = _checksum $self->ismn;

	substr($self->{'ismn'}, 9, 1) = $checksum;

	$self->_check_validity;

	return 0 if $last_char eq $checksum;
	return 1;
	}

sub as_string {
	my $self      = shift;
	my $array_ref = shift;

	#this allows one to override the positions settings from the
	#constructor
	$array_ref = $self->{'positions'} unless ref $array_ref eq 'ARRAY';

	return unless $self->is_valid eq GOOD_ISMN;
	my $ismn = $self->ismn;

	foreach my $position ( sort { $b <=> $a } @$array_ref )
		{
		next if $position > 9 or $position < 1;
		substr($ismn, $position, 0) = '-';
		}

	return $ismn;
	}

sub as_ean {
	my $self = shift;

	my $ismn = ref $self ? $self->as_string([]) : _common_format $self;

	return unless ( defined $ismn and length $ismn == 10 );

	# the M becomes a zero in bookland
	substr( $ismn, 0, 1 ) = '0';

	my $ean = '979' . substr($ismn, 0, 9);

	my $sum = 0;
	foreach my $index ( 0, 2, 4, 6, 8, 10 ) {
		$sum +=     substr($ean, $index, 1);
		$sum += 3 * substr($ean, $index + 1, 1);
		}

	#take the next higher multiple of 10 and subtract the sum.
	#if $sum is 37, the next highest multiple of ten is 40. the
	#check digit would be 40 - 37 => 3.
	$ean .= ( 10 * ( int( $sum / 10 ) + 1 ) - $sum ) % 10;

	return $ean;
	}

sub is_valid_country_code {
	my $self = shift;
	my $code = $self->publisher_code;

	my $success = 0;

	foreach my $tuple ( @publisher_tuples ) {
		no warnings;
		next if( defined $tuple->[2] and $code > $tuple->[2] );
		last if $code < $tuple->[1];
		if( $code >= $tuple->[1] and $code <= $tuple->[2] ) {
			$success = 1;
			$self->{'country'} = $tuple->[0];
			last;
			}
		}

	return $success;
	}

sub is_valid_publisher_code {
	carp "is_valid_publisher_code is deprecated. Use is_valid_country_code";
	&is_valid_country_code
	}

sub is_valid_checksum {
	my $data = _common_format shift;

	return BAD_ISMN unless defined $data;

	return GOOD_ISMN if substr($data, 9, 1) eq _checksum $data;

	return BAD_CHECKSUM;
	}

sub ean_to_ismn {
	my $ean = shift;

	$ean =~ s/[^0-9]//g;

	return unless length $ean == 13;
	return unless substr($ean, 0, 3) eq 979;

	#XXX: fix to change leading 0 back to M
	my $ismn = Business::ISMN->new( substr($ean, 3, 9) . '1' );

	$ismn->fix_checksum;

	return $ismn->as_string([]) if $ismn->is_valid;

	return;
	}


sub ismn_to_ean {
	my $ismn = _common_format shift;

	return unless (defined $ismn and is_valid_checksum($ismn) eq GOOD_ISMN);

	return as_ean($ismn);
	}

sub png_barcode {
	my $self = shift;

	my $ean = ismn_to_ean( $self->as_string([]) );

	eval "use GD::Barcode::EAN13";
	if( $@ ) {
		carp "GD::Barcode::EAN13 required to make PNG barcodes";
		return;
		}

	my $image = GD::Barcode::EAN13->new($ean)->plot->png;

	return $image;
	}

#internal function.  you don't get to use this one.
sub _check_validity {
	my $self = shift;

	if( is_valid_checksum $self->{'ismn'} eq GOOD_ISMN
	    and defined $self->{'publisher_code'} ) {
	    $self->{'valid'} = GOOD_ISMN;
	    }
	else {
		$self->{'valid'} = INVALID_PUBLISHER_CODE
			unless defined $self->{'publisher_code'};
		$self->{'valid'} = GOOD_ISMN
			 unless is_valid_checksum $self->{'ismn'} ne GOOD_ISMN;
		}
	}

#internal function.  you don't get to use this one.
sub _checksum {
	my $data = _common_format shift;

	tie my $factor, 'Tie::Cycle', [ 1, 3 ];
	return unless defined $data;

	my $sum = 9;

	foreach my $digit ( split //, substr( $data, 1, 8 ) ) {
		my $mult = $factor;
		$sum += $digit * $mult;
		}

	#return what the check digit should be
	# the extra mod 10 turns 10 into 0.
	my $checksum = ( 10 - ($sum % 10) ) % 10;

	return $checksum;
	}

#internal function.  you don't get to use this one.
sub _common_format {
	no warnings qw(uninitialized);
	#we want uppercase X's
	my $data = uc shift;

	# get rid of everything except decimal digits and X
	# and leading M
	$data =~ s/[^0-9M]//g;

	return $1 if $data =~ m/
						^
						(
						M
						\d{9}
						)
						$
						/x;

	return;
	}

1;

__END__