This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add socklen_t probe; Configure maintenance.
[perl5.git] / ext / NDBM_File / NDBM_File.xs
CommitLineData
a0d0e21e
LW
1#include "EXTERN.h"
2#include "perl.h"
3#include "XSUB.h"
4#include <ndbm.h>
5
9fe6733a
PM
6typedef struct {
7 DBM * dbp ;
8 SV * filter_fetch_key ;
9 SV * filter_store_key ;
10 SV * filter_fetch_value ;
11 SV * filter_store_value ;
12 int filtering ;
13 } NDBM_File_type;
14
15typedef NDBM_File_type * NDBM_File ;
16typedef datum datum_key ;
17typedef datum datum_value ;
18
19#define ckFilter(arg,type,name) \
20 if (db->type) { \
21 SV * save_defsv ; \
22 /* printf("filtering %s\n", name) ;*/ \
23 if (db->filtering) \
24 croak("recursion detected in %s", name) ; \
25 db->filtering = TRUE ; \
26 save_defsv = newSVsv(DEFSV) ; \
27 sv_setsv(DEFSV, arg) ; \
28 PUSHMARK(sp) ; \
29 (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS); \
30 sv_setsv(arg, DEFSV) ; \
31 sv_setsv(DEFSV, save_defsv) ; \
32 SvREFCNT_dec(save_defsv) ; \
33 db->filtering = FALSE ; \
34 /*printf("end of filtering %s\n", name) ;*/ \
35 }
36
a0d0e21e 37
049cc612 38MODULE = NDBM_File PACKAGE = NDBM_File PREFIX = ndbm_
a0d0e21e
LW
39
40NDBM_File
049cc612 41ndbm_TIEHASH(dbtype, filename, flags, mode)
a0d0e21e
LW
42 char * dbtype
43 char * filename
44 int flags
45 int mode
9fe6733a
PM
46 CODE:
47 {
48 DBM * dbp ;
49
50 RETVAL = NULL ;
51 if (dbp = dbm_open(filename, flags, mode)) {
52 RETVAL = (NDBM_File)safemalloc(sizeof(NDBM_File_type)) ;
53 Zero(RETVAL, 1, NDBM_File_type) ;
54 RETVAL->dbp = dbp ;
55 }
56
57 }
58 OUTPUT:
59 RETVAL
a0d0e21e
LW
60
61void
049cc612 62ndbm_DESTROY(db)
a0d0e21e
LW
63 NDBM_File db
64 CODE:
9fe6733a 65 dbm_close(db->dbp);
eb99164f 66 safefree(db);
a0d0e21e 67
049cc612 68#define ndbm_FETCH(db,key) dbm_fetch(db->dbp,key)
9fe6733a 69datum_value
049cc612 70ndbm_FETCH(db, key)
a0d0e21e 71 NDBM_File db
9fe6733a 72 datum_key key
a0d0e21e 73
049cc612 74#define ndbm_STORE(db,key,value,flags) dbm_store(db->dbp,key,value,flags)
a0d0e21e 75int
049cc612 76ndbm_STORE(db, key, value, flags = DBM_REPLACE)
a0d0e21e 77 NDBM_File db
9fe6733a
PM
78 datum_key key
79 datum_value value
a0d0e21e
LW
80 int flags
81 CLEANUP:
82 if (RETVAL) {
83 if (RETVAL < 0 && errno == EPERM)
84 croak("No write permission to ndbm file");
748a9306 85 croak("ndbm store returned %d, errno %d, key \"%s\"",
a0d0e21e 86 RETVAL,errno,key.dptr);
9fe6733a 87 dbm_clearerr(db->dbp);
a0d0e21e
LW
88 }
89
049cc612 90#define ndbm_DELETE(db,key) dbm_delete(db->dbp,key)
a0d0e21e 91int
049cc612 92ndbm_DELETE(db, key)
a0d0e21e 93 NDBM_File db
9fe6733a 94 datum_key key
a0d0e21e 95
049cc612 96#define ndbm_FIRSTKEY(db) dbm_firstkey(db->dbp)
9fe6733a 97datum_key
049cc612 98ndbm_FIRSTKEY(db)
a0d0e21e
LW
99 NDBM_File db
100
049cc612 101#define ndbm_NEXTKEY(db,key) dbm_nextkey(db->dbp)
9fe6733a 102datum_key
049cc612 103ndbm_NEXTKEY(db, key)
a0d0e21e 104 NDBM_File db
9fe6733a 105 datum_key key
a0d0e21e 106
049cc612 107#define ndbm_error(db) dbm_error(db->dbp)
a0d0e21e 108int
049cc612 109ndbm_error(db)
a0d0e21e
LW
110 NDBM_File db
111
049cc612 112#define ndbm_clearerr(db) dbm_clearerr(db->dbp)
a0d0e21e 113void
049cc612 114ndbm_clearerr(db)
a0d0e21e
LW
115 NDBM_File db
116
9fe6733a
PM
117
118#define setFilter(type) \
119 { \
120 if (db->type) \
e62f7e43
PM
121 RETVAL = sv_mortalcopy(db->type) ; \
122 ST(0) = RETVAL ; \
9fe6733a
PM
123 if (db->type && (code == &PL_sv_undef)) { \
124 SvREFCNT_dec(db->type) ; \
125 db->type = NULL ; \
126 } \
127 else if (code) { \
128 if (db->type) \
129 sv_setsv(db->type, code) ; \
130 else \
131 db->type = newSVsv(code) ; \
132 } \
133 }
134
135
136
137SV *
138filter_fetch_key(db, code)
139 NDBM_File db
140 SV * code
141 SV * RETVAL = &PL_sv_undef ;
142 CODE:
143 setFilter(filter_fetch_key) ;
9fe6733a
PM
144
145SV *
146filter_store_key(db, code)
147 NDBM_File db
148 SV * code
149 SV * RETVAL = &PL_sv_undef ;
150 CODE:
151 setFilter(filter_store_key) ;
9fe6733a
PM
152
153SV *
154filter_fetch_value(db, code)
155 NDBM_File db
156 SV * code
157 SV * RETVAL = &PL_sv_undef ;
158 CODE:
159 setFilter(filter_fetch_value) ;
9fe6733a
PM
160
161SV *
162filter_store_value(db, code)
163 NDBM_File db
164 SV * code
165 SV * RETVAL = &PL_sv_undef ;
166 CODE:
167 setFilter(filter_store_value) ;
9fe6733a 168