1#include "EXTERN.h"
2#include "perl.h"
3#include "XSUB.h"
4
5#ifdef I_DBM
6#  include <dbm.h>
7#else
8#  ifdef I_RPCSVC_DBM
9#    include <rpcsvc/dbm.h>
10#  endif
11#endif
12
13#ifndef HAS_DBMINIT_PROTO
14int	dbminit(char* filename);
15int	dbmclose(void);
16datum	fetch(datum key);
17int	store(datum key, datum dat);
18int	delete(datum key);
19datum	firstkey(void);
20datum	nextkey(datum key);
21#endif
22
23#ifdef DBM_BUG_DUPLICATE_FREE
24/*
25 * DBM on at least Ultrix and HPUX call dbmclose() from dbminit(),
26 * resulting in duplicate free() because dbmclose() does *not*
27 * check if it has already been called for this DBM.
28 * If some malloc/free calls have been done between dbmclose() and
29 * the next dbminit(), the memory might be used for something else when
30 * it is freed.
31 * Verified to work on ultrix4.3.  Probably will work on HP/UX.
32 * Set DBM_BUG_DUPLICATE_FREE in the extension hint file.
33 */
34/* Close the previous dbm, and fail to open a new dbm */
35#define dbmclose()	((void) dbminit("/non/exist/ent"))
36#endif
37
38#include <fcntl.h>
39
40typedef struct {
41	void * 	dbp ;
42	SV *    filter_fetch_key ;
43	SV *    filter_store_key ;
44	SV *    filter_fetch_value ;
45	SV *    filter_store_value ;
46	int     filtering ;
47	} ODBM_File_type;
48
49typedef ODBM_File_type * ODBM_File ;
50typedef datum datum_key ;
51typedef datum datum_key_copy ;
52typedef datum datum_value ;
53
54#define odbm_FETCH(db,key)			fetch(key)
55#define odbm_STORE(db,key,value,flags)		store(key,value)
56#define odbm_DELETE(db,key)			delete(key)
57#define odbm_FIRSTKEY(db)			firstkey()
58#define odbm_NEXTKEY(db,key)			nextkey(key)
59
60#define MY_CXT_KEY "ODBM_File::_guts" XS_VERSION
61
62typedef struct {
63    int		x_dbmrefcnt;
64} my_cxt_t;
65
66START_MY_CXT
67
68#define dbmrefcnt	(MY_CXT.x_dbmrefcnt)
69
70#ifndef DBM_REPLACE
71#define DBM_REPLACE 0
72#endif
73
74MODULE = ODBM_File	PACKAGE = ODBM_File	PREFIX = odbm_
75
76BOOT:
77{
78    MY_CXT_INIT;
79}
80
81ODBM_File
82odbm_TIEHASH(dbtype, filename, flags, mode)
83	char *		dbtype
84	char *		filename
85	int		flags
86	int		mode
87	CODE:
88	{
89	    char *tmpbuf;
90	    void * dbp ;
91	    dMY_CXT;
92
93	    if (dbmrefcnt++)
94		croak("Old dbm can only open one database");
95	    New(0, tmpbuf, strlen(filename) + 5, char);
96	    SAVEFREEPV(tmpbuf);
97	    sprintf(tmpbuf,"%s.dir",filename);
98	    if (stat(tmpbuf, &PL_statbuf) < 0) {
99		if (flags & O_CREAT) {
100		    if (mode < 0 || close(creat(tmpbuf,mode)) < 0)
101			croak("ODBM_File: Can't create %s", filename);
102		    sprintf(tmpbuf,"%s.pag",filename);
103		    if (close(creat(tmpbuf,mode)) < 0)
104			croak("ODBM_File: Can't create %s", filename);
105		}
106		else
107		    croak("ODBM_FILE: Can't open %s", filename);
108	    }
109	    dbp = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0);
110	    RETVAL = (ODBM_File)safemalloc(sizeof(ODBM_File_type)) ;
111    	    Zero(RETVAL, 1, ODBM_File_type) ;
112	    RETVAL->dbp = dbp ;
113	    ST(0) = sv_mortalcopy(&PL_sv_undef);
114	    sv_setptrobj(ST(0), RETVAL, dbtype);
115	}
116
117void
118DESTROY(db)
119	ODBM_File	db
120	PREINIT:
121	dMY_CXT;
122	CODE:
123	dbmrefcnt--;
124	dbmclose();
125	safefree(db);
126
127datum_value
128odbm_FETCH(db, key)
129	ODBM_File	db
130	datum_key_copy	key
131
132int
133odbm_STORE(db, key, value, flags = DBM_REPLACE)
134	ODBM_File	db
135	datum_key	key
136	datum_value	value
137	int		flags
138    CLEANUP:
139	if (RETVAL) {
140	    if (RETVAL < 0 && errno == EPERM)
141		croak("No write permission to odbm file");
142	    croak("odbm store returned %d, errno %d, key \"%s\"",
143			RETVAL,errno,key.dptr);
144	}
145
146int
147odbm_DELETE(db, key)
148	ODBM_File	db
149	datum_key	key
150
151datum_key
152odbm_FIRSTKEY(db)
153	ODBM_File	db
154
155datum_key
156odbm_NEXTKEY(db, key)
157	ODBM_File	db
158	datum_key	key
159
160
161#define setFilter(type)					\
162	{						\
163	    if (db->type)				\
164	        RETVAL = sv_mortalcopy(db->type) ; 	\
165	    ST(0) = RETVAL ;				\
166	    if (db->type && (code == &PL_sv_undef)) {	\
167                SvREFCNT_dec(db->type) ;		\
168	        db->type = Nullsv ;			\
169	    }						\
170	    else if (code) {				\
171	        if (db->type)				\
172	            sv_setsv(db->type, code) ;		\
173	        else					\
174	            db->type = newSVsv(code) ;		\
175	    }	    					\
176	}
177
178
179
180SV *
181filter_fetch_key(db, code)
182	ODBM_File	db
183	SV *		code
184	SV *		RETVAL = &PL_sv_undef ;
185	CODE:
186	    DBM_setFilter(db->filter_fetch_key, code) ;
187
188SV *
189filter_store_key(db, code)
190	ODBM_File	db
191	SV *		code
192	SV *		RETVAL =  &PL_sv_undef ;
193	CODE:
194	    DBM_setFilter(db->filter_store_key, code) ;
195
196SV *
197filter_fetch_value(db, code)
198	ODBM_File	db
199	SV *		code
200	SV *		RETVAL =  &PL_sv_undef ;
201	CODE:
202	    DBM_setFilter(db->filter_fetch_value, code) ;
203
204SV *
205filter_store_value(db, code)
206	ODBM_File	db
207	SV *		code
208	SV *		RETVAL =  &PL_sv_undef ;
209	CODE:
210	    DBM_setFilter(db->filter_store_value, code) ;
211
212