xref: /openbsd-src/gnu/usr.bin/perl/ext/SDBM_File/SDBM_File.xs (revision a28daedfc357b214be5c701aa8ba8adb29a7f1c2)
1 #define PERL_NO_GET_CONTEXT
2 #include "EXTERN.h"
3 #include "perl.h"
4 #include "XSUB.h"
5 #include "sdbm/sdbm.h"
6 
7 typedef struct {
8 	DBM * 	dbp ;
9 	SV *    filter_fetch_key ;
10 	SV *    filter_store_key ;
11 	SV *    filter_fetch_value ;
12 	SV *    filter_store_value ;
13 	int     filtering ;
14 	} SDBM_File_type;
15 
16 typedef SDBM_File_type * SDBM_File ;
17 typedef datum datum_key ;
18 typedef datum datum_value ;
19 
20 #define sdbm_TIEHASH(dbtype,filename,flags,mode) sdbm_open(filename,flags,mode)
21 #define sdbm_FETCH(db,key)			sdbm_fetch(db->dbp,key)
22 #define sdbm_STORE(db,key,value,flags)		sdbm_store(db->dbp,key,value,flags)
23 #define sdbm_DELETE(db,key)			sdbm_delete(db->dbp,key)
24 #define sdbm_EXISTS(db,key)			sdbm_exists(db->dbp,key)
25 #define sdbm_FIRSTKEY(db)			sdbm_firstkey(db->dbp)
26 #define sdbm_NEXTKEY(db,key)			sdbm_nextkey(db->dbp)
27 
28 
29 MODULE = SDBM_File	PACKAGE = SDBM_File	PREFIX = sdbm_
30 
31 SDBM_File
32 sdbm_TIEHASH(dbtype, filename, flags, mode)
33 	char *		dbtype
34 	char *		filename
35 	int		flags
36 	int		mode
37 	CODE:
38 	{
39 	    DBM * 	dbp ;
40 
41 	    RETVAL = NULL ;
42 	    if ((dbp = sdbm_open(filename,flags,mode))) {
43 	        RETVAL = (SDBM_File)safemalloc(sizeof(SDBM_File_type)) ;
44     	        Zero(RETVAL, 1, SDBM_File_type) ;
45 		RETVAL->dbp = dbp ;
46 	    }
47 
48 	}
49 	OUTPUT:
50 	  RETVAL
51 
52 void
53 sdbm_DESTROY(db)
54 	SDBM_File	db
55 	CODE:
56 	if (db) {
57 	    sdbm_close(db->dbp);
58 	    if (db->filter_fetch_key)
59 		SvREFCNT_dec(db->filter_fetch_key) ;
60 	    if (db->filter_store_key)
61 		SvREFCNT_dec(db->filter_store_key) ;
62 	    if (db->filter_fetch_value)
63 		SvREFCNT_dec(db->filter_fetch_value) ;
64 	    if (db->filter_store_value)
65 		SvREFCNT_dec(db->filter_store_value) ;
66 	    safefree(db) ;
67 	}
68 
69 datum_value
70 sdbm_FETCH(db, key)
71 	SDBM_File	db
72 	datum_key	key
73 
74 int
75 sdbm_STORE(db, key, value, flags = DBM_REPLACE)
76 	SDBM_File	db
77 	datum_key	key
78 	datum_value	value
79 	int		flags
80     CLEANUP:
81 	if (RETVAL) {
82 	    if (RETVAL < 0 && errno == EPERM)
83 		croak("No write permission to sdbm file");
84 	    croak("sdbm store returned %d, errno %d, key \"%s\"",
85 			RETVAL,errno,key.dptr);
86 	    sdbm_clearerr(db->dbp);
87 	}
88 
89 int
90 sdbm_DELETE(db, key)
91 	SDBM_File	db
92 	datum_key	key
93 
94 int
95 sdbm_EXISTS(db,key)
96 	SDBM_File	db
97 	datum_key	key
98 
99 datum_key
100 sdbm_FIRSTKEY(db)
101 	SDBM_File	db
102 
103 datum_key
104 sdbm_NEXTKEY(db, key)
105 	SDBM_File	db
106 	datum_key	key;
107 
108 int
109 sdbm_error(db)
110 	SDBM_File	db
111 	CODE:
112 	RETVAL = sdbm_error(db->dbp) ;
113 	OUTPUT:
114 	  RETVAL
115 
116 int
117 sdbm_clearerr(db)
118 	SDBM_File	db
119 	CODE:
120 	RETVAL = sdbm_clearerr(db->dbp) ;
121 	OUTPUT:
122 	  RETVAL
123 
124 
125 SV *
126 filter_fetch_key(db, code)
127 	SDBM_File	db
128 	SV *		code
129 	SV *		RETVAL = &PL_sv_undef ;
130 	CODE:
131 	    DBM_setFilter(db->filter_fetch_key, code) ;
132 
133 SV *
134 filter_store_key(db, code)
135 	SDBM_File	db
136 	SV *		code
137 	SV *		RETVAL =  &PL_sv_undef ;
138 	CODE:
139 	    DBM_setFilter(db->filter_store_key, code) ;
140 
141 SV *
142 filter_fetch_value(db, code)
143 	SDBM_File	db
144 	SV *		code
145 	SV *		RETVAL =  &PL_sv_undef ;
146 	CODE:
147 	    DBM_setFilter(db->filter_fetch_value, code) ;
148 
149 SV *
150 filter_store_value(db, code)
151 	SDBM_File	db
152 	SV *		code
153 	SV *		RETVAL =  &PL_sv_undef ;
154 	CODE:
155 	    DBM_setFilter(db->filter_store_value, code) ;
156 
157