Algorithm-LUHN_XS

 view release on metacpan or  search on metacpan

LUHN_XS.xs  view on Meta::CPAN

    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;
        }
    }

LUHN_XS.xs  view on Meta::CPAN

        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;

LUHN_XS.xs  view on Meta::CPAN

    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;

t/01-cc.t  view on Meta::CPAN

  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

t/03-csp.t  view on Meta::CPAN

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__