1#define PERL_NO_GET_CONTEXT
2
3#include "EXTERN.h"
4#include "perl.h"
5#include "XSUB.h"
6#undef NDBM_HEADER_USES_PROTOTYPES
7#if defined(I_GDBM_NDBM)
8#  ifdef GDBM_NDBM_H_USES_PROTOTYPES
9#    define NDBM_HEADER_USES_PROTOTYPES
10START_EXTERN_C
11#  endif
12#  include <gdbm-ndbm.h> /* Debian compatibility version */
13#elif defined(I_GDBMNDBM)
14#  ifdef GDBMNDBM_H_USES_PROTOTYPES
15#    define NDBM_HEADER_USES_PROTOTYPES
16START_EXTERN_C
17#  endif
18#  include <gdbm/ndbm.h> /* RedHat compatibility version */
19#elif defined(I_NDBM)
20#  ifdef NDBM_H_USES_PROTOTYPES
21#    define NDBM_HEADER_USES_PROTOTYPES
22START_EXTERN_C
23#  endif
24#  include <ndbm.h>
25#endif
26#ifdef NDBM_HEADER_USES_PROTOTYPES
27END_EXTERN_C
28#endif
29
30#define fetch_key 0
31#define store_key 1
32#define fetch_value 2
33#define store_value 3
34
35typedef struct {
36	DBM * 	dbp ;
37	SV *    filter[4];
38	int     filtering ;
39	} NDBM_File_type;
40
41typedef NDBM_File_type * NDBM_File ;
42typedef datum datum_key ;
43typedef datum datum_value ;
44
45
46#if defined(__cplusplus) && !defined(NDBM_HEADER_USES_PROTOTYPES)
47/* gdbm's header file used for compatibility with gdbm */
48/* isn't compatible to C++ syntax, so we need these */
49/* declarations to make everyone happy. */
50EXTERN_C DBM *dbm_open(const char *, int, mode_t);
51EXTERN_C void dbm_close(DBM *);
52EXTERN_C datum dbm_fetch(DBM *, datum);
53EXTERN_C int dbm_store(DBM *, datum, datum, int);
54EXTERN_C int dbm_delete(DBM *, datum);
55EXTERN_C datum dbm_firstkey(DBM *);
56EXTERN_C datum dbm_nextkey(DBM *);
57#endif
58
59MODULE = NDBM_File	PACKAGE = NDBM_File	PREFIX = ndbm_
60
61NDBM_File
62ndbm_TIEHASH(dbtype, filename, flags, mode)
63	char *		dbtype
64	char *		filename
65	int		flags
66	int		mode
67	CODE:
68	{
69	    DBM * 	dbp ;
70
71	    RETVAL = NULL ;
72	    if ((dbp =  dbm_open(filename, flags, mode))) {
73	        RETVAL = (NDBM_File)safecalloc(1, sizeof(NDBM_File_type));
74		RETVAL->dbp = dbp ;
75	    }
76
77	}
78	OUTPUT:
79	  RETVAL
80
81void
82ndbm_DESTROY(db)
83	NDBM_File	db
84	PREINIT:
85	int i = store_value;
86	CODE:
87	dbm_close(db->dbp);
88	do {
89	    if (db->filter[i])
90		SvREFCNT_dec(db->filter[i]);
91	} while (i-- > 0);
92	safefree(db);
93
94#define ndbm_FETCH(db,key)			dbm_fetch(db->dbp,key)
95datum_value
96ndbm_FETCH(db, key)
97	NDBM_File	db
98	datum_key	key
99
100#define ndbm_EXISTS(db,key)			dbm_fetch(db->dbp,key).dptr
101bool
102ndbm_EXISTS(db, key)
103	NDBM_File	db
104	datum_key	key
105
106#define ndbm_STORE(db,key,value,flags)		dbm_store(db->dbp,key,value,flags)
107int
108ndbm_STORE(db, key, value, flags = DBM_REPLACE)
109	NDBM_File	db
110	datum_key	key
111	datum_value	value
112	int		flags
113    CLEANUP:
114	if (RETVAL) {
115	    if (RETVAL < 0 && errno == EPERM)
116		croak("No write permission to ndbm file");
117	    croak("ndbm store returned %d, errno %d, key \"%s\"",
118                  RETVAL, errno, (const char *)key.dptr);
119	    dbm_clearerr(db->dbp);
120	}
121
122#define ndbm_DELETE(db,key)			dbm_delete(db->dbp,key)
123int
124ndbm_DELETE(db, key)
125	NDBM_File	db
126	datum_key	key
127
128#define ndbm_FIRSTKEY(db)			dbm_firstkey(db->dbp)
129datum_key
130ndbm_FIRSTKEY(db)
131	NDBM_File	db
132
133#define ndbm_NEXTKEY(db,key)			dbm_nextkey(db->dbp)
134datum_key
135ndbm_NEXTKEY(db, key)
136	NDBM_File	db
137	datum_key	key = NO_INIT
138    CLEANUP:
139	PERL_UNUSED_VAR(key);
140
141#define ndbm_error(db)				dbm_error(db->dbp)
142int
143ndbm_error(db)
144	NDBM_File	db
145    CLEANUP:
146	PERL_UNUSED_VAR(db);
147
148#define ndbm_clearerr(db)			dbm_clearerr(db->dbp)
149void
150ndbm_clearerr(db)
151	NDBM_File	db
152    CLEANUP:
153	PERL_UNUSED_VAR(db);
154
155
156SV *
157filter_fetch_key(db, code)
158	NDBM_File	db
159	SV *		code
160	SV *		RETVAL = &PL_sv_undef ;
161	ALIAS:
162	NDBM_File::filter_fetch_key = fetch_key
163	NDBM_File::filter_store_key = store_key
164	NDBM_File::filter_fetch_value = fetch_value
165	NDBM_File::filter_store_value = store_value
166	CODE:
167	    DBM_setFilter(db->filter[ix], code);
168