view release on metacpan or  search on metacpan

CRC32.xs  view on Meta::CPAN

0xbdbdf21c, 0xcabac28a, 0x53b39330, 0x24b4a3a6, 0xbad03605, 0xcdd70693, 0x54de5729, 0x23d967bf,
0xb3667a2e, 0xc4614ab8, 0x5d681b02, 0x2a6f2b94, 0xb40bbe37, 0xc30c8ea1, 0x5a05df1b, 0x2d02ef8d,
};
#endif /* GENTABLE */

U32 
getcrc(char *c, int len, U32 crcinit)
{
    register U32 crc;
    char     *e = c + len;

    crc = crcinit^0xFFFFFFFF;
    while (c < e) {
        crc = ((crc >> 8) & 0x00FFFFFF) ^ crcTable[ (crc^ *c) & 0xFF ];
        ++c;
    }
    return( crc^0xFFFFFFFF );
}

#define BUFSIZE 32768

U32
getcrc_fp( PerlIO *fp, U32 crcinit )
{
    register U32 crc;
    register U16 len;
    unsigned char buf[BUFSIZE];

    crc = crcinit^0xFFFFFFFF;
    while((len = PerlIO_read(fp, buf, BUFSIZE)) > 0 ) {
        unsigned char * p = buf;
        do {
	    crc = ((crc >> 8) & 0x00FFFFFF) ^ crcTable[(unsigned char)( (crc & 0xff) ^ *(p++) )];
	} while (--len);
    }
    return( crc^0xFFFFFFFF );
}

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

MODULE = String::CRC32		PACKAGE = String::CRC32

VERSIONCHECK: DISABLE
PROTOTYPES: DISABLE 

U32
crc32(data, ...)
    char *data = NO_INIT
    PREINIT:
	U32 crcinit = 0;
    STRLEN data_len;
    PPCODE:
	int sv_type;
	IO *io;
	SV *sv;
	U32 rv = 0;
      {
#ifdef GENTABLE
	crcgen();
#endif /* GENTABLE */
	/* Horst Fickenscher <horst_fickenscher@sepp.de> mailed me that it
	   could be useful to supply an initial value other than 0, e.g.
	   to calculate checksums of big files without the need of keeping
	   them comletely in memory */
	if ( items > 1 )
		crcinit = (U32) SvNV(ST(items - 1));

	sv_type = getsvtype(ST(0));

	if (sv_type == SVt_PVGV)
	  {
		io = sv_2io(ST(0));
		rv = getcrc_fp(IoIFP(io), crcinit);
	  }
	else
	  {
		data = (char *)SvPV(ST(0),data_len);
		rv = getcrc(data, data_len, crcinit);
	  }
	EXTEND(sp, 1);
	sv = newSV(0);
	sv_setuv(sv, (UV)rv);
	PUSHs(sv_2mortal(sv));
      }