3 DB_File.xs -- Perl 5 interface to Berkeley DB
5 written by Paul Marquess (pmarquess@bfsec.bt.co.uk)
6 last modified 14th November 1995
9 All comments/suggestions/problems are welcome
13 0.2 - No longer bombs out if dbopen returns an error.
14 0.3 - Added some support for multiple btree compares
15 1.0 - Complete support for multiple callbacks added.
16 Fixed a problem with pushing a value onto an empty list.
17 1.01 - Fixed a SunOS core dump problem.
18 The return value from TIEHASH wasn't set to NULL when
19 dbopen returned an error.
38 typedef DB_File_type * DB_File ;
50 #define db_DESTROY(db) ((db->dbp)->close)(db->dbp)
51 #define db_DELETE(db, key, flags) ((db->dbp)->del)(db->dbp, &key, flags)
52 #define db_STORE(db, key, value, flags) ((db->dbp)->put)(db->dbp, &key, &value, flags)
53 #define db_FETCH(db, key, flags) ((db->dbp)->get)(db->dbp, &key, &value, flags)
55 #define db_close(db) ((db->dbp)->close)(db->dbp)
56 #define db_del(db, key, flags) ((db->dbp)->del)(db->dbp, &key, flags)
57 #define db_fd(db) ((db->dbp)->fd)(db->dbp)
58 #define db_put(db, key, value, flags) ((db->dbp)->put)(db->dbp, &key, &value, flags)
59 #define db_get(db, key, value, flags) ((db->dbp)->get)(db->dbp, &key, &value, flags)
60 #define db_seq(db, key, value, flags) ((db->dbp)->seq)(db->dbp, &key, &value, flags)
61 #define db_sync(db, flags) ((db->dbp)->sync)(db->dbp, flags)
64 #define OutputValue(arg, name) \
65 { if (RETVAL == 0) sv_setpvn(arg, name.data, name.size) ; }
67 #define OutputKey(arg, name) \
70 if (db->type != DB_RECNO) \
71 sv_setpvn(arg, name.data, name.size); \
73 sv_setiv(arg, (I32)*(I32*)name.data - 1); \
77 /* Internal Global Data */
78 static recno_t Value ;
79 static DB_File CurrentDB ;
80 static recno_t zero = 0 ;
81 static DBTKEY empty = { &zero, sizeof(recno_t) } ;
85 btree_compare(key1, key2)
90 void * data1, * data2 ;
97 /* As newSVpv will assume that the data pointer is a null terminated C
98 string if the size parameter is 0, make sure that data points to an
99 empty string if the length is 0
111 PUSHs(sv_2mortal(newSVpv(data1,key1->size)));
112 PUSHs(sv_2mortal(newSVpv(data2,key2->size)));
115 count = perl_call_sv(CurrentDB->compare, G_SCALAR);
120 croak ("DB_File btree_compare: expected 1 return value from %s, got %d\n", count) ;
132 btree_prefix(key1, key2)
137 void * data1, * data2 ;
144 /* As newSVpv will assume that the data pointer is a null terminated C
145 string if the size parameter is 0, make sure that data points to an
146 empty string if the length is 0
158 PUSHs(sv_2mortal(newSVpv(data1,key1->size)));
159 PUSHs(sv_2mortal(newSVpv(data2,key2->size)));
162 count = perl_call_sv(CurrentDB->prefix, G_SCALAR);
167 croak ("DB_File btree_prefix: expected 1 return value from %s, got %d\n", count) ;
191 XPUSHs(sv_2mortal(newSVpv((char*)data,size)));
194 count = perl_call_sv(CurrentDB->hash, G_SCALAR);
199 croak ("DB_File hash_cb: expected 1 return value from %s, got %d\n", count) ;
217 printf ("HASH Info\n") ;
218 printf (" hash = %s\n", (hash.hash != NULL ? "redefined" : "default")) ;
219 printf (" bsize = %d\n", hash.bsize) ;
220 printf (" ffactor = %d\n", hash.ffactor) ;
221 printf (" nelem = %d\n", hash.nelem) ;
222 printf (" cachesize = %d\n", hash.cachesize) ;
223 printf (" lorder = %d\n", hash.lorder) ;
231 printf ("RECNO Info\n") ;
232 printf (" flags = %d\n", recno.flags) ;
233 printf (" cachesize = %d\n", recno.cachesize) ;
234 printf (" psize = %d\n", recno.psize) ;
235 printf (" lorder = %d\n", recno.lorder) ;
236 printf (" reclen = %d\n", recno.reclen) ;
237 printf (" bval = %d\n", recno.bval) ;
238 printf (" bfname = %s\n", recno.bfname) ;
244 printf ("BTREE Info\n") ;
245 printf (" compare = %s\n", (btree.compare ? "redefined" : "default")) ;
246 printf (" prefix = %s\n", (btree.prefix ? "redefined" : "default")) ;
247 printf (" flags = %d\n", btree.flags) ;
248 printf (" cachesize = %d\n", btree.cachesize) ;
249 printf (" psize = %d\n", btree.psize) ;
250 printf (" maxkeypage = %d\n", btree.maxkeypage) ;
251 printf (" minkeypage = %d\n", btree.minkeypage) ;
252 printf (" lorder = %d\n", btree.lorder) ;
257 #define PrintRecno(recno)
258 #define PrintHash(hash)
259 #define PrintBtree(btree)
272 RETVAL = (db->seq)(db, &key, &value, R_LAST) ;
274 RETVAL = *(I32 *)key.data ;
275 else if (RETVAL == 1) /* No key means empty file */
282 ParseOpenInfo(name, flags, mode, sv, string)
292 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
293 void * openinfo = NULL ;
294 /* DBTYPE type = DB_HASH ; */
296 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
297 RETVAL->type = DB_HASH ;
302 croak ("type parameter is not a reference") ;
304 action = (HV*)SvRV(sv);
305 if (sv_isa(sv, "DB_File::HASHINFO"))
307 RETVAL->type = DB_HASH ;
308 openinfo = (void*)&info ;
310 svp = hv_fetch(action, "hash", 4, FALSE);
312 if (svp && SvOK(*svp))
314 info.hash.hash = hash_cb ;
315 RETVAL->hash = newSVsv(*svp) ;
318 info.hash.hash = NULL ;
320 svp = hv_fetch(action, "bsize", 5, FALSE);
321 info.hash.bsize = svp ? SvIV(*svp) : 0;
323 svp = hv_fetch(action, "ffactor", 7, FALSE);
324 info.hash.ffactor = svp ? SvIV(*svp) : 0;
326 svp = hv_fetch(action, "nelem", 5, FALSE);
327 info.hash.nelem = svp ? SvIV(*svp) : 0;
329 svp = hv_fetch(action, "cachesize", 9, FALSE);
330 info.hash.cachesize = svp ? SvIV(*svp) : 0;
332 svp = hv_fetch(action, "lorder", 6, FALSE);
333 info.hash.lorder = svp ? SvIV(*svp) : 0;
337 else if (sv_isa(sv, "DB_File::BTREEINFO"))
339 RETVAL->type = DB_BTREE ;
340 openinfo = (void*)&info ;
342 svp = hv_fetch(action, "compare", 7, FALSE);
343 if (svp && SvOK(*svp))
345 info.btree.compare = btree_compare ;
346 RETVAL->compare = newSVsv(*svp) ;
349 info.btree.compare = NULL ;
351 svp = hv_fetch(action, "prefix", 6, FALSE);
352 if (svp && SvOK(*svp))
354 info.btree.prefix = btree_prefix ;
355 RETVAL->prefix = newSVsv(*svp) ;
358 info.btree.prefix = NULL ;
360 svp = hv_fetch(action, "flags", 5, FALSE);
361 info.btree.flags = svp ? SvIV(*svp) : 0;
363 svp = hv_fetch(action, "cachesize", 9, FALSE);
364 info.btree.cachesize = svp ? SvIV(*svp) : 0;
366 svp = hv_fetch(action, "minkeypage", 10, FALSE);
367 info.btree.minkeypage = svp ? SvIV(*svp) : 0;
369 svp = hv_fetch(action, "maxkeypage", 10, FALSE);
370 info.btree.maxkeypage = svp ? SvIV(*svp) : 0;
372 svp = hv_fetch(action, "psize", 5, FALSE);
373 info.btree.psize = svp ? SvIV(*svp) : 0;
375 svp = hv_fetch(action, "lorder", 6, FALSE);
376 info.btree.lorder = svp ? SvIV(*svp) : 0;
381 else if (sv_isa(sv, "DB_File::RECNOINFO"))
383 RETVAL->type = DB_RECNO ;
384 openinfo = (void *)&info ;
386 svp = hv_fetch(action, "flags", 5, FALSE);
387 info.recno.flags = (u_long) svp ? SvIV(*svp) : 0;
389 svp = hv_fetch(action, "cachesize", 9, FALSE);
390 info.recno.cachesize = (u_int) svp ? SvIV(*svp) : 0;
392 svp = hv_fetch(action, "psize", 5, FALSE);
393 info.recno.psize = (int) svp ? SvIV(*svp) : 0;
395 svp = hv_fetch(action, "lorder", 6, FALSE);
396 info.recno.lorder = (int) svp ? SvIV(*svp) : 0;
398 svp = hv_fetch(action, "reclen", 6, FALSE);
399 info.recno.reclen = (size_t) svp ? SvIV(*svp) : 0;
401 svp = hv_fetch(action, "bval", 4, FALSE);
402 if (svp && SvOK(*svp))
405 info.recno.bval = (u_char)*SvPV(*svp, na) ;
407 info.recno.bval = (u_char)(unsigned long) SvIV(*svp) ;
411 if (info.recno.flags & R_FIXEDLEN)
412 info.recno.bval = (u_char) ' ' ;
414 info.recno.bval = (u_char) '\n' ;
417 svp = hv_fetch(action, "bfname", 6, FALSE);
418 info.recno.bfname = (char *) svp ? SvPV(*svp,na) : 0;
423 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
427 RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ;
430 /* kludge mode on: RETVAL->type for DB_RECNO is set to DB_BTREE
431 so remember a DB_RECNO by saving the address
432 of one of it's internal routines
434 if (RETVAL->dbp && type == DB_RECNO)
435 DB_recno_close = RETVAL->dbp->close ;
447 croak("DB_File::%s not implemented on this architecture", s);
461 if (strEQ(name, "BTREEMAGIC"))
467 if (strEQ(name, "BTREEVERSION"))
477 if (strEQ(name, "DB_LOCK"))
483 if (strEQ(name, "DB_SHMEM"))
489 if (strEQ(name, "DB_TXN"))
503 if (strEQ(name, "HASHMAGIC"))
509 if (strEQ(name, "HASHVERSION"))
525 if (strEQ(name, "MAX_PAGE_NUMBER"))
526 #ifdef MAX_PAGE_NUMBER
527 return (U32)MAX_PAGE_NUMBER;
531 if (strEQ(name, "MAX_PAGE_OFFSET"))
532 #ifdef MAX_PAGE_OFFSET
533 return MAX_PAGE_OFFSET;
537 if (strEQ(name, "MAX_REC_NUMBER"))
538 #ifdef MAX_REC_NUMBER
539 return (U32)MAX_REC_NUMBER;
553 if (strEQ(name, "RET_ERROR"))
559 if (strEQ(name, "RET_SPECIAL"))
565 if (strEQ(name, "RET_SUCCESS"))
571 if (strEQ(name, "R_CURSOR"))
577 if (strEQ(name, "R_DUP"))
583 if (strEQ(name, "R_FIRST"))
589 if (strEQ(name, "R_FIXEDLEN"))
595 if (strEQ(name, "R_IAFTER"))
601 if (strEQ(name, "R_IBEFORE"))
607 if (strEQ(name, "R_LAST"))
613 if (strEQ(name, "R_NEXT"))
619 if (strEQ(name, "R_NOKEY"))
625 if (strEQ(name, "R_NOOVERWRITE"))
627 return R_NOOVERWRITE;
631 if (strEQ(name, "R_PREV"))
637 if (strEQ(name, "R_RECNOSYNC"))
643 if (strEQ(name, "R_SETCURSOR"))
649 if (strEQ(name, "R_SNAPSHOT"))
673 if (strEQ(name, "__R_UNUSED"))
689 MODULE = DB_File PACKAGE = DB_File PREFIX = db_
698 db_TIEHASH(dbtype, name=undef, flags=O_RDWR, mode=0640, type=DB_HASH)
704 char * name = (char *) NULL ;
705 SV * sv = (SV *) NULL ;
707 if (items >= 2 && SvOK(ST(1)))
708 name = (char*) SvPV(ST(1), na) ;
713 RETVAL = ParseOpenInfo(name, flags, mode, sv, "new") ;
714 if (RETVAL->dbp == NULL)
721 newXS("DB_File::TIEARRAY", XS_DB_File_db_TIEHASH, file);
730 SvREFCNT_dec(db->hash) ;
732 SvREFCNT_dec(db->compare) ;
734 SvREFCNT_dec(db->prefix) ;
739 db_DELETE(db, key, flags=0)
747 db_FETCH(db, key, flags=0)
756 RETVAL = ((db->dbp)->get)(db->dbp, &key, &value, flags) ;
757 ST(0) = sv_newmortal();
759 sv_setpvn(ST(0), value.data, value.size);
763 db_STORE(db, key, value, flags=0)
782 RETVAL = (Db->seq)(Db, &key, &value, R_FIRST) ;
783 ST(0) = sv_newmortal();
786 if (Db->type != DB_RECNO)
787 sv_setpvn(ST(0), key.data, key.size);
789 sv_setiv(ST(0), (I32)*(I32*)key.data - 1);
803 RETVAL = (Db->seq)(Db, &key, &value, R_NEXT) ;
804 ST(0) = sv_newmortal();
807 if (Db->type != DB_RECNO)
808 sv_setpvn(ST(0), key.data, key.size);
810 sv_setiv(ST(0), (I32)*(I32*)key.data - 1);
815 # These would be nice for RECNO
831 for (i = items-1 ; i > 0 ; --i)
833 value.data = SvPV(ST(i), na) ;
837 key.size = sizeof(int) ;
838 RETVAL = (Db->put)(Db, &key, &value, R_IBEFORE) ;
856 /* First get the final value */
857 RETVAL = (Db->seq)(Db, &key, &value, R_LAST) ;
858 ST(0) = sv_newmortal();
862 RETVAL = (Db->del)(Db, &key, R_CURSOR) ;
864 sv_setpvn(ST(0), value.data, value.size);
878 /* get the first value */
879 RETVAL = (Db->seq)(Db, &key, &value, R_FIRST) ;
880 ST(0) = sv_newmortal();
884 RETVAL = (Db->del)(Db, &key, R_CURSOR) ;
886 sv_setpvn(ST(0), value.data, value.size);
897 DBTKEY * keyptr = &key ;
903 /* Set the Cursor to the Last element */
904 RETVAL = (Db->seq)(Db, &key, &value, R_LAST) ;
909 for (i = items - 1 ; i > 0 ; --i)
911 value.data = SvPV(ST(i), na) ;
913 RETVAL = (Db->put)(Db, keyptr, &value, R_IAFTER) ;
928 RETVAL = GetArrayLength(db->dbp) ;
934 # Now provide an interface to the rest of the DB functionality
938 db_del(db, key, flags=0)
947 db_get(db, key, value, flags=0)
958 db_put(db, key, value, flags=0)
966 key if (flags & (R_IAFTER|R_IBEFORE)) OutputKey(ST(1), key);
983 db_seq(db, key, value, flags)