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