This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Use the system's free to dealloc a PV allocated by the system
[perl5.git] / ext / GDBM_File / GDBM_File.xs
CommitLineData
a0d0e21e
LW
1#include "EXTERN.h"
2#include "perl.h"
3#include "XSUB.h"
4
5#include <gdbm.h>
6#include <fcntl.h>
7
9fe6733a
PM
8typedef struct {
9 GDBM_FILE dbp ;
10 SV * filter_fetch_key ;
11 SV * filter_store_key ;
12 SV * filter_fetch_value ;
13 SV * filter_store_value ;
14 int filtering ;
15 } GDBM_File_type;
16
17typedef GDBM_File_type * GDBM_File ;
18typedef datum datum_key ;
19typedef datum datum_value ;
0bf2e707 20typedef datum datum_key_copy;
9fe6733a 21
9fe6733a 22#define GDBM_BLOCKSIZE 0 /* gdbm defaults to stat blocksize */
a0d0e21e 23
12f917ad 24typedef void (*FATALFUNC)();
a0d0e21e 25
8063af02 26#ifndef GDBM_FAST
a0d0e21e 27static int
f0f333f4 28not_here(char *s)
a0d0e21e
LW
29{
30 croak("GDBM_File::%s not implemented on this architecture", s);
31 return -1;
32}
8063af02 33#endif
a0d0e21e 34
097d66a9
GS
35/* GDBM allocates the datum with system malloc() and expects the user
36 * to free() it. So we either have to free() it immediately, or have
37 * perl free() it when it deallocates the SV, depending on whether
38 * perl uses malloc()/free() or not. */
39static void
caa0600b 40output_datum(pTHX_ SV *arg, char *str, int size)
097d66a9 41{
097d66a9 42 sv_setpvn(arg, str, size);
77b7876f 43 free(str);
097d66a9
GS
44}
45
e50aee73
AD
46/* Versions of gdbm prior to 1.7x might not have the gdbm_sync,
47 gdbm_exists, and gdbm_setopt functions. Apparently Slackware
48 (Linux) 2.1 contains gdbm-1.5 (which dates back to 1991).
49*/
50#ifndef GDBM_FAST
51#define gdbm_exists(db,key) not_here("gdbm_exists")
52#define gdbm_sync(db) (void) not_here("gdbm_sync")
53#define gdbm_setopt(db,optflag,optval,optlen) not_here("gdbm_setopt")
54#endif
55
1cb0fb50 56#include "const-c.inc"
a0d0e21e
LW
57
58MODULE = GDBM_File PACKAGE = GDBM_File PREFIX = gdbm_
59
1cb0fb50 60INCLUDE: const-xs.inc
a0d0e21e
LW
61
62GDBM_File
63gdbm_TIEHASH(dbtype, name, read_write, mode, fatal_func = (FATALFUNC)croak)
64 char * dbtype
65 char * name
66 int read_write
67 int mode
68 FATALFUNC fatal_func
9fe6733a
PM
69 CODE:
70 {
71 GDBM_FILE dbp ;
a0d0e21e 72
9fe6733a 73 RETVAL = NULL ;
8063af02 74 if ((dbp = gdbm_open(name, GDBM_BLOCKSIZE, read_write, mode, fatal_func))) {
9fe6733a
PM
75 RETVAL = (GDBM_File)safemalloc(sizeof(GDBM_File_type)) ;
76 Zero(RETVAL, 1, GDBM_File_type) ;
77 RETVAL->dbp = dbp ;
78 }
79
80 }
81 OUTPUT:
82 RETVAL
83
84
85#define gdbm_close(db) gdbm_close(db->dbp)
a0d0e21e
LW
86void
87gdbm_close(db)
88 GDBM_File db
89 CLEANUP:
90
91void
92gdbm_DESTROY(db)
93 GDBM_File db
94 CODE:
95 gdbm_close(db);
eb99164f 96 safefree(db);
a0d0e21e 97
9fe6733a
PM
98#define gdbm_FETCH(db,key) gdbm_fetch(db->dbp,key)
99datum_value
a0d0e21e
LW
100gdbm_FETCH(db, key)
101 GDBM_File db
0bf2e707 102 datum_key_copy key
a0d0e21e 103
9fe6733a 104#define gdbm_STORE(db,key,value,flags) gdbm_store(db->dbp,key,value,flags)
a0d0e21e
LW
105int
106gdbm_STORE(db, key, value, flags = GDBM_REPLACE)
107 GDBM_File db
9fe6733a
PM
108 datum_key key
109 datum_value value
a0d0e21e
LW
110 int flags
111 CLEANUP:
112 if (RETVAL) {
113 if (RETVAL < 0 && errno == EPERM)
114 croak("No write permission to gdbm file");
748a9306 115 croak("gdbm store returned %d, errno %d, key \"%.*s\"",
a0d0e21e 116 RETVAL,errno,key.dsize,key.dptr);
a0d0e21e
LW
117 }
118
9fe6733a 119#define gdbm_DELETE(db,key) gdbm_delete(db->dbp,key)
a0d0e21e
LW
120int
121gdbm_DELETE(db, key)
122 GDBM_File db
9fe6733a 123 datum_key key
a0d0e21e 124
9fe6733a
PM
125#define gdbm_FIRSTKEY(db) gdbm_firstkey(db->dbp)
126datum_key
a0d0e21e
LW
127gdbm_FIRSTKEY(db)
128 GDBM_File db
129
9fe6733a
PM
130#define gdbm_NEXTKEY(db,key) gdbm_nextkey(db->dbp,key)
131datum_key
a0d0e21e
LW
132gdbm_NEXTKEY(db, key)
133 GDBM_File db
0bf2e707 134 datum_key key
a0d0e21e 135
9fe6733a 136#define gdbm_reorganize(db) gdbm_reorganize(db->dbp)
a0d0e21e
LW
137int
138gdbm_reorganize(db)
139 GDBM_File db
140
3b35bae3 141
9fe6733a 142#define gdbm_sync(db) gdbm_sync(db->dbp)
3b35bae3
AD
143void
144gdbm_sync(db)
145 GDBM_File db
146
9fe6733a 147#define gdbm_EXISTS(db,key) gdbm_exists(db->dbp,key)
3b35bae3 148int
c07a80fd 149gdbm_EXISTS(db, key)
3b35bae3 150 GDBM_File db
9fe6733a 151 datum_key key
3b35bae3 152
9fe6733a 153#define gdbm_setopt(db,optflag, optval, optlen) gdbm_setopt(db->dbp,optflag, optval, optlen)
3b35bae3
AD
154int
155gdbm_setopt (db, optflag, optval, optlen)
156 GDBM_File db
157 int optflag
158 int &optval
159 int optlen
160
9fe6733a 161
9fe6733a
PM
162SV *
163filter_fetch_key(db, code)
164 GDBM_File db
165 SV * code
166 SV * RETVAL = &PL_sv_undef ;
167 CODE:
6a31061a 168 DBM_setFilter(db->filter_fetch_key, code) ;
9fe6733a
PM
169
170SV *
171filter_store_key(db, code)
172 GDBM_File db
173 SV * code
174 SV * RETVAL = &PL_sv_undef ;
175 CODE:
6a31061a 176 DBM_setFilter(db->filter_store_key, code) ;
9fe6733a
PM
177
178SV *
179filter_fetch_value(db, code)
180 GDBM_File db
181 SV * code
182 SV * RETVAL = &PL_sv_undef ;
183 CODE:
6a31061a 184 DBM_setFilter(db->filter_fetch_value, code) ;
9fe6733a
PM
185
186SV *
187filter_store_value(db, code)
188 GDBM_File db
189 SV * code
190 SV * RETVAL = &PL_sv_undef ;
191 CODE:
6a31061a 192 DBM_setFilter(db->filter_store_value, code) ;
9fe6733a 193