File Coverage

blib/lib/Business/ISSN.pm

Criterion	Covered	Total	%
statement	59	59	100.0
branch	15	16	93.7
condition			n/a
subroutine	16	16	100.0
pod	5	5	100.0
total	95	96	98.9

package Business::ISSN;

use strict;

use warnings;
no warnings;

use subs qw(_common_format _checksum is_valid_checksum);

use Exporter qw(import);

our @EXPORT    = qw();
our @EXPORT_OK = qw(is_valid_checksum);

our $VERSION = '1.004';

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

	return unless $common_data;

	my $self = bless {}, $class;

	$self->{'issn'}      = $common_data;

	$common_data =~m/([0-9]{7,7})([0-9\dxX])$/;

	@{$self}{ qw(checksum code) } = ( $2, $1 );

	$self->_check_validity;

	return $self;
	}

sub _issn             { $_[0]->{'issn'}         }
sub is_valid          { $_[0]->{'valid'}        }
sub checksum          { $_[0]->{'checksum'}     }
sub _hyphen_positions { 4 }

sub fix_checksum {
	my $self = shift;
	my $debug = 1;

	my $last_char = substr($self->_issn, -1, 1);

	my $checksum = _checksum $self->_issn;

	substr( $self->{issn}, -1, 1) = $checksum;

	$self->_check_validity;

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

sub as_string {
	return unless $_[0]->is_valid;

	my $issn = $_[0]->_issn;

	substr($issn, $_[0]->_hyphen_positions, 0) = '-';

	return $issn;
	}

sub is_valid_checksum {
	my $data = _common_format shift;
	return 0 unless $data;
	return 1 if substr($data, -1, 1) eq _checksum $data;
	return 0;
	}

sub _check_validity {
	$_[0]->{'valid'}  = is_valid_checksum( $_[0]->_issn );
	}

sub _checksum {
	my $data = _common_format shift;

	return unless $data;

	my @digits = split //, $data;
	my $sum    = 0;

	foreach( reverse 2..8 ) # oli 10
		{
		$sum += $_ * (shift @digits);
		}

	#return what the check digit should be
	my $checksum = (11 - ($sum % 11))%11;

	$checksum = 'X' if $checksum == 10;

	return $checksum;
	}

sub _common_format {
	#we want uppercase X's
	my $data = uc shift;

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

	return $data if $data =~ m/^[0-9]{7}[0-9X]\z/;

	return;
	}

1;
__END__