view release on metacpan or  search on metacpan

LUHN_XS.xs  view on Meta::CPAN

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"



#include <stdio.h>
#include <string.h>
int   _al_vc[256];
#define MAX_ERROR_LEN 200

/* you may be asking...why? */
/* well, windows and older versions of MacOS don't have strndup, so... */
unsigned char * _al_substr(unsigned const char* src, const int offset, const int len) {
    unsigned char * sub = (unsigned char*)malloc(len+1);
    memcpy(sub, src + offset, len);
    sub[len] = 0;
    return sub;
}

/* not thread safe, don't use this module with perl threads */
int _al_init_vc(SV* hash_ref) {
  HV* hash;
  HE* hash_entry;
  int num_keys, i;
  SV* sv_key;
  SV* sv_val;
  for (i=0;i<256;++i) {
      _al_vc[i]=-1;
  }
  hash = (HV*)SvRV(hash_ref);
  num_keys = hv_iterinit(hash);
  for (i = 0; i < num_keys; i++) {
    hash_entry = hv_iternext(hash);
    sv_key = hv_iterkeysv(hash_entry);
    sv_val = hv_iterval(hash, hash_entry);
    _al_vc[(SvPV(sv_key,PL_na))[0]]=atoi(SvPV(sv_val,PL_na)); 
  }
  return 1;
}

int check_digit_rff(unsigned char *input) {
    int len=strlen(input)-1;
    if (len < 1) { 
        return -1;
    }
    static int deltas[]={ 0, 1, 2, 3, 4, -4, -3, -2, -1, 0 };
    int checksum=0;
    int flip=0;
    int i,j;
    for (i = len; i >=0; --i) {
       j=input[i]-48;
       /* only handle numeric input */
       if (j > 9 || j < 0) {return -1;} 
       checksum += j;
       if (flip ^= 1) {
           checksum += deltas[j];
       }
    }
    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];