String-CRC32-1.5/0000755000175000017500000000000012260262735012736 5ustar soenkesoenkeString-CRC32-1.5/CRC32.xs0000644000175000017500000001255610421603121014060 0ustar soenkesoenke/* Perl Extension for 32bit CRC computations by Soenke J. Peters */ #include "EXTERN.h" #include "perl.h" #include "XSUB.h" /* Based on CRC-32 version 1.04 by Craig Bruce, 05-Dec-1994 */ #include #include #include #ifdef GENTABLE U32 crcTable[256]; void crcgen( void ) { U32 crc, poly; int i, j; poly = 0xEDB88320L; for (i=0; i<256; i++) { crc = i; for (j=8; j>0; j--) { if (crc&1) { crc = (crc >> 1) ^ poly; } else { crc >>= 1; } } crcTable[i] = crc; } } #else /* GENTABLE */ U32 crcTable[256] = { 0x0, 0x77073096, 0xee0e612c, 0x990951ba, 0x76dc419, 0x706af48f, 0xe963a535, 0x9e6495a3, 0xedb8832, 0x79dcb8a4, 0xe0d5e91e, 0x97d2d988, 0x9b64c2b, 0x7eb17cbd, 0xe7b82d07, 0x90bf1d91, 0x1db71064, 0x6ab020f2, 0xf3b97148, 0x84be41de, 0x1adad47d, 0x6ddde4eb, 0xf4d4b551, 0x83d385c7, 0x136c9856, 0x646ba8c0, 0xfd62f97a, 0x8a65c9ec, 0x14015c4f, 0x63066cd9, 0xfa0f3d63, 0x8d080df5, 0x3b6e20c8, 0x4c69105e, 0xd56041e4, 0xa2677172, 0x3c03e4d1, 0x4b04d447, 0xd20d85fd, 0xa50ab56b, 0x35b5a8fa, 0x42b2986c, 0xdbbbc9d6, 0xacbcf940, 0x32d86ce3, 0x45df5c75, 0xdcd60dcf, 0xabd13d59, 0x26d930ac, 0x51de003a, 0xc8d75180, 0xbfd06116, 0x21b4f4b5, 0x56b3c423, 0xcfba9599, 0xb8bda50f, 0x2802b89e, 0x5f058808, 0xc60cd9b2, 0xb10be924, 0x2f6f7c87, 0x58684c11, 0xc1611dab, 0xb6662d3d, 0x76dc4190, 0x1db7106, 0x98d220bc, 0xefd5102a, 0x71b18589, 0x6b6b51f, 0x9fbfe4a5, 0xe8b8d433, 0x7807c9a2, 0xf00f934, 0x9609a88e, 0xe10e9818, 0x7f6a0dbb, 0x86d3d2d, 0x91646c97, 0xe6635c01, 0x6b6b51f4, 0x1c6c6162, 0x856530d8, 0xf262004e, 0x6c0695ed, 0x1b01a57b, 0x8208f4c1, 0xf50fc457, 0x65b0d9c6, 0x12b7e950, 0x8bbeb8ea, 0xfcb9887c, 0x62dd1ddf, 0x15da2d49, 0x8cd37cf3, 0xfbd44c65, 0x4db26158, 0x3ab551ce, 0xa3bc0074, 0xd4bb30e2, 0x4adfa541, 0x3dd895d7, 0xa4d1c46d, 0xd3d6f4fb, 0x4369e96a, 0x346ed9fc, 0xad678846, 0xda60b8d0, 0x44042d73, 0x33031de5, 0xaa0a4c5f, 0xdd0d7cc9, 0x5005713c, 0x270241aa, 0xbe0b1010, 0xc90c2086, 0x5768b525, 0x206f85b3, 0xb966d409, 0xce61e49f, 0x5edef90e, 0x29d9c998, 0xb0d09822, 0xc7d7a8b4, 0x59b33d17, 0x2eb40d81, 0xb7bd5c3b, 0xc0ba6cad, 0xedb88320, 0x9abfb3b6, 0x3b6e20c, 0x74b1d29a, 0xead54739, 0x9dd277af, 0x4db2615, 0x73dc1683, 0xe3630b12, 0x94643b84, 0xd6d6a3e, 0x7a6a5aa8, 0xe40ecf0b, 0x9309ff9d, 0xa00ae27, 0x7d079eb1, 0xf00f9344, 0x8708a3d2, 0x1e01f268, 0x6906c2fe, 0xf762575d, 0x806567cb, 0x196c3671, 0x6e6b06e7, 0xfed41b76, 0x89d32be0, 0x10da7a5a, 0x67dd4acc, 0xf9b9df6f, 0x8ebeeff9, 0x17b7be43, 0x60b08ed5, 0xd6d6a3e8, 0xa1d1937e, 0x38d8c2c4, 0x4fdff252, 0xd1bb67f1, 0xa6bc5767, 0x3fb506dd, 0x48b2364b, 0xd80d2bda, 0xaf0a1b4c, 0x36034af6, 0x41047a60, 0xdf60efc3, 0xa867df55, 0x316e8eef, 0x4669be79, 0xcb61b38c, 0xbc66831a, 0x256fd2a0, 0x5268e236, 0xcc0c7795, 0xbb0b4703, 0x220216b9, 0x5505262f, 0xc5ba3bbe, 0xb2bd0b28, 0x2bb45a92, 0x5cb36a04, 0xc2d7ffa7, 0xb5d0cf31, 0x2cd99e8b, 0x5bdeae1d, 0x9b64c2b0, 0xec63f226, 0x756aa39c, 0x26d930a, 0x9c0906a9, 0xeb0e363f, 0x72076785, 0x5005713, 0x95bf4a82, 0xe2b87a14, 0x7bb12bae, 0xcb61b38, 0x92d28e9b, 0xe5d5be0d, 0x7cdcefb7, 0xbdbdf21, 0x86d3d2d4, 0xf1d4e242, 0x68ddb3f8, 0x1fda836e, 0x81be16cd, 0xf6b9265b, 0x6fb077e1, 0x18b74777, 0x88085ae6, 0xff0f6a70, 0x66063bca, 0x11010b5c, 0x8f659eff, 0xf862ae69, 0x616bffd3, 0x166ccf45, 0xa00ae278, 0xd70dd2ee, 0x4e048354, 0x3903b3c2, 0xa7672661, 0xd06016f7, 0x4969474d, 0x3e6e77db, 0xaed16a4a, 0xd9d65adc, 0x40df0b66, 0x37d83bf0, 0xa9bcae53, 0xdebb9ec5, 0x47b2cf7f, 0x30b5ffe9, 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 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)); } String-CRC32-1.5/MANIFEST0000644000175000017500000000042207022426263014063 0ustar soenkesoenkeREADME Makefile.PL t/crc.t # some tests t/testfile # a file to check during tests CRC32.xs # the heart of the module CRC32.pm CRC32.pod # documentation MANIFEST crcgen.c # use this to rebuild your crc table typemap # my typemap for a correct mapping from C types to perl String-CRC32-1.5/CRC32.pm0000644000175000017500000000044212260262340014040 0ustar soenkesoenke package String::CRC32; require Exporter; require DynaLoader; @ISA = qw(Exporter DynaLoader); $VERSION = 1.5; # Items to export into callers namespace by default @EXPORT = qw(crc32); # Other items we are prepared to export if requested @EXPORT_OK = qw(); bootstrap String::CRC32; 1; String-CRC32-1.5/t/0000755000175000017500000000000007022426266013202 5ustar soenkesoenkeString-CRC32-1.5/t/crc.t0000644000175000017500000000203307021503231014117 0ustar soenkesoenke#!/usr/local/bin/perl -I./blib/arch -I./blib/lib require String::CRC32; $string1 = "This is the test string"; $l1 = length($string1); print "1..", $l1+4, "\n"; print "\n1) Test the CRC of a string variable\n"; $v1 = String::CRC32::crc32($string1); print ($v1 == 1835534707 ? "ok 1\n" : "not ok 1\n"); print "\n2) Test the CRC of a string\n"; $v1 = String::CRC32::crc32("This is another test string"); print ($v1 == 2154698217 ? "ok 2\n" : "not ok 2\n"); $i = 2; $l=$l1+3; print "\n3..$l) Test the CRC of various substrings (using crcinit)\n"; for ($j = 0; $j <= $l1; $j++) { $v1 = String::CRC32::crc32(substr($string1, 0, $j)); $v1 = String::CRC32::crc32(substr($string1, $j), $v1); $i++; print ($v1 == 1835534707 ? "ok $i\n" : "not ok $i\n"); } $l=$l1+4; print "\n$l) Test the CRC of a file\n"; $i++; open(TESTFILE,"testfile") || open(TESTFILE,"t/testfile") || open(TESTFILE," ../testfile") || die "No such file!\n"; $v1 = String::CRC32::crc32(*TESTFILE); close TESTFILE; print ($v1 == 1925609391 ? "ok $i\n" : "not ok $i\n"); String-CRC32-1.5/t/testfile0000644000175000017500000000011107020777106014735 0ustar soenkesoenkeDo not alter this file! Changing this file will result in a failing test!String-CRC32-1.5/crcgen.c0000644000175000017500000000111510224254313014330 0ustar soenkesoenke/* Generation of CRC lookup table as used in Perl module "String::CRC32" 1999 by Soenke J. Peters */ #include int main ( void ) { unsigned long crc, poly; int i, j; poly = 0xEDB88320L; printf("unigned long\ncrcTable[256] = {\n"); for (i=0; i<256; i++) { crc = i; for (j=8; j>0; j--) { if (crc&1) { crc = (crc >> 1) ^ poly; } else { crc >>= 1; } } printf( "0x%lx,", crc); if( (i&7) == 7 ) printf("\n" ); else printf(" "); } printf("};\n"); return 0; } String-CRC32-1.5/README0000644000175000017500000000140312260262734013613 0ustar soenkesoenke Perl Module String::CRC32 This packages provides a perl module to generate checksums from strings and from files. Written 19990310 by Soenke J. Peters . The checksums are the same as those calculated by ZMODEM, PKZIP, PICCHECK and many others. There's another perl module called String::CRC which allows to calculate not only 32 bit CRC numbers, but the generated sums differ from those of the programs mentioned above. Installation: "perl Makefile.PL" "make" "make test" "make install" If you find any bugs, please send me a good description (or a patch ;-) ). Thanks to s0lar(at)gmx.li who sent me a patch to replace PerlIO_getc with PerlIO_read to improve performance. Have fun, Soenke J. Peters Hamburg, Germany String-CRC32-1.5/typemap0000444000175000017500000001415007022425025014330 0ustar soenkesoenke# $Header$ # basic C types int T_IV unsigned T_UV unsigned int T_UV long T_IV unsigned long T_UV short T_IV unsigned short T_UV char T_CHAR unsigned char T_U_CHAR char * T_PV unsigned char * T_PV caddr_t T_PV wchar_t * T_PV wchar_t T_IV bool_t T_IV size_t T_IV ssize_t T_IV time_t T_NV unsigned long * T_OPAQUEPTR char ** T_PACKED void * T_PTR Time_t * T_PV SV * T_SV SVREF T_SVREF AV * T_AVREF HV * T_HVREF CV * T_CVREF IV T_IV I32 T_IV I16 T_IV I8 T_IV U32 T_U_LONG U16 T_U_SHORT U8 T_UV Result T_U_CHAR Boolean T_IV double T_DOUBLE SysRet T_SYSRET SysRetLong T_SYSRET FILE * T_IN FileHandle T_PTROBJ InputStream T_IN InOutStream T_INOUT OutputStream T_OUT bool T_BOOL ############################################################################# INPUT T_SV $var = $arg T_SVREF if (sv_isa($arg, \"${ntype}\")) $var = (SV*)SvRV($arg); else croak(\"$var is not of type ${ntype}\") T_AVREF if (sv_isa($arg, \"${ntype}\")) $var = (AV*)SvRV($arg); else croak(\"$var is not of type ${ntype}\") T_HVREF if (sv_isa($arg, \"${ntype}\")) $var = (HV*)SvRV($arg); else croak(\"$var is not of type ${ntype}\") T_CVREF if (sv_isa($arg, \"${ntype}\")) $var = (CV*)SvRV($arg); else croak(\"$var is not of type ${ntype}\") T_SYSRET $var NOT IMPLEMENTED T_UV $var = ($type)SvUV($arg) T_IV $var = ($type)SvIV($arg) T_INT $var = (int)SvIV($arg) T_ENUM $var = ($type)SvIV($arg) T_BOOL $var = (int)SvIV($arg) T_U_INT $var = (unsigned int)SvUV($arg) T_SHORT $var = (short)SvIV($arg) T_U_SHORT $var = (unsigned short)SvUV($arg) T_LONG $var = (long)SvIV($arg) T_U_LONG $var = (unsigned long)SvUV($arg) T_CHAR $var = (char)*SvPV($arg,PL_na) T_U_CHAR $var = (unsigned char)SvUV($arg) T_FLOAT $var = (float)SvNV($arg) T_NV $var = ($type)SvNV($arg) T_DOUBLE $var = (double)SvNV($arg) T_PV $var = ($type)SvPV($arg,PL_na) T_PTR $var = ($type)SvIV($arg) T_PTRREF if (SvROK($arg)) { IV tmp = SvIV((SV*)SvRV($arg)); $var = ($type) tmp; } else croak(\"$var is not a reference\") T_REF_IV_REF if (sv_isa($arg, \"${type}\")) { IV tmp = SvIV((SV*)SvRV($arg)); $var = *($type *) tmp; } else croak(\"$var is not of type ${ntype}\") T_REF_IV_PTR if (sv_isa($arg, \"${type}\")) { IV tmp = SvIV((SV*)SvRV($arg)); $var = ($type) tmp; } else croak(\"$var is not of type ${ntype}\") T_PTROBJ if (sv_derived_from($arg, \"${ntype}\")) { IV tmp = SvIV((SV*)SvRV($arg)); $var = ($type) tmp; } else croak(\"$var is not of type ${ntype}\") T_PTRDESC if (sv_isa($arg, \"${ntype}\")) { IV tmp = SvIV((SV*)SvRV($arg)); ${type}_desc = (\U${type}_DESC\E*) tmp; $var = ${type}_desc->ptr; } else croak(\"$var is not of type ${ntype}\") T_REFREF if (SvROK($arg)) { IV tmp = SvIV((SV*)SvRV($arg)); $var = *($type) tmp; } else croak(\"$var is not a reference\") T_REFOBJ if (sv_isa($arg, \"${ntype}\")) { IV tmp = SvIV((SV*)SvRV($arg)); $var = *($type) tmp; } else croak(\"$var is not of type ${ntype}\") T_OPAQUE $var NOT IMPLEMENTED T_OPAQUEPTR $var = ($type)SvPV($arg,PL_na) T_PACKED $var = XS_unpack_$ntype($arg) T_PACKEDARRAY $var = XS_unpack_$ntype($arg) T_CALLBACK $var = make_perl_cb_$type($arg) T_ARRAY $var = $ntype(items -= $argoff); U32 ix_$var = $argoff; while (items--) { DO_ARRAY_ELEM; } T_IN $var = IoIFP(sv_2io($arg)) T_INOUT $var = IoIFP(sv_2io($arg)) T_OUT $var = IoOFP(sv_2io($arg)) ############################################################################# OUTPUT T_SV $arg = $var; T_SVREF $arg = newRV((SV*)$var); T_AVREF $arg = newRV((SV*)$var); T_HVREF $arg = newRV((SV*)$var); T_CVREF $arg = newRV((SV*)$var); T_IV sv_setiv($arg, (IV)$var); T_UV sv_setuv($arg, (UV)$var); T_INT sv_setiv($arg, (IV)$var); T_SYSRET if ($var != -1) { if ($var == 0) sv_setpvn($arg, "0 but true", 10); else sv_setiv($arg, (IV)$var); } T_ENUM sv_setiv($arg, (IV)$var); T_BOOL $arg = boolSV($var); T_U_INT sv_setuv($arg, (UV)$var); T_SHORT sv_setiv($arg, (IV)$var); T_U_SHORT sv_setuv($arg, (UV)$var); T_LONG sv_setiv($arg, (IV)$var); T_U_LONG sv_setuv($arg, (UV)$var); T_CHAR sv_setpvn($arg, (char *)&$var, 1); T_U_CHAR sv_setuv($arg, (UV)$var); T_FLOAT sv_setnv($arg, (double)$var); T_NV sv_setnv($arg, (double)$var); T_DOUBLE sv_setnv($arg, (double)$var); T_PV sv_setpv((SV*)$arg, $var); T_PTR sv_setiv($arg, (IV)$var); T_PTRREF sv_setref_pv($arg, Nullch, (void*)$var); T_REF_IV_REF sv_setref_pv($arg, \"${ntype}\", (void*)new $ntype($var)); T_REF_IV_PTR sv_setref_pv($arg, \"${ntype}\", (void*)$var); T_PTROBJ sv_setref_pv($arg, \"${ntype}\", (void*)$var); T_PTRDESC sv_setref_pv($arg, \"${ntype}\", (void*)new\U${type}_DESC\E($var)); T_REFREF sv_setrefref($arg, \"${ntype}\", XS_service_$ntype, ($var ? (void*)new $ntype($var) : 0)); T_REFOBJ NOT IMPLEMENTED T_OPAQUE sv_setpvn($arg, (char *)&$var, sizeof($var)); T_OPAQUEPTR sv_setpvn($arg, (char *)$var, sizeof(*$var)), XFree((char *)$var); T_PACKED XS_pack_$ntype($arg, $var); T_PACKEDARRAY XS_pack_$ntype($arg, $var, count_$ntype); T_DATAUNIT sv_setpvn($arg, $var.chp(), $var.size()); T_CALLBACK sv_setpvn($arg, $var.context.value().chp(), $var.context.value().size()); T_ARRAY ST_EXTEND($var.size); for (U32 ix_$var = 0; ix_$var < $var.size; ix_$var++) { ST(ix_$var) = sv_newmortal(); DO_ARRAY_ELEM } SP += $var.size - 1; T_IN { GV *gv = newGVgen("$Package"); if ( do_open(gv, "<&", 2, FALSE, 0, 0, $var) ) sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1))); else $arg = &PL_sv_undef; } T_INOUT { GV *gv = newGVgen("$Package"); if ( do_open(gv, "+<&", 3, FALSE, 0, 0, $var) ) sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1))); else $arg = &PL_sv_undef; } T_OUT { GV *gv = newGVgen("$Package"); if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) ) sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1))); else $arg = &PL_sv_undef; } # SJP TYPEMAP pdl* T_PDL pdl * T_PDL Logical T_IV float T_NV INPUT T_PDL $var = PDL->SvPDLV($arg) OUTPUT T_PDL PDL->SetSV_PDL($arg,$var); String-CRC32-1.5/Makefile.PL0000644000175000017500000000050712260262355014710 0ustar soenkesoenke#! /usr/local/bin/perl use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile being created. WriteMakefile( 'NAME' => 'String::CRC32', 'DISTNAME' => 'String-CRC32', 'VERSION' => '1.5', 'OBJECT' => 'CRC32.o', 'dist' => {COMPRESS=>'gzip', SUFFIX=>'gz'} ); String-CRC32-1.5/CRC32.pod0000644000175000017500000000304612260262476014223 0ustar soenkesoenke=head1 NAME String::CRC32 - Perl interface for cyclic redundency check generation =head1 SYNOPSIS use String::CRC32; $crc = crc32("some string"); $crc = crc32("some string", initvalue); $somestring = "some string"; $crc = crc32($somestring); open(SOMEFILE, "location/of/some.file"); binmode SOMEFILE; $crc = crc32(*SOMEFILE); close(SOMEFILE); =head1 DESCRIPTION The B module calculates CRC sums of 32 bit lenghts. It generates the same CRC values as ZMODEM, PKZIP, PICCHECK and many others. Despite its name, this module is able to compute the checksum of files as well as strings. =head1 EXAMPLES $crc = crc32("some string"); results in the same as $crc = crc32(" string", crc32("some")); This is useful for subsequent CRC checking of substrings. You may even check files: open(SOMEFILE, "location/of/some.file"); binmode SOMEFILE; $crc = crc32(*SOMEFILE); close(SOMEFILE); A init value may also been supplied in the above example. =head1 AUTHOR Soenke J. Peters Please be so kind as to report any bugs/suggestions to the above address. =head1 COPYRIGHT CRC algorithm code taken from CRC-32 by Craig Bruce. The module stuff is inspired by a similar perl module called String::CRC by David Sharnoff & Matthew Dillon. Horst Fickenscher told me that it could be useful to supply an init value to the crc checking function and so I included this possibility. The author of this package disclaims all copyrights and releases it into the public domain.