Algorithm-LUHN_XS
view release on metacpan or search on metacpan
checksum *= 9;
return(checksum%10);
}
int check_digit_fast(unsigned char *input) {
int i, sum, ch, num, twoup, len;
len = strlen(input);
if (len < 1) {
char err[MAX_ERROR_LEN];
snprintf(err,MAX_ERROR_LEN,"check_digit_fast: No input string.");
SV *error;
error=get_sv("Algorithm::LUHN_XS::ERROR",GV_ADD);
sv_setpv(error,err);
return -1;
}
sum = 0;
twoup = 1;
for (i = len - 1; i >= 0; --i) {
num=_al_vc[input[i]];
if (num == -1) {
/* Don't change the error text, perl tests depend on the exact words */
unsigned char err[MAX_ERROR_LEN];
snprintf(err,MAX_ERROR_LEN,"Invalid character '%c', in check_digit calculation string [%s]",input[i],input);
SV *error;
error=get_sv("Algorithm::LUHN_XS::ERROR",GV_ADD);
sv_setpv(error,err);
return -1;
}
if (!(twoup = !twoup)) {
num *= 2;
}
while (num) {
sum += num % 10;
num=num/10;
}
}
return newSViv(rv);
}
}
SV* is_valid(unsigned char *input) {
int len=strlen(input);
if (len < 2) {
unsigned char err[MAX_ERROR_LEN];
snprintf(err,MAX_ERROR_LEN,
"is_valid: you must supply input of at least 2 characters");
SV *error;
error=get_sv("Algorithm::LUHN_XS::ERROR",GV_ADD);
sv_setpv(error,err);
SV* rv=newSVpv(NULL,1);
return rv;
}
unsigned char *leftmost=_al_substr(input,0,len-1);
unsigned char cd=input[len-1];
unsigned char c=check_digit_fast(leftmost)+'0';
free(leftmost);
if (c < 48) {
SV* rv=newSVpv(NULL,1);
return rv;
} else {
if (cd == c) {
return(newSViv(1));
} else {
unsigned char err[MAX_ERROR_LEN];
snprintf(err,MAX_ERROR_LEN,
"Check digit incorrect. Expected %c",c);
SV *error;
error=get_sv("Algorithm::LUHN_XS::ERROR",GV_ADD);
sv_setpv(error,err);
SV* rv=newSVpv(NULL,1);
return rv;
}
}
}
int is_valid_fast(unsigned char *input) {
int len=strlen(input);
if (len < 2) {
return 0;
if (c < 48) {
return 0;
} else {
if (cd == c) {
return 1;
} else {
unsigned char err[MAX_ERROR_LEN];
snprintf(err,MAX_ERROR_LEN,
"Check digit incorrect. Expected %c",c);
SV *error;
error=get_sv("Algorithm::LUHN_XS::ERROR",GV_ADD);
sv_setpv(error,err);
return 0;
}
}
}
int is_valid_rff(unsigned char *input) {
unsigned char csum;
int len=strlen(input);
if (len < 2) {
return 0;
ok($c, $expected, "check_digit($v): expected $expected; got $c\n");
$c = check_digit_fast($v);
ok($c, $expected, "check_digit_fast($v): expected $expected; got $c\n");
$c = check_digit_rff($v);
ok($c, $expected, "check_digit_rff($v): expected $expected; got $c\n");
ok(is_valid("$v$expected"));
# sprintf() avoids perl turning 123456789 into 1.23456789e+1
ok(!is_valid($v.sprintf("%d",9-$expected)));
ok($Algorithm::LUHN_XS::ERROR, qr/^Check digit/,
"Did not get the expected error. Got $Algorithm::LUHN_XS::ERROR\n");
ok(is_valid_fast("$v$expected"));
ok(!is_valid_fast($v.sprintf("%d",9-$expected)));
ok(is_valid_rff("$v$expected"));
ok(!is_valid_rff($v.sprintf("%d",9-$expected)));
}
# Check a value including alphas (should fail).
my ($v, $c);
$v = 'A2';
ok(!defined($c=check_digit($v)));
$c ||= ''; # make sure $c is defined or we get an "uninit val" warning
ok($Algorithm::LUHN_XS::ERROR, qr/\S/,
" Expected an error, but got a check_digit instead: $v => $c\n");
ok($Algorithm::LUHN_XS::ERROR, qr/^Invalid/,
" Did not get the expected error. Got $Algorithm::LUHN_XS::ERROR\n");
ok(($c=check_digit_fast($v))==-1);
ok($Algorithm::LUHN_XS::ERROR, qr/\S/,
" Expected an error, but got a check_digit instead: $v => $c\n");
ok($Algorithm::LUHN_XS::ERROR, qr/^Invalid/,
" Did not get the expected error. Got $Algorithm::LUHN_XS::ERROR\n");
# check passing an empty string...should fail
ok( (!defined($c=check_digit(''))));
ok(($c=check_digit_fast(''))==-1);
ok(($c=check_digit_rff(''))==-1);
ok((!is_valid('')));
ok((!is_valid_fast('')));
ok((!is_valid_rff('')));
# check passing one character to is_valid...should fail
my @values = qw/83764912 8 123456781234567 0 4992739871 6
392690QT 3 035231AH 2 157125AA 3/;
while (@values) {
my ($v, $expected) = splice @values, 0, 2;
my $c = check_digit($v);
ok($c, $expected, "check_digit($v): expected $expected; got $c\n");
ok(is_valid("$v$c"));
ok(!is_valid("$v".(9-$c)));
ok($Algorithm::LUHN_XS::ERROR, qr/^Check digit/,
" Did not get the expected error. Got $Algorithm::LUHN_XS::ERROR\n");
my $d = check_digit_fast($v);
ok($d, $expected, "check_digit($v): expected $expected; got $d\n");
ok(is_valid_fast("$v$c"));
ok(!is_valid_fast("$v".(9-$c)));
ok($Algorithm::LUHN_XS::ERROR, qr/^Check digit/,
" Did not get the expected error. Got $Algorithm::LUHN_XS::ERROR\n");
}
# check_digit_rff and is_valid_rff should fail with non-numeric input
my $cd;
ok(($cd=check_digit_rff("392690QT"))==-1);
ok((!is_valid_rff("392690QT3")));
# Check a value including non-alphanum char (should fail).
my ($v, $c);
$v = '016783A@';
ok(!defined($c=check_digit($v)));
$c ||= ''; # make sure $c is defined or we get an "uninit val" warning
ok($Algorithm::LUHN_XS::ERROR, qr/\S/,
" Expected an error, but got a check_digit instead: $v => $c\n");
ok($Algorithm::LUHN_XS::ERROR, qr/^Invalid/,
" Did not get the expected error. Got $Algorithm::LUHN_XS::ERROR\n");
ok(($c=check_digit_fast($v))==-1);
$c ||= ''; # make sure $c is defined or we get an "uninit val" warning
ok($Algorithm::LUHN_XS::ERROR, qr/\S/,
" Expected an error, but got a check_digit instead: $v => $c\n");
ok($Algorithm::LUHN_XS::ERROR, qr/^Invalid/,
" Did not get the expected error. Got $Algorithm::LUHN_XS::ERROR\n");
__END__
( run in 0.605 second using v1.01-cache-2.11-cpan-65fba6d93b7 )