import CDB_File 0.8 from CPAN

git-cpan-module:   CDB_File
git-cpan-version:  0.8
git-cpan-authorid: TIMPX
git-cpan-file:     authors/id/T/TI/TIMPX/CDB_File-0.8.tar.gz

ACKNOWLEDGE

 The help of these people is gratefully acknowledged.
 
     AK   Andreas Koenig <andreas.koenig@franz.ww.tu-berlin.de>
+    CMC  Chris Chalfant <chalfant_chris_m@lilly.com>
     DB   Dan Bernstein <djb@koobera.math.uic.edu>
+    GT   Gene Titus <gene@shalott.ots.utexas.edu>
     IP   Ian Phillipps <ian@dial.pipex.com>
     JB   Jos Backus <jos@oce.nl>
+    JPB  Joao Bordalo <jpb@ip.pt>
     MdlR Michael de la Rue <mikedlr@tardis.ed.ac.uk>
     MP   Mark Powell <mark@salford.ac.uk>
     NMS  Nickolay Saukh <nms@nns.ru>
@@ -11,5 +14,5 @@ The help of these people is gratefully acknowledged.
     SB   Stephen Beckstrom-Sternberg <sbeckstr@rapd.gig.usda.gov>
 
 Tim Goodwin
-<tgoodwin@cygnus.co.uk>
-1997-10-20
+<tjg@star.le.ac.uk>
+1999-09-08

CDB_File.pm

@@ -11,7 +11,7 @@ use Exporter ();
 @ISA = qw(Exporter DynaLoader);
 @EXPORT_OK = qw(create);
 
-$VERSION = '0.7';
+$VERSION = '0.8';
 
 =head1 NAME
 
@@ -242,7 +242,7 @@ cdb(3).
 
 =head1 AUTHOR
 
-Tim Goodwin, <tgoodwin@cygnus.co.uk>, 1997-01-08 - 1997-10-20.
+Tim Goodwin, <tjg@star.le.ac.uk>, 1997-01-08 - 1999-09-08.
 
 =cut
 

CDB_File.xs

@@ -114,9 +114,9 @@ cdb_TIEHASH(dbtype, filename)
 		RETVAL
 
 SV *
-cdb_FETCH(db, key)
+cdb_FETCH(db, k)
 	SV *		db
-	SV *		key
+	SV *		k
 
 	PROTOTYPE: $$
 
@@ -125,20 +125,23 @@ cdb_FETCH(db, key)
 	uint32 dlen;
 	int fd, found;
 	off_t pos;
+	STRLEN klen;
+	char *kp;
 
