3 DB_File.xs -- Perl 5 interface to Berkeley DB
5 written by Paul Marquess (pmarquess@bfsec.bt.co.uk)
6 last modified 26th June 1996
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.
20 1.02 - Use ALIAS to define TIEARRAY.
21 Removed some redundant commented code.
22 Merged OS2 code into the main distribution.
23 Allow negative subscripts with RECNO interface.
24 Changed the default flags to O_CREAT|O_RDWR
43 typedef DB_File_type * DB_File ;
55 #define db_DESTROY(db) ((db->dbp)->close)(db->dbp)
56 #define db_DELETE(db, key, flags) ((db->dbp)->del)(db->dbp, &key, flags)
57 #define db_STORE(db, key, value, flags) ((db->dbp)->put)(db->dbp, &key, &value, flags)
58 #define db_FETCH(db, key, flags) ((db->dbp)->get)(db->dbp, &key, &value, flags)
60 #define db_close(db) ((db->dbp)->close)(db->dbp)
61 #define db_del(db, key, flags) ((db->dbp)->del)(db->dbp, &key, flags)
62 #define db_fd(db) ((db->dbp)->fd)(db->dbp)
63 #define db_put(db, key, value, flags) ((db->dbp)->put)(db->dbp, &key, &value, flags)
64 #define db_get(db, key, value, flags) ((db->dbp)->get)(db->dbp, &key, &value, flags)
65 #define db_seq(db, key, value, flags) ((db->dbp)->seq)(db->dbp, &key, &value, flags)
66 #define db_sync(db, flags) ((db->dbp)->sync)(db->dbp, flags)
69 #define OutputValue(arg, name) \
70 { if (RETVAL == 0) { \
71 sv_setpvn(arg, name.data, name.size) ; \
75 #define OutputKey(arg, name) \
78 if (db->type != DB_RECNO) { \
79 sv_setpvn(arg, name.data, name.size); \
82 sv_setiv(arg, (I32)*(I32*)name.data - 1); \
86 /* Internal Global Data */
87 static recno_t Value ;
88 static DB_File CurrentDB ;
89 static recno_t zero = 0 ;
90 static DBTKEY empty = { &zero, sizeof(recno_t) } ;
94 btree_compare(key1, key2)
99 void * data1, * data2 ;
106 /* As newSVpv will assume that the data pointer is a null terminated C
107 string if the size parameter is 0, make sure that data points to an
108 empty string if the length is 0
120 PUSHs(sv_2mortal(newSVpv(data1,key1->size)));
121 PUSHs(sv_2mortal(newSVpv(data2,key2->size)));
124 count = perl_call_sv(CurrentDB->compare, G_SCALAR);
129 croak ("DB_File btree_compare: expected 1 return value from %s, got %d\n", count) ;
141 btree_prefix(key1, key2)
146 void * data1, * data2 ;
153 /* As newSVpv will assume that the data pointer is a null terminated C
154 string if the size parameter is 0, make sure that data points to an
155 empty string if the length is 0
167 PUSHs(sv_2mortal(newSVpv(data1,key1->size)));
168 PUSHs(sv_2mortal(newSVpv(data2,key2->size)));
171 count = perl_call_sv(CurrentDB->prefix, G_SCALAR);
176 croak ("DB_File btree_prefix: expected 1 return value from %s, got %d\n", count) ;
200 XPUSHs(sv_2mortal(newSVpv((char*)data,size)));
203 count = perl_call_sv(CurrentDB->hash, G_SCALAR);
208 croak ("DB_File hash_cb: expected 1 return value from %s, got %d\n", count) ;
226 printf ("HASH Info\n") ;
227 printf (" hash = %s\n", (hash.hash != NULL ? "redefined" : "default")) ;
228 printf (" bsize = %d\n", hash.bsize) ;
229 printf (" ffactor = %d\n", hash.ffactor) ;
230 printf (" nelem = %d\n", hash.nelem) ;
231 printf (" cachesize = %d\n", hash.cachesize) ;
232 printf (" lorder = %d\n", hash.lorder) ;
240 printf ("RECNO Info\n") ;
241 printf (" flags = %d\n", recno.flags) ;
242 printf (" cachesize = %d\n", recno.cachesize) ;
243 printf (" psize = %d\n", recno.psize) ;
244 printf (" lorder = %d\n", recno.lorder) ;
245 printf (" reclen = %d\n", recno.reclen) ;
246 printf (" bval = %d\n", recno.bval) ;
247 printf (" bfname = %d [%s]\n", recno.bfname, recno.bfname) ;
253 printf ("BTREE Info\n") ;
254 printf (" compare = %s\n", (btree.compare ? "redefined" : "default")) ;
255 printf (" prefix = %s\n", (btree.prefix ? "redefined" : "default")) ;
256 printf (" flags = %d\n", btree.flags) ;
257 printf (" cachesize = %d\n", btree.cachesize) ;
258 printf (" psize = %d\n", btree.psize) ;
259 printf (" maxkeypage = %d\n", btree.maxkeypage) ;
260 printf (" minkeypage = %d\n", btree.minkeypage) ;
261 printf (" lorder = %d\n", btree.lorder) ;
266 #define PrintRecno(recno)
267 #define PrintHash(hash)
268 #define PrintBtree(btree)
281 RETVAL = (db->seq)(db, &key, &value, R_LAST) ;
283 RETVAL = *(I32 *)key.data ;
284 else if (RETVAL == 1) /* No key means empty file */
291 GetRecnoKey(db, value)
296 /* Get the length of the array */
297 I32 length = GetArrayLength(db->dbp) ;
299 /* check for attempt to write before start of array */
300 if (length + value + 1 <= 0)
301 croak("Modification of non-creatable array value attempted, subscript %d", value) ;
303 value = length + value + 1 ;
312 ParseOpenInfo(name, flags, mode, sv, string)
322 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
323 void * openinfo = NULL ;
325 /* Default to HASH */
326 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
327 RETVAL->type = DB_HASH ;
332 croak ("type parameter is not a reference") ;
334 action = (HV*)SvRV(sv);
335 if (sv_isa(sv, "DB_File::HASHINFO"))
337 RETVAL->type = DB_HASH ;
338 openinfo = (void*)&info ;
340 svp = hv_fetch(action, "hash", 4, FALSE);
342 if (svp && SvOK(*svp))
344 info.hash.hash = hash_cb ;
345 RETVAL->hash = newSVsv(*svp) ;
348 info.hash.hash = NULL ;
350 svp = hv_fetch(action, "bsize", 5, FALSE);
351 info.hash.bsize = svp ? SvIV(*svp) : 0;
353 svp = hv_fetch(action, "ffactor", 7, FALSE);
354 info.hash.ffactor = svp ? SvIV(*svp) : 0;
356 svp = hv_fetch(action, "nelem", 5, FALSE);
357 info.hash.nelem = svp ? SvIV(*svp) : 0;
359 svp = hv_fetch(action, "cachesize", 9, FALSE);
360 info.hash.cachesize = svp ? SvIV(*svp) : 0;
362 svp = hv_fetch(action, "lorder", 6, FALSE);
363 info.hash.lorder = svp ? SvIV(*svp) : 0;
367 else if (sv_isa(sv, "DB_File::BTREEINFO"))
369 RETVAL->type = DB_BTREE ;
370 openinfo = (void*)&info ;
372 svp = hv_fetch(action, "compare", 7, FALSE);
373 if (svp && SvOK(*svp))
375 info.btree.compare = btree_compare ;
376 RETVAL->compare = newSVsv(*svp) ;
379 info.btree.compare = NULL ;
381 svp = hv_fetch(action, "prefix", 6, FALSE);
382 if (svp && SvOK(*svp))
384 info.btree.prefix = btree_prefix ;
385 RETVAL->prefix = newSVsv(*svp) ;
388 info.btree.prefix = NULL ;
390 svp = hv_fetch(action, "flags", 5, FALSE);
391 info.btree.flags = svp ? SvIV(*svp) : 0;
393 svp = hv_fetch(action, "cachesize", 9, FALSE);
394 info.btree.cachesize = svp ? SvIV(*svp) : 0;
396 svp = hv_fetch(action, "minkeypage", 10, FALSE);
397 info.btree.minkeypage = svp ? SvIV(*svp) : 0;
399 svp = hv_fetch(action, "maxkeypage", 10, FALSE);
400 info.btree.maxkeypage = svp ? SvIV(*svp) : 0;
402 svp = hv_fetch(action, "psize", 5, FALSE);
403 info.btree.psize = svp ? SvIV(*svp) : 0;
405 svp = hv_fetch(action, "lorder", 6, FALSE);
406 info.btree.lorder = svp ? SvIV(*svp) : 0;
411 else if (sv_isa(sv, "DB_File::RECNOINFO"))
413 RETVAL->type = DB_RECNO ;
414 openinfo = (void *)&info ;
416 svp = hv_fetch(action, "flags", 5, FALSE);
417 info.recno.flags = (u_long) svp ? SvIV(*svp) : 0;
419 svp = hv_fetch(action, "cachesize", 9, FALSE);
420 info.recno.cachesize = (u_int) svp ? SvIV(*svp) : 0;
422 svp = hv_fetch(action, "psize", 5, FALSE);
423 info.recno.psize = (int) svp ? SvIV(*svp) : 0;
425 svp = hv_fetch(action, "lorder", 6, FALSE);
426 info.recno.lorder = (int) svp ? SvIV(*svp) : 0;
428 svp = hv_fetch(action, "reclen", 6, FALSE);
429 info.recno.reclen = (size_t) svp ? SvIV(*svp) : 0;
431 svp = hv_fetch(action, "bval", 4, FALSE);
432 if (svp && SvOK(*svp))
435 info.recno.bval = (u_char)*SvPV(*svp, na) ;
437 info.recno.bval = (u_char)(unsigned long) SvIV(*svp) ;
441 if (info.recno.flags & R_FIXEDLEN)
442 info.recno.bval = (u_char) ' ' ;
444 info.recno.bval = (u_char) '\n' ;
447 svp = hv_fetch(action, "bfname", 6, FALSE);
449 char * ptr = SvPV(*svp,na) ;
450 info.recno.bfname = (char*) na ? ptr : 0 ;
456 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
460 /* OS2 Specific Code */
467 RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ;
477 croak("DB_File::%s not implemented on this architecture", s);
491 if (strEQ(name, "BTREEMAGIC"))
497 if (strEQ(name, "BTREEVERSION"))
507 if (strEQ(name, "DB_LOCK"))
513 if (strEQ(name, "DB_SHMEM"))
519 if (strEQ(name, "DB_TXN"))
533 if (strEQ(name, "HASHMAGIC"))
539 if (strEQ(name, "HASHVERSION"))
555 if (strEQ(name, "MAX_PAGE_NUMBER"))
556 #ifdef MAX_PAGE_NUMBER
557 return (U32)MAX_PAGE_NUMBER;
561 if (strEQ(name, "MAX_PAGE_OFFSET"))
562 #ifdef MAX_PAGE_OFFSET
563 return MAX_PAGE_OFFSET;
567 if (strEQ(name, "MAX_REC_NUMBER"))
568 #ifdef MAX_REC_NUMBER
569 return (U32)MAX_REC_NUMBER;
583 if (strEQ(name, "RET_ERROR"))
589 if (strEQ(name, "RET_SPECIAL"))
595 if (strEQ(name, "RET_SUCCESS"))
601 if (strEQ(name, "R_CURSOR"))
607 if (strEQ(name, "R_DUP"))
613 if (strEQ(name, "R_FIRST"))
619 if (strEQ(name, "R_FIXEDLEN"))
625 if (strEQ(name, "R_IAFTER"))
631 if (strEQ(name, "R_IBEFORE"))
637 if (strEQ(name, "R_LAST"))
643 if (strEQ(name, "R_NEXT"))
649 if (strEQ(name, "R_NOKEY"))
655 if (strEQ(name, "R_NOOVERWRITE"))
657 return R_NOOVERWRITE;
661 if (strEQ(name, "R_PREV"))
667 if (strEQ(name, "R_RECNOSYNC"))
673 if (strEQ(name, "R_SETCURSOR"))
679 if (strEQ(name, "R_SNAPSHOT"))
703 if (strEQ(name, "__R_UNUSED"))
719 MODULE = DB_File PACKAGE = DB_File PREFIX = db_
728 db_TIEHASH(dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0640, type=DB_HASH)
735 char * name = (char *) NULL ;
736 SV * sv = (SV *) NULL ;
738 if (items >= 2 && SvOK(ST(1)))
739 name = (char*) SvPV(ST(1), na) ;
744 RETVAL = ParseOpenInfo(name, flags, mode, sv, "new") ;
745 if (RETVAL->dbp == NULL)
758 SvREFCNT_dec(db->hash) ;
760 SvREFCNT_dec(db->compare) ;
762 SvREFCNT_dec(db->prefix) ;
767 db_DELETE(db, key, flags=0)
775 db_FETCH(db, key, flags=0)
784 RETVAL = ((db->dbp)->get)(db->dbp, &key, &value, flags) ;
785 ST(0) = sv_newmortal();
787 sv_setpvn(ST(0), value.data, value.size);
791 db_STORE(db, key, value, flags=0)
810 RETVAL = (Db->seq)(Db, &key, &value, R_FIRST) ;
811 ST(0) = sv_newmortal();
814 if (Db->type != DB_RECNO)
815 sv_setpvn(ST(0), key.data, key.size);
817 sv_setiv(ST(0), (I32)*(I32*)key.data - 1);
831 RETVAL = (Db->seq)(Db, &key, &value, R_NEXT) ;
832 ST(0) = sv_newmortal();
835 if (Db->type != DB_RECNO)
836 sv_setpvn(ST(0), key.data, key.size);
838 sv_setiv(ST(0), (I32)*(I32*)key.data - 1);
843 # These would be nice for RECNO
859 for (i = items-1 ; i > 0 ; --i)
861 value.data = SvPV(ST(i), na) ;
865 key.size = sizeof(int) ;
866 RETVAL = (Db->put)(Db, &key, &value, R_IBEFORE) ;
884 /* First get the final value */
885 RETVAL = (Db->seq)(Db, &key, &value, R_LAST) ;
886 ST(0) = sv_newmortal();
890 RETVAL = (Db->del)(Db, &key, R_CURSOR) ;
892 sv_setpvn(ST(0), value.data, value.size);
906 /* get the first value */
907 RETVAL = (Db->seq)(Db, &key, &value, R_FIRST) ;
908 ST(0) = sv_newmortal();
912 RETVAL = (Db->del)(Db, &key, R_CURSOR) ;
914 sv_setpvn(ST(0), value.data, value.size);
925 DBTKEY * keyptr = &key ;
931 /* Set the Cursor to the Last element */
932 RETVAL = (Db->seq)(Db, &key, &value, R_LAST) ;
937 for (i = items - 1 ; i > 0 ; --i)
939 value.data = SvPV(ST(i), na) ;
941 RETVAL = (Db->put)(Db, keyptr, &value, R_IAFTER) ;
956 RETVAL = GetArrayLength(db->dbp) ;
962 # Now provide an interface to the rest of the DB functionality
966 db_del(db, key, flags=0)
975 db_get(db, key, value, flags=0)
986 db_put(db, key, value, flags=0)
994 key if (flags & (R_IAFTER|R_IBEFORE)) OutputKey(ST(1), key);
1003 db_sync(db, flags=0)
1011 db_seq(db, key, value, flags)