package Algorithm::CheckDigits::MBase_003; use 5.006; use strict; use warnings; use integer; our @ISA = qw(Algorithm::CheckDigits); my @weight = ( 6, 3, 7, 9, 10, 5, 8, 4, 2, 1 ); my %table_to = ( '0' => 0, '1' => 1, '2' => 2, '3' => 3, '4' => 4, '5' => 5, '6' => 6, '7' => 7, '8' => 8, '9' => 9, 'A' => 10, 'B' => 11, 'C' => 12, 'D' => 13, 'E' => 14, 'F' => 15, 'G' => 16, 'H' => 17, 'I' => 18, 'J' => 19, 'K' => 20, 'L' => 21, 'M' => 22, 'N' => 23, 'O' => 24, 'P' => 25, 'Q' => 26, 'R' => 27, 'S' => 28, 'T' => 29, 'U' => 30, 'V' => 31, 'W' => 32, 'X' => 33, 'Y' => 34, 'Z' => 35, ); my @table_from = ( '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z', '#', ); sub new { my $proto = shift; my $type = shift; my $class = ref($proto) || $proto; my $self = bless({}, $class); $self->{type} = lc($type); return $self; } # new() sub is_valid { my ($self,$number) = @_; if ($number =~ /^(.*)(.)$/) { return uc($2) eq $self->_compute_checkdigits($1); } return '' } # is_valid() sub complete { my ($self,$number) = @_; if ($number =~ /^(.*)$/) { return "$1" . $self->_compute_checkdigits($1) } return ''; } # complete() sub basenumber { my ($self,$number) = @_; if ($number =~ /^(.*)(.)$/) { return "$1" if ($2 eq $self->_compute_checkdigits($1)); } return ''; } # basenumber() sub checkdigit { my ($self,$number) = @_; if ($number =~ /^(.*)(.)$/) { return $2 if ($2 eq $self->_compute_checkdigits($1)); } return ''; } # checkdigit() sub _compute_checkdigits { my $self = shift; my $number = shift; my $digit; my @digits = split(//,$number); my $even = 0; my $sum1 = 0; my $sum2 = 0; for (my $i = $#digits; $i>= 0; $i--) { if (uc($digits[$i]) =~ /[0-9A-Z]/) { $digit = $table_to{uc($digits[$i])}; } else { $digit = 36; } $sum1 += 3 * $digit unless ($even); $sum2 += $digit if ($even); $even = not $even; } my $sum = 37 - (($sum1 + $sum2) % 37); return $table_from[$sum]; } # _compute_checkdigit() # Preloaded methods go here. 1; __END__ =head1 NAME CheckDigits::MBase_003 - compute check digits for SICI (Serial Item and Contribution Identifier) =head1 SYNOPSIS use Algorithm::CheckDigits; $sici = CheckDigits('sici'); if ($sici->is_valid('0784-8679(20040308)6:<138>2.0.TX;2-H')) { # do something } $cn = $sici->complete('0784-8679(20040308)6:<138>2.0.TX;2-'); # $cn = '0784-8679(20040308)6:<138>2.0.TX;2-H' $cd = $sici->checkdigit('0784-8679(20040308)6:<138>2.0.TX;2-H'); # $cd = 'H' $bn = $sici->basenumber('0784-8679(20040308)6:<138>2.0.TX;2-H'); # $bn = '0784-8679(20040308)6:<138>2.0.TX;2-'; =head1 DESCRIPTION =head2 ALGORITHM =over 4 =item 0 In the string describing the number all letters (A-Z) are replaced with numbers 10-35 accordingly. All other non-numbers are replaced by 36. =item 1 Beginning right the numbers at all odd positions are added. =item 2 The sum from step 1 is multiplied by 3. =item 3 Beginning right the numbers at all even positions are added. =item 4 The sums from step 2 and 3 are added. =item 5 The sum from step 4 is taken modulo 37. =item 6 The checksum is 37 minus the sum from step 5 where numbers from 10 to 35 are represented by 'A' to 'Z' accordingly and 36 is represented by '#'. =back =head2 METHODS =over 4 =item is_valid($number) Returns true only if C<$number> consists solely of numbers and hyphens and the two digits in the middle are valid check digits according to the algorithm given above. Returns false otherwise, =item complete($number) The check digit for C<$number> is computed and inserted into the middle of C<$number>. Returns the complete number with check digit or '' if C<$number> does not consist solely of digits, hyphens and spaces. =item basenumber($number) Returns the basenumber of C<$number> if C<$number> has a valid check digit. Return '' otherwise. =item checkdigit($number) Returns the check digits of C<$number> if C<$number> has valid check digits. Return '' otherwise. =back =head2 EXPORT None by default. =head1 AUTHOR Mathias Weidner, Emathias@weidner.in-bad-schmiedeberg.deE =head1 SEE ALSO L, L, F, F =cut