view release on metacpan or  search on metacpan

LRC.xs  view on Meta::CPAN

# * }# for
# * return $check;
# *
# *
 */

/* getlrc(...)
 * generate the lrc using the XOR of each byte
 *
 * ALTERNATIVE:
 * generate the lrc using a unsigned char sum of each ptr 
 * position in the string, and then take the two's complment.
 * My OS professor from college would kill me, but I have to admit, I'm 
 * not sure if the XOR and this alternative are actually equivalent.
 *
 */ 
unsigned char 
getlrc(unsigned char *string, unsigned long stringSize, unsigned char lrcinit)
{
  unsigned long i;
  unsigned char lrc  = lrcinit;
  unsigned char *buf = (unsigned char *) string;
  for (i=0; i < stringSize;  i++)
	lrc = lrc ^ buf[i];
  return (unsigned char) lrc; 
} // getlrc

unsigned char getlrc_fp(PerlIO *fp,unsigned char lrcinit)
{
    unsigned char lrc = lrcinit;
    int c;
    while( (c=PerlIO_getc(fp)) != EOF ) {
        lrc = lrc ^ c;
    }
    return (unsigned char) lrc;		// normal return of lrc byte
}

svtype getsvtype(SV *sv)
{
  if (sv == NULL )
    return SVt_NULL;
  if (SvROK(sv))
    return SvTYPE(SvRV(sv));
  else 
    return SvTYPE(sv);
}


MODULE = String::LRC		PACKAGE = String::LRC

VERSIONCHECK: DISABLE
PROTOTYPES: DISABLE 


unsigned char
lrc(data, ...)
    char *data = NO_INIT
    PREINIT:
    unsigned char lrcinit = 0x00;
    STRLEN data_len;
    PPCODE:
	int sv_type;
	IO *io;
	SV *sv;
	unsigned char rv;
      {
	if ( items > 1 )
		lrcinit = (unsigned char) SvNV(ST(items - 1));

	sv_type = getsvtype(ST(0));

	if (sv_type == SVt_PVGV)
	  {
		io = sv_2io(ST(0));
		rv = (unsigned char) getlrc_fp(IoIFP(io), lrcinit);
	  }
	else
	  {
		data = (char *)SvPV(ST(0),data_len);
		rv = (unsigned char) getlrc(data, data_len, lrcinit);
	  }
	EXTEND(sp, 1);
	sv = newSV(0);
	//sv_setuv(sv, (UV)rv);
	sv_setpvn(sv, (char *)&rv, 1);
	PUSHs(sv_2mortal(sv));
      }