1 #define PERL_NO_GET_CONTEXT
2
3 #include "EXTERN.h"
4 #include "perl.h"
5 #include "XSUB.h"
6
7 #include <gdbm.h>
8 #include <fcntl.h>
9
10 #define fetch_key 0
11 #define store_key 1
12 #define fetch_value 2
13 #define store_value 3
14
15 typedef struct {
16 GDBM_FILE dbp ;
17 SV * filter[4];
18 int filtering ;
19 } GDBM_File_type;
20
21 typedef GDBM_File_type * GDBM_File ;
22 typedef datum datum_key ;
23 typedef datum datum_value ;
24 typedef datum datum_key_copy;
25
26 /* Indexes for gdbm_flags aliases */
27 enum {
28 opt_flags = 0,
29 opt_cache_size,
30 opt_sync_mode,
31 opt_centfree,
32 opt_coalesce,
33 opt_dbname,
34 opt_block_size,
35 opt_mmap,
36 opt_mmapsize
37 };
38
39 /* Names of gdbm_flags aliases, for error reporting.
40 Indexed by opt_ constants above.
41 */
42 char const *opt_names[] = {
43 "GDBM_File::flags",
44 "GDBM_File::cache_size",
45 "GDBM_File::sync_mode",
46 "GDBM_File::centfree",
47 "GDBM_File::coalesce",
48 "GDBM_File::dbname",
49 "GDBM_File::block_size",
50 "GDBM_File::mmap",
51 "GDBM_File::mmapsize"
52 };
53
54 #ifdef GDBM_VERSION_MAJOR
55 # define GDBM_VERSION_GUESS 0
56 #else
57 /* Try educated guess
58 * The value of GDBM_VERSION_GUESS indicates how rough the guess is:
59 * 1 - Precise; based on the CVS logs and existing archives
60 * 2 - Moderate. The major and minor number are correct. The patchlevel
61 * is set to the upper bound.
62 * 3 - Rough; The version is guaranteed to be not newer than major.minor.
63 */
64 # if defined(GDBM_SYNCMODE)
65 /* CHANGES from 1.7.3 to 1.8
66 * 1. Added GDBM_CENTFREE functionality and option.
67 */
68 # define GDBM_VERSION_MAJOR 1
69 # define GDBM_VERSION_MINOR 8
70 # define GDBM_VERSION_PATCH 3
71 # define GDBM_VERSION_GUESS 1
72 # elif defined(GDBM_FASTMODE)
73 /* CHANGES from 1.7.2 to 1.7.3
74 * 1. Fixed a couple of last minute problems. (Namely, no autoconf.h in
75 * version.c, and no GDBM_FASTMODE in gdbm.h!)
76 */
77 # define GDBM_VERSION_MAJOR 1
78 # define GDBM_VERSION_MINOR 7
79 # define GDBM_VERSION_PATCH 3
80 # define GDBM_VERSION_GUESS 1
81 # elif defined(GDBM_FAST)
82 /* From CVS logs:
83 * Mon May 17 12:32:02 1993 Phil Nelson (phil at cs.wwu.edu)
84 *
85 * * gdbm.proto: Added GDBM_FAST to the read_write flags.
86 */
87 # define GDBM_VERSION_MAJOR 1
88 # define GDBM_VERSION_MINOR 7
89 # define GDBM_VERSION_PATCH 2
90 # define GDBM_VERSION_GUESS 2
91 # else
92 # define GDBM_VERSION_MAJOR 1
93 # define GDBM_VERSION_MINOR 6
94 # define GDBM_VERSION_GUESS 3
95 # endif
96 #endif
97
98 #ifndef GDBM_VERSION_PATCH
99 # define GDBM_VERSION_PATCH 0
100 #endif
101
102 /* The use of fatal_func argument to gdbm_open is deprecated since 1.13 */
103 #if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13
104 # define FATALFUNC NULL
105 #elif GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 9
106 # define FATALFUNC croak_string
107 # define NEED_FATALFUNC 1
108 #else
109 # define FATALFUNC (void (*)()) croak_string
110 # define NEED_FATALFUNC 1
111 #endif
112
113 #ifdef NEED_FATALFUNC
114 static void
croak_string(const char * message)115 croak_string(const char *message) {
116 Perl_croak_nocontext("%s", message);
117 }
118 #endif
119
120 #define not_here(s) (croak("GDBM_File::%s not implemented", #s),-1)
121
122 #if ! (GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 11)
123 typedef unsigned gdbm_count_t;
124 #endif
125
126 /* GDBM allocates the datum with system malloc() and expects the user
127 * to free() it. So we either have to free() it immediately, or have
128 * perl free() it when it deallocates the SV, depending on whether
129 * perl uses malloc()/free() or not. */
130 static void
output_datum(pTHX_ SV * arg,char * str,int size)131 output_datum(pTHX_ SV *arg, char *str, int size)
132 {
133 sv_setpvn(arg, str, size);
134 # undef free
135 free(str);
136 }
137
138 /* Versions of gdbm prior to 1.7x might not have the gdbm_sync,
139 gdbm_exists, and gdbm_setopt functions. Apparently Slackware
140 (Linux) 2.1 contains gdbm-1.5 (which dates back to 1991).
141 */
142 #ifndef GDBM_FAST
143 #define gdbm_exists(db,key) not_here("gdbm_exists")
144 #define gdbm_sync(db) (void) not_here("gdbm_sync")
145 #define gdbm_setopt(db,optflag,optval,optlen) not_here("gdbm_setopt")
146 #endif
147
148 #if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR < 13
149 /* Prior to 1.13, only gdbm_fetch set GDBM_ITEM_NOT_FOUND if the requested
150 key did not exist. Other similar functions would set GDBM_NO_ERROR instead.
151 The GDBM_ITEM_NOT_FOUND existed as early as in 1.7.3 */
152 # define ITEM_NOT_FOUND() (gdbm_errno == GDBM_NO_ERROR || gdbm_errno == GDBM_ITEM_NOT_FOUND)
153 #else
154 # define ITEM_NOT_FOUND() (gdbm_errno == GDBM_ITEM_NOT_FOUND)
155 #endif
156
157 #define CHECKDB(db) do { \
158 if (!db->dbp) { \
159 croak("database was closed"); \
160 } \
161 } while (0)
162
163 static void
dbcroak(GDBM_File db,char const * func)164 dbcroak(GDBM_File db, char const *func)
165 {
166 #if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13
167 if (db)
168 croak("%s: %s", func, gdbm_db_strerror(db->dbp));
169 if (gdbm_check_syserr(gdbm_errno))
170 croak("%s: %s: %s", func, gdbm_strerror(gdbm_errno), strerror(errno));
171 #else
172 (void)db;
173 #endif
174 croak("%s: %s", func, gdbm_strerror(gdbm_errno));
175 }
176
177 #if GDBM_VERSION_MAJOR == 1 && (GDBM_VERSION_MINOR > 16 || GDBM_VERSION_PATCH >= 90)
178 # define gdbm_close(db) gdbm_close(db->dbp)
179 #else
180 # define gdbm_close(db) (gdbm_close(db->dbp),0)
181 #endif
182 static int
gdbm_file_close(GDBM_File db)183 gdbm_file_close(GDBM_File db)
184 {
185 int rc = 0;
186 if (db->dbp) {
187 rc = gdbm_close(db);
188 db->dbp = NULL;
189 }
190 return rc;
191 }
192
193 #if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13
194 /* Error-reporting wrapper for gdbm_recover */
195 static void
rcvr_errfun(void * cv,char const * fmt,...)196 rcvr_errfun(void *cv, char const *fmt, ...)
197 {
198 dTHX;
199 dSP;
200 va_list ap;
201
202 ENTER;
203 SAVETMPS;
204
205 PUSHMARK(SP);
206 va_start(ap, fmt);
207 XPUSHs(sv_2mortal(vnewSVpvf(fmt, &ap)));
208 va_end(ap);
209 PUTBACK;
210
211 call_sv((SV*)cv, G_DISCARD);
212
213 FREETMPS;
214 LEAVE;
215 }
216 #endif
217
218 #if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR < 13
219 static int
gdbm_check_syserr(int ec)220 gdbm_check_syserr(int ec)
221 {
222 switch (ec) {
223 case GDBM_FILE_OPEN_ERROR:
224 case GDBM_FILE_WRITE_ERROR:
225 case GDBM_FILE_SEEK_ERROR:
226 case GDBM_FILE_READ_ERROR:
227 return 1;
228
229 default:
230 return 0;
231 }
232 }
233 #endif
234
235 static I32
get_gdbm_errno(pTHX_ IV idx,SV * sv)236 get_gdbm_errno(pTHX_ IV idx, SV *sv)
237 {
238 PERL_UNUSED_ARG(idx);
239 sv_setiv(sv, gdbm_errno);
240 sv_setpv(sv, gdbm_strerror(gdbm_errno));
241 if (gdbm_check_syserr(gdbm_errno)) {
242 SV *val = get_sv("!", 0);
243 if (val) {
244 sv_catpv(sv, ": ");
245 sv_catsv(sv, val);
246 }
247 }
248 SvIOK_on(sv);
249 return 0;
250 }
251
252 static I32
set_gdbm_errno(pTHX_ IV idx,SV * sv)253 set_gdbm_errno(pTHX_ IV idx, SV *sv)
254 {
255 PERL_UNUSED_ARG(idx);
256 gdbm_errno = SvIV(sv);
257 return 0;
258 }
259
260
261 #include "const-c.inc"
262
263 MODULE = GDBM_File PACKAGE = GDBM_File PREFIX = gdbm_
264
265 INCLUDE: const-xs.inc
266
267 BOOT:
268 {
269 SV *sv = get_sv("GDBM_File::gdbm_errno", GV_ADD);
270 struct ufuncs uf;
271
272 uf.uf_val = get_gdbm_errno;
273 uf.uf_set = set_gdbm_errno;
274 uf.uf_index = 0;
275
276 sv_magic(sv, NULL, PERL_MAGIC_uvar, (char*)&uf, sizeof(uf));
277 }
278
279 void
280 gdbm_GDBM_version(package)
281 PPCODE:
282 I32 gimme = GIMME_V;
283 if (gimme == G_VOID) {
284 /* nothing */;
285 } else if (gimme == G_SCALAR) {
286 static char const *guess[] = {
287 "",
288 " (exact guess)",
289 " (approximate)",
290 " (rough guess)"
291 };
292 if (GDBM_VERSION_PATCH > 0) {
293 XPUSHs(sv_2mortal(newSVpvf("%d.%d.%d%s",
294 GDBM_VERSION_MAJOR,
295 GDBM_VERSION_MINOR,
296 GDBM_VERSION_PATCH,
297 guess[GDBM_VERSION_GUESS])));
298 } else {
299 XPUSHs(sv_2mortal(newSVpvf("%d.%d%s",
300 GDBM_VERSION_MAJOR,
301 GDBM_VERSION_MINOR,
302 guess[GDBM_VERSION_GUESS])));
303 }
304 } else {
305 XPUSHs(sv_2mortal(newSVuv(GDBM_VERSION_MAJOR)));
306 XPUSHs(sv_2mortal(newSVuv(GDBM_VERSION_MINOR)));
307 XPUSHs(sv_2mortal(newSVuv(GDBM_VERSION_PATCH)));
308 if (GDBM_VERSION_GUESS > 0) {
309 XPUSHs(sv_2mortal(newSVuv(GDBM_VERSION_GUESS)));
310 }
311 }
312
313 GDBM_File
gdbm_TIEHASH(dbtype,name,read_write,mode)314 gdbm_TIEHASH(dbtype, name, read_write, mode)
315 char * dbtype
316 char * name
317 int read_write
318 int mode
319 PREINIT:
320 GDBM_FILE dbp;
321 CODE:
322 dbp = gdbm_open(name, 0, read_write, mode, FATALFUNC);
323 if (!dbp && gdbm_errno == GDBM_BLOCK_SIZE_ERROR) {
324 /*
325 * By specifying a block size of 0 above, we asked gdbm to
326 * default to the filesystem's block size. That's usually the
327 * right size to choose. But some versions of gdbm require
328 * a power-of-two block size, and some unusual filesystems
329 * or devices have a non-power-of-two size that cause this
330 * defaulting to fail. In that case, force an acceptable
331 * block size.
332 */
333 dbp = gdbm_open(name, 4096, read_write, mode, FATALFUNC);
334 }
335 if (dbp) {
336 RETVAL = (GDBM_File)safecalloc(1, sizeof(GDBM_File_type));
337 RETVAL->dbp = dbp;
338 } else {
339 RETVAL = NULL;
340 }
341 OUTPUT:
342 RETVAL
343
344 void
345 gdbm_DESTROY(db)
346 GDBM_File db
347 PREINIT:
348 int i = store_value;
349 CODE:
350 if (gdbm_file_close(db)) {
351 croak("gdbm_close: %s; %s", gdbm_strerror(gdbm_errno),
352 strerror(errno));
353 }
354 do {
355 if (db->filter[i])
356 SvREFCNT_dec(db->filter[i]);
357 } while (i-- > 0);
358 safefree(db);
359
360 void
361 gdbm_UNTIE(db, count)
362 GDBM_File db
363 unsigned count
364 CODE:
365 if (count == 0) {
366 if (gdbm_file_close(db))
367 croak("gdbm_close: %s; %s",
368 gdbm_strerror(gdbm_errno),
369 strerror(errno));
370 }
371
372
373 #define gdbm_FETCH(db,key) gdbm_fetch(db->dbp,key)
374 datum_value
375 gdbm_FETCH(db, key)
376 GDBM_File db
377 datum_key_copy key
378 INIT:
379 CHECKDB(db);
380 CLEANUP:
381 if (RETVAL.dptr == NULL && !ITEM_NOT_FOUND()) {
382 dbcroak(db, "gdbm_fetch");
383 }
384
385 #define gdbm_STORE(db,key,value,flags) gdbm_store(db->dbp,key,value,flags)
386 int
387 gdbm_STORE(db, key, value, flags = GDBM_REPLACE)
388 GDBM_File db
389 datum_key key
390 datum_value value
391 int flags
392 INIT:
393 CHECKDB(db);
394 CLEANUP:
395 if (RETVAL) {
396 dbcroak(db, "gdbm_store");
397 }
398
399 #define gdbm_DELETE(db,key) gdbm_delete(db->dbp,key)
400 int
401 gdbm_DELETE(db, key)
402 GDBM_File db
403 datum_key key
404 INIT:
405 CHECKDB(db);
406 CLEANUP:
407 if (RETVAL && !ITEM_NOT_FOUND()) {
408 dbcroak(db, "gdbm_delete");
409 }
410
411 #define gdbm_FIRSTKEY(db) gdbm_firstkey(db->dbp)
412 datum_key
413 gdbm_FIRSTKEY(db)
414 GDBM_File db
415 INIT:
416 CHECKDB(db);
417 CLEANUP:
418 if (RETVAL.dptr == NULL && !ITEM_NOT_FOUND()) {
419 dbcroak(db, "gdbm_firstkey");
420 }
421
422 #define gdbm_NEXTKEY(db,key) gdbm_nextkey(db->dbp,key)
423 datum_key
424 gdbm_NEXTKEY(db, key)
425 GDBM_File db
426 datum_key key
427 INIT:
428 CHECKDB(db);
429 CLEANUP:
430 if (RETVAL.dptr == NULL && !ITEM_NOT_FOUND()) {
431 dbcroak(db, "gdbm_nextkey");
432 }
433
434 #define gdbm_EXISTS(db,key) gdbm_exists(db->dbp,key)
435 int
436 gdbm_EXISTS(db, key)
437 GDBM_File db
438 datum_key key
439 INIT:
440 CHECKDB(db);
441
442 ##
443
444 int
445 gdbm_close(db)
446 GDBM_File db
447 INIT:
448 CHECKDB(db);
449 CODE:
450 RETVAL = gdbm_file_close(db);
451 OUTPUT:
452 RETVAL
453
454 #define gdbm_gdbm_check_syserr(ec) gdbm_check_syserr(ec)
455 int
456 gdbm_gdbm_check_syserr(ec)
457 int ec
458
459 SV *
460 gdbm_errno(db)
461 GDBM_File db
462 INIT:
463 CHECKDB(db);
464 CODE:
465 #if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13
466 {
467 int ec = gdbm_last_errno(db->dbp);
468 RETVAL = newSViv(ec);
469 sv_setpv(RETVAL, gdbm_db_strerror (db->dbp));
470 SvIOK_on(RETVAL);
471 }
472 #else
473 RETVAL = newSVsv(get_sv("GDBM_File::gdbm_errno", 0));
474 #endif
475 OUTPUT:
476 RETVAL
477
478 int
479 gdbm_syserrno(db)
480 GDBM_File db
481 INIT:
482 CHECKDB(db);
483 CODE:
484 #if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13
485 {
486 int ec = gdbm_last_errno(db->dbp);
487 if (gdbm_check_syserr(ec)) {
488 RETVAL = gdbm_last_syserr(db->dbp);
489 } else {
490 RETVAL = 0;
491 }
492 }
493 #else
494 RETVAL = not_here("syserrno");
495 #endif
496 OUTPUT:
497 RETVAL
498
499 SV *
500 gdbm_strerror(db)
501 GDBM_File db
502 PREINIT:
503 char const *errstr;
504 INIT:
505 CHECKDB(db);
506 CODE:
507 #if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13
508 errstr = gdbm_db_strerror(db->dbp);
509 #else
510 errstr = gdbm_strerror(gdbm_errno);
511 #endif
512 RETVAL = newSVpv(errstr, 0);
513 OUTPUT:
514 RETVAL
515
516 #if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13
517 # define gdbm_clear_error(db) gdbm_clear_error(db->dbp)
518 #else
519 # define gdbm_clear_error(db) (gdbm_errno = 0)
520 #endif
521 void
522 gdbm_clear_error(db)
523 GDBM_File db
524 INIT:
525 CHECKDB(db);
526
527 #if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13
528 # define gdbm_needs_recovery(db) gdbm_needs_recovery(db->dbp)
529 #else
530 # define gdbm_needs_recovery(db) not_here("gdbm_needs_recovery")
531 #endif
532 int
533 gdbm_needs_recovery(db)
534 GDBM_File db
535 INIT:
536 CHECKDB(db);
537
538 #define gdbm_reorganize(db) gdbm_reorganize(db->dbp)
539 int
540 gdbm_reorganize(db)
541 GDBM_File db
542 INIT:
543 CHECKDB(db);
544
545
546 # Arguments:
547 # err => sub { ... }
548 # max_failed_keys => $n
549 # max_failed_buckets => $n
550 # max_failures => $n
551 # backup => \$str
552 # stat => \%hash
553
554 #if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13
555
556 void
557 gdbm_recover(db, ...)
558 GDBM_File db
559 PREINIT:
560 int flags = GDBM_RCVR_FORCE;
561 SV *backup_ref = &PL_sv_undef;
562 SV *stat_ref = &PL_sv_undef;
563 gdbm_recovery rcvr;
564 INIT:
565 CHECKDB(db);
566 CODE:
567 if (items > 1) {
568 int i;
569 if ((items % 2) == 0) {
570 croak_xs_usage(cv, "db, %opts");
571 }
572 for (i = 1; i < items; i += 2) {
573 char *kw;
574 SV *sv = ST(i);
575 SV *val = ST(i+1);
576
577 kw = SvPV_nolen(sv);
578 if (strcmp(kw, "err") == 0) {
579 SvGETMAGIC(val);
580 if (SvROK(val) && SvTYPE(SvRV(val)) == SVt_PVCV) {
581 rcvr.data = SvRV(val);
582 } else {
583 croak("%s must be a code ref", kw);
584 }
585 rcvr.errfun = rcvr_errfun;
586 flags |= GDBM_RCVR_ERRFUN;
587 } else if (strcmp(kw, "max_failed_keys") == 0) {
588 rcvr.max_failed_keys = SvUV(val);
589 flags |= GDBM_RCVR_MAX_FAILED_KEYS;
590 } else if (strcmp(kw, "max_failed_buckets") == 0) {
591 rcvr.max_failed_buckets = SvUV(val);
592 flags |= GDBM_RCVR_MAX_FAILED_BUCKETS;
593 } else if (strcmp(kw, "max_failures") == 0) {
594 rcvr.max_failures = SvUV(val);
595 flags |= GDBM_RCVR_MAX_FAILURES;
596 } else if (strcmp(kw, "backup") == 0) {
597 SvGETMAGIC(val);
598 if (SvROK(val) && SvTYPE(SvRV(val)) < SVt_PVAV) {
599 backup_ref = val;
600 } else {
601 croak("%s must be a scalar reference", kw);
602 }
603 flags |= GDBM_RCVR_BACKUP;
604 } else if (strcmp(kw, "stat") == 0) {
605 SvGETMAGIC(val);
606 if (SvROK(val) && SvTYPE(SvRV(val)) == SVt_PVHV) {
607 stat_ref = val;
608 } else {
609 croak("%s must be a scalar reference", kw);
610 }
611 } else {
612 croak("%s: unrecognized argument", kw);
613 }
614 }
615 }
616 if (gdbm_recover(db->dbp, &rcvr, flags)) {
617 dbcroak(db, "gdbm_recover");
618 }
619 if (stat_ref != &PL_sv_undef) {
620 HV *hv = (HV*)SvRV(stat_ref);
621 #define STAT_RECOVERED_KEYS_STR "recovered_keys"
622 #define STAT_RECOVERED_KEYS_LEN (sizeof(STAT_RECOVERED_KEYS_STR)-1)
623 #define STAT_RECOVERED_BUCKETS_STR "recovered_buckets"
624 #define STAT_RECOVERED_BUCKETS_LEN (sizeof(STAT_RECOVERED_BUCKETS_STR)-1)
625 #define STAT_FAILED_KEYS_STR "failed_keys"
626 #define STAT_FAILED_KEYS_LEN (sizeof(STAT_FAILED_KEYS_STR)-1)
627 #define STAT_FAILED_BUCKETS_STR "failed_buckets"
628 #define STAT_FAILED_BUCKETS_LEN (sizeof(STAT_FAILED_BUCKETS_STR)-1)
629 hv_store(hv, STAT_RECOVERED_KEYS_STR, STAT_RECOVERED_KEYS_LEN,
630 newSVuv(rcvr.recovered_keys), 0);
631 hv_store(hv,
632 STAT_RECOVERED_BUCKETS_STR,
633 STAT_RECOVERED_BUCKETS_LEN,
634 newSVuv(rcvr.recovered_buckets), 0);
635 hv_store(hv,
636 STAT_FAILED_KEYS_STR,
637 STAT_FAILED_KEYS_LEN,
638 newSVuv(rcvr.failed_keys), 0);
639 hv_store(hv,
640 STAT_FAILED_BUCKETS_STR,
641 STAT_FAILED_BUCKETS_LEN,
642 newSVuv(rcvr.failed_buckets), 0);
643 }
644 if (backup_ref != &PL_sv_undef) {
645 SV *sv = SvRV(backup_ref);
646 sv_setpv(sv, rcvr.backup_name);
647 free(rcvr.backup_name);
648 }
649
650 #endif
651
652 #if GDBM_VERSION_MAJOR == 1 && (GDBM_VERSION_MINOR > 16 || GDBM_VERSION_PATCH >= 90)
653 # define gdbm_sync(db) gdbm_sync(db->dbp)
654 #else
655 # define gdbm_sync(db) (gdbm_sync(db->dbp),0)
656 #endif
657 int
658 gdbm_sync(db)
659 GDBM_File db
660 INIT:
661 CHECKDB(db);
662 CLEANUP:
663 if (RETVAL) {
664 dbcroak(db, "gdbm_sync");
665 }
666
667 #if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 11
668
669 gdbm_count_t
670 gdbm_count(db)
671 GDBM_File db
672 PREINIT:
673 gdbm_count_t c;
674 INIT:
675 CHECKDB(db);
676 CODE:
677 if (gdbm_count(db->dbp, &c)) {
678 dbcroak(db, "gdbm_count");
679 }
680 RETVAL = c;
681 OUTPUT:
682 RETVAL
683
684 void
685 gdbm_dump(db, filename, ...)
686 GDBM_File db
687 char * filename
688 PREINIT:
689 int format = GDBM_DUMP_FMT_ASCII;
690 int flags = GDBM_WRCREAT;
691 int mode = 0666;
692 INIT:
693 CHECKDB(db);
694 CODE:
695 if (items % 2) {
696 croak_xs_usage(cv, "db, filename, %opts");
697 } else {
698 int i;
699
700 for (i = 2; i < items; i += 2) {
701 char *kw;
702 SV *sv = ST(i);
703 SV *val = ST(i+1);
704
705 kw = SvPV_nolen(sv);
706 if (strcmp(kw, "mode") == 0) {
707 mode = SvUV(val) & 0777;
708 } else if (strcmp(kw, "binary") == 0) {
709 if (SvTRUE(val)) {
710 format = GDBM_DUMP_FMT_BINARY;
711 }
712 } else if (strcmp(kw, "overwrite") == 0) {
713 if (SvTRUE(val)) {
714 flags = GDBM_NEWDB;
715 }
716 } else {
717 croak("unrecognized keyword: %s", kw);
718 }
719 }
720 if (gdbm_dump(db->dbp, filename, format, flags, mode)) {
721 dbcroak(NULL, "dump");
722 }
723 }
724
725 void
726 gdbm_load(db, filename, ...)
727 GDBM_File db
728 char * filename
729 PREINIT:
730 int flag = GDBM_INSERT;
731 int meta_mask = 0;
732 unsigned long errline;
733 int result;
734 int strict_errors = 0;
735 INIT:
736 CHECKDB(db);
737 CODE:
738 if (items % 2) {
739 croak_xs_usage(cv, "db, filename, %opts");
740 } else {
741 int i;
742
743 for (i = 2; i < items; i += 2) {
744 char *kw;
745 SV *sv = ST(i);
746 SV *val = ST(i+1);
747
748 kw = SvPV_nolen(sv);
749
750 if (strcmp(kw, "restore_mode") == 0) {
751 if (!SvTRUE(val))
752 meta_mask |= GDBM_META_MASK_MODE;
753 } else if (strcmp(kw, "restore_owner") == 0) {
754 if (!SvTRUE(val))
755 meta_mask |= GDBM_META_MASK_OWNER;
756 } else if (strcmp(kw, "replace") == 0) {
757 if (SvTRUE(val))
758 flag = GDBM_REPLACE;
759 } else if (strcmp(kw, "strict_errors") == 0) {
760 strict_errors = SvTRUE(val);
761 } else {
762 croak("unrecognized keyword: %s", kw);
763 }
764 }
765 }
766
767 result = gdbm_load(&db->dbp, filename, flag, meta_mask, &errline);
768 if (result == -1 || (result == 1 && strict_errors)) {
769 #if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13
770 if (errline) {
771 croak("%s:%lu: database load error: %s",
772 filename, errline, gdbm_db_strerror(db->dbp));
773 } else {
774 croak("%s: database load error: %s",
775 filename, gdbm_db_strerror(db->dbp));
776 }
777 #else
778 if (errline) {
779 croak("%s:%lu: database load error: %s",
780 filename, errline, gdbm_strerror(gdbm_errno));
781 } else {
782 croak("%s: database load error: %s",
783 filename, gdbm_strerror(gdbm_errno));
784 }
785 #endif
786 }
787
788 #endif
789
790 #define OPTNAME(a,b) a ## b
791 #define INTOPTSETUP(opt) \
792 do { \
793 if (items == 1) { \
794 opcode = OPTNAME(GDBM_GET, opt); \
795 } else { \
796 opcode = OPTNAME(GDBM_SET, opt); \
797 c_iv = SvIV(ST(1)); \
798 } \
799 } while (0)
800
801 #if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 9
802 # define OPTVALPTR void *
803 #else
804 # define OPTVALPTR int *
805 #endif
806
807 # GDBM_GET defines appeared in version 1.9 (2011-08-12).
808 #
809 # Provide definitions for earlier versions. These will cause gdbm_setopt
810 # to fail with GDBM_OPT_ILLEGAL
811
812 #ifndef GDBM_GETFLAGS
813 # define GDBM_GETFLAGS -1
814 #endif
815 #ifndef GDBM_GETMMAP
816 # define GDBM_GETMMAP -1
817 #endif
818 #ifndef GDBM_GETCACHESIZE
819 # define GDBM_GETCACHESIZE -1
820 #endif
821 #ifndef GDBM_GETSYNCMODE
822 # define GDBM_GETSYNCMODE -1
823 #endif
824 #ifndef GDBM_GETCENTFREE
825 # define GDBM_GETCENTFREE -1
826 #endif
827 #ifndef GDBM_GETCOALESCEBLKS
828 # define GDBM_GETCOALESCEBLKS -1
829 #endif
830 #ifndef GDBM_GETMAXMAPSIZE
831 # define GDBM_GETMAXMAPSIZE -1
832 #endif
833 #ifndef GDBM_GETDBNAME
834 # define GDBM_GETDBNAME -1
835 #endif
836 #ifndef GDBM_GETBLOCKSIZE
837 # define GDBM_GETBLOCKSIZE -1
838 #endif
839
840 # These two appeared in version 1.10:
841
842 #ifndef GDBM_SETMAXMAPSIZE
843 # define GDBM_SETMAXMAPSIZE -1
844 #endif
845 #ifndef GDBM_SETMMAP
846 # define GDBM_SETMMAP -1
847 #endif
848
849 # These GDBM_SET defines appeared in 1.10, replacing obsolete opcodes.
850 # Provide definitions for older versions
851
852 #ifndef GDBM_SETCACHESIZE
853 # define GDBM_SETCACHESIZE GDBM_CACHESIZE
854 #endif
855 #ifndef GDBM_SETSYNCMODE
856 # define GDBM_SETSYNCMODE GDBM_SYNCMODE
857 #endif
858 #ifndef GDBM_SETCENTFREE
859 # define GDBM_SETCENTFREE GDBM_CENTFREE
860 #endif
861 #ifndef GDBM_SETCOALESCEBLKS
862 # define GDBM_SETCOALESCEBLKS GDBM_COALESCEBLKS
863 #endif
864
865 SV *
866 gdbm_flags(db, ...)
867 GDBM_File db
868 SV * RETVAL = &PL_sv_undef;
869 ALIAS:
870 GDBM_File::cache_size = opt_cache_size
871 GDBM_File::sync_mode = opt_sync_mode
872 GDBM_File::centfree = opt_centfree
873 GDBM_File::coalesce = opt_coalesce
874 GDBM_File::dbname = opt_dbname
875 GDBM_File::block_size = opt_block_size
876 GDBM_File::mmap = opt_mmap
877 GDBM_File::mmapsize = opt_mmapsize
878 PREINIT:
879 int opcode = -1;
880 int c_iv;
881 size_t c_uv;
882 char *c_cv;
883 OPTVALPTR vptr = (OPTVALPTR) &c_iv;
884 size_t vsiz = sizeof(c_iv);
885 INIT:
886 CHECKDB(db);
887 CODE:
888 if (items > 2) {
889 croak("%s: too many arguments", opt_names[ix]);
890 }
891
892 switch (ix) {
893 case opt_flags:
894 if (items > 1) {
895 croak("%s: too many arguments", opt_names[ix]);
896 }
897 opcode = GDBM_GETFLAGS;
898 break;
899 case opt_cache_size:
900 INTOPTSETUP(CACHESIZE);
901 break;
902 case opt_sync_mode:
903 INTOPTSETUP(SYNCMODE);
904 break;
905 case opt_centfree:
906 INTOPTSETUP(CENTFREE);
907 break;
908 case opt_coalesce:
909 INTOPTSETUP(COALESCEBLKS);
910 break;
911 case opt_dbname:
912 if (items > 1) {
913 croak("%s: too many arguments", opt_names[ix]);
914 }
915 opcode = GDBM_GETDBNAME;
916 vptr = (OPTVALPTR) &c_cv;
917 vsiz = sizeof(c_cv);
918 break;
919 case opt_block_size:
920 if (items > 1) {
921 croak("%s: too many arguments", opt_names[ix]);
922 }
923 opcode = GDBM_GETBLOCKSIZE;
924 break;
925 case opt_mmap:
926 if (items > 1) {
927 croak("%s: too many arguments", opt_names[ix]);
928 }
929 opcode = GDBM_GETMMAP;
930 break;
931 case opt_mmapsize:
932 vptr = (OPTVALPTR) &c_uv;
933 vsiz = sizeof(c_uv);
934 if (items == 1) {
935 opcode = GDBM_GETMAXMAPSIZE;
936 } else {
937 opcode = GDBM_SETMAXMAPSIZE;
938 c_uv = SvUV(ST(1));
939 }
940 break;
941 }
942
943 if (gdbm_setopt(db->dbp, opcode, vptr, vsiz)) {
944 if (gdbm_errno == GDBM_OPT_ILLEGAL)
945 croak("%s not implemented", opt_names[ix]);
946 dbcroak(db, "gdbm_setopt");
947 }
948
949 if (vptr == (OPTVALPTR) &c_iv) {
950 RETVAL = newSViv(c_iv);
951 } else if (vptr == (OPTVALPTR) &c_uv) {
952 RETVAL = newSVuv(c_uv);
953 } else {
954 RETVAL = newSVpv(c_cv, 0);
955 free(c_cv);
956 }
957 OUTPUT:
958 RETVAL
959
960 #define gdbm_setopt(db,optflag, optval, optlen) gdbm_setopt(db->dbp,optflag, optval, optlen)
961 int
962 gdbm_setopt (db, optflag, optval, optlen)
963 GDBM_File db
964 int optflag
965 int &optval
966 int optlen
967 INIT:
968 CHECKDB(db);
969 CLEANUP:
970 if (RETVAL) {
971 dbcroak(db, "gdbm_setopt");
972 }
973
974 SV *
975 filter_fetch_key(db, code)
976 GDBM_File db
977 SV * code
978 SV * RETVAL = &PL_sv_undef ;
979 ALIAS:
980 GDBM_File::filter_fetch_key = fetch_key
981 GDBM_File::filter_store_key = store_key
982 GDBM_File::filter_fetch_value = fetch_value
983 GDBM_File::filter_store_value = store_value
984 CODE:
985 DBM_setFilter(db->filter[ix], code);
986
987 #
988 # Export/Import API
989 #
990
991
992 #
993 # Crash tolerance API
994 #
995
996 #if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 21
997
998 #define gdbm_convert(db, flag) gdbm_convert(db->dbp, flag)
999 int
1000 gdbm_convert(db, flag)
1001 GDBM_File db
1002 int flag
1003 INIT:
1004 CHECKDB(db);
1005 CLEANUP:
1006 if (RETVAL) {
1007 dbcroak(db, "gdbm_convert");
1008 }
1009
1010 #define gdbm_failure_atomic(db, even, odd) gdbm_failure_atomic(db->dbp, even, odd)
1011
1012 int
1013 gdbm_failure_atomic(db, even, odd)
1014 GDBM_File db
1015 char * even
1016 char * odd
1017 INIT:
1018 CHECKDB(db);
1019 CLEANUP:
1020 if (RETVAL) {
1021 dbcroak(db, "gdbm_failure_atomic");
1022 }
1023
1024 void
1025 gdbm_latest_snapshot(package, even, odd)
1026 char * even
1027 char * odd
1028 INIT:
1029 int result;
1030 int syserr;
1031 const char * filename;
1032 PPCODE:
1033 result = gdbm_latest_snapshot(even, odd, &filename);
1034 syserr = errno;
1035 if (result == GDBM_SNAPSHOT_OK) {
1036 XPUSHs(sv_2mortal(newSVpv(filename, 0)));
1037 } else {
1038 XPUSHs(&PL_sv_undef);
1039 }
1040 if (GIMME_V == G_ARRAY) {
1041 XPUSHs(sv_2mortal(newSVuv(result)));
1042 if (result == GDBM_SNAPSHOT_ERR)
1043 XPUSHs(sv_2mortal(newSVuv(syserr)));
1044 }
1045
1046 #endif
1047
1048 int
1049 gdbm_crash_tolerance_status(package)
1050 CODE:
1051 #if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 21
1052 /*
1053 * The call below returns GDBM_SNAPSHOT_ERR and sets errno to
1054 * EINVAL, if crash tolerance is implemented, or ENOSYS, if it
1055 * is not.
1056 */
1057 gdbm_latest_snapshot(NULL, NULL, NULL);
1058 RETVAL = (errno != ENOSYS);
1059 #else
1060 RETVAL = 0;
1061 #endif
1062 OUTPUT:
1063 RETVAL
1064
1065