-	if (!SvOK(key)) {
+	if (!SvOK(k)) {
 		if (dowarn) warn(warn_uninit);
 		XSRETURN_UNDEF;
 	}
 	this = (struct cdbobj *)SvPV(SvRV(db), na);
 	fd = this->fd; /* This micro optimization makes a measurable difference. */
-	if (this->end && sv_eq(this->curkey, key)) {
-		pos = this->curpos + 8 + SvCUR(key);
+	kp = SvPV(k, klen);
+	if (this->end && sv_eq(this->curkey, k)) {
+		pos = this->curpos + 8 + klen;
 		if (lseek(fd, pos, SEEK_SET) != pos) seekerror();
 		dlen = this->curlen;
 		found = 1;
 	} else {
-		found = cdb_seek(fd, SvPV(key, na), SvCUR(key), &dlen);
+		found = cdb_seek(fd, kp, klen, &dlen);
 		if ((found != 0) && (found != 1)) readerror();
 	}
 	ST(0) = sv_newmortal();
@@ -150,22 +153,25 @@ cdb_FETCH(db, key)
 	}
 
 int
-cdb_EXISTS(db, key)
+cdb_EXISTS(db, k)
 	SV *		db
-	SV *		key
+	SV *		k
 
 	PROTOTYPE: $$
 
 	CODE:
 	struct cdbobj *this;
 	uint32 dlen;
+	STRLEN klen;
+	char *kp;
 
-	if (!SvOK(key)) {
+	if (!SvOK(k)) {
 		if (dowarn) warn(warn_uninit);
 		XSRETURN_NO;
 	}
 	this = (struct cdbobj *)SvPV(SvRV(db), na);
-	RETVAL = cdb_seek(this->fd, SvPV(key, na), SvCUR(key), &dlen);
+	kp = SvPV(k, klen);
+	RETVAL = cdb_seek(this->fd, kp, klen, &dlen);
 	if (RETVAL != 0 && RETVAL != 1) readerror();
 
 	OUTPUT:
@@ -216,34 +222,36 @@ cdb_FIRSTKEY(db)
 	}
 
 SV *
-cdb_NEXTKEY(db, key)
+cdb_NEXTKEY(db, k)
 	SV *		db
-	SV *		key
+	SV *		k
 
 	PROTOTYPE: $$
 
 	CODE:
 	struct cdbobj *this;
-	char buf[8];
+	char buf[8], *kp;
 	int fd, found;
 	off_t pos;
-	uint32 dlen, klen;
+	uint32 dlen, klen0;
+	STRLEN klen1;
 
-	if (!SvOK(key)) {
+	if (!SvOK(k)) {
 		if (dowarn) warn(warn_uninit);
 		XSRETURN_UNDEF;
 	}
 	this = (struct cdbobj *)SvPV(SvRV(db), na);
 	fd = this->fd;
 	if (this->end == 0) croak("Use CDB_File::FIRSTKEY before CDB_File::NEXTKEY");
-	if (sv_eq(this->curkey, key)) {
+	if (sv_eq(this->curkey, k)) {
 		if (lseek(fd, this->curpos, SEEK_SET) == -1) seekerror();
 		if (cdb_bread(fd, buf, 8) == -1) readerror();
-		klen = cdb_unpack(buf); dlen = cdb_unpack(buf + 4);
-		if ((pos = lseek(fd, klen + dlen, SEEK_CUR)) == -1) seekerror();
+		klen0 = cdb_unpack(buf); dlen = cdb_unpack(buf + 4);
+		if ((pos = lseek(fd, klen0 + dlen, SEEK_CUR)) == -1) seekerror();
 		found = 1;
 	} else {
-		found = cdb_seek(fd, SvPV(key, na), SvCUR(key), &dlen);
+		kp = SvPV(k, klen1);
+		found = cdb_seek(fd, kp, klen1, &dlen);
 		if (found != 0 && found != 1) readerror();
 		if (found)
 			if ((pos = lseek(fd, dlen, SEEK_CUR)) < 0) readerror();
@@ -251,13 +259,13 @@ cdb_NEXTKEY(db, key)
 	ST(0) = sv_newmortal();
 	if (found && (pos < this->end) && sv_upgrade(ST(0), SVt_PV)) {
 		if (cdb_bread(fd, buf, 8) == -1) readerror();
-		klen = cdb_unpack(buf); dlen = cdb_unpack(buf + 4);
+		klen0 = cdb_unpack(buf); dlen = cdb_unpack(buf + 4);
 		(void)SvPOK_only(ST(0));
-		SvGROW(ST(0), klen); SvCUR_set(ST(0), klen);
-		if (cdb_bread(fd, SvPVX(ST(0)), klen) == -1) readerror();
+		SvGROW(ST(0), klen0); SvCUR_set(ST(0), klen0);
+		if (cdb_bread(fd, SvPVX(ST(0)), klen0) == -1) readerror();
 		this->curpos = pos;
 		this->curlen = dlen;
-		sv_setpvn(this->curkey, SvPVX(ST(0)), klen);
+		sv_setpvn(this->curkey, SvPVX(ST(0)), klen0);
 	} else {
 		sv_setsv(this->curkey, &sv_undef);
 	}
@@ -312,13 +320,14 @@ cdb_insert(cdbmake, k, v)
 	PROTOTYPE: $$$
 
 	CODE:
-	char packbuf[8];
-	int c, i, klen, vlen;
+	char *kp, *vp, packbuf[8];
+	int c, i;
+	STRLEN klen, vlen;
 	struct cdbmakeobj *this;
 	uint32 h;
 
 	this = (struct cdbmakeobj *)SvPV(SvRV(cdbmake), na);
-	klen = SvCUR(k); vlen = SvCUR(v);
+	kp = SvPV(k, klen); vp = SvPV(v, vlen);
 	cdbmake_pack(packbuf, (uint32)klen);
 	cdbmake_pack(packbuf + 4, (uint32)vlen);
 
@@ -326,11 +335,11 @@ cdb_insert(cdbmake, k, v)
 
 	h = CDBMAKE_HASHSTART;
 	for (i = 0; i < klen; ++i) {
-		c = SvPV(k, na)[i];
+		c = kp[i];
 		h = cdbmake_hashadd(h, c);
 		if (putc(c, this->fi) == EOF) writeerror();
 	}
-	if (fwrite(SvPV(v, na), 1, vlen, this->fi) < vlen) writeerror();
+	if (fwrite(vp, 1, vlen, this->fi) < vlen) writeerror();
 
 	if (!cdbmake_add(&this->cdbm, h, this->pos, malloc)) nomem();
 	this->pos = safeadd(this->pos, (uint32) 8);

CHANGES

 Revision history for Perl extension CDB_File.
 
+0.8 1999-09-08
+	- fix bug with undefined keys / values (thanks CMC, JPB)
+	- beta release
+
 0.7 1997-10-20
 	- use Perl's Strerror instead of strerror
 	- fix bogus warning in multi_get (thanks MdlR)

COPYRIGHT

-The files in this directory are Copyright 1997-10-20, Tim Goodwin.
+The files in this directory are Copyright 1997, 1999 Tim Goodwin.
 
 You may redistribute them under the same terms as Perl itself.
 

INSTALL

 You need Perl 5.002 or later.
 
-It is not possible to compile CDB_File-0.7 if you are using sfio.
-Sorry.  I will soon be releasing CDB_File-0.8, which will work with
-sfio (but not with older versions of Perl).
+It is not possible to compile CDB_File-0.8 if you are using sfio.
+Sorry.  I will soon be releasing CDB_File-0.9, which will work with sfio
+(but not with older versions of Perl).
 
 1. Create a Makefile.
 
@@ -16,7 +16,7 @@ sfio (but not with older versions of Perl).
 
     make test
 
-You should see `ok 1' through to `ok 32'.  (Note: test 27 is known to
+You should see `ok 1' through to `ok 33'.  (Note: test 27 is known to
 fail with some older versions of Perl.  This test checks that Perl
 correctly gives a warning if you attempt to look up an undefined key, so
 the failure of this test has no material impact on the correct operation
@@ -38,5 +38,5 @@ instructions given during the build process.
 enhancements, please contact me.
 
 Tim Goodwin
-<tgoodwin@cygnus.co.uk>
+<tjg@star.le.ac.uk>
 1997-10-20

README

-This is release 0.7 of CDB_File.  See INSTALL for installation instructions.
+This is beta release 0.8 of CDB_File.  See INSTALL for installation
+instructions.
 
 CDB_File is a module which provides a Perl interface to Dan
 Berstein's cdb package:
@@ -12,4 +13,4 @@ Release 0.55 of cdb is included with this Perl module.
 
 Tim Goodwin
 <tgoodwin@cygnus.co.uk>
-1997-10-20
+1999-09-08

test.pl

 # Before `make install' is performed this script should be runnable with
 # `make test'. After `make install' it should work as `perl test.pl'
 
-BEGIN {print "1..32\n";}
+BEGIN {print "1..33\n";}
 END {print "not ok 1\n" unless $loaded;}
 use CDB_File;
 $loaded = 1;
 print "ok 1\n";
 
 # Test that attempt to tie to nonexist file fails.
-#tie %h, CDB_File, 'nonesuch.cdb' and print 'not ';
+tie %h, CDB_File, 'nonesuch.cdb' and print 'not ';
 print "ok 2\n";
 
 # Test that attempt to read incorrect file fails.
@@ -164,3 +164,14 @@ defined $h{'one'} or print "not ";
 print "ok 32\n";
 
 unlink 'good.cdb';
+
+# Test numeric data (broken before 0.8)
+$h = new CDB_File 't.cdb', 't.tmp' or print "not ";
+$h->insert(1, 1 * 23);
+$h->finish or print "not ";
+tie %h, CDB_File, 't.cdb' or print "not ";
+$h{1} == 23 or print "not ";
+untie %h;
+print "ok 33\n";
+
+unlink 't.cdb';