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