This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Convert [GNOS]DBM_File::TIEHASH to safecalloc() from safemalloc() then Zero().
[perl5.git] / ext / SDBM_File / SDBM_File.xs
CommitLineData
c5be433b 1#define PERL_NO_GET_CONTEXT
a0d0e21e
LW
2#include "EXTERN.h"
3#include "perl.h"
4#include "XSUB.h"
5#include "sdbm/sdbm.h"
6
9fe6733a
PM
7typedef struct {
8 DBM * dbp ;
9 SV * filter_fetch_key ;
10 SV * filter_store_key ;
11 SV * filter_fetch_value ;
12 SV * filter_store_value ;
13 int filtering ;
14 } SDBM_File_type;
15
16typedef SDBM_File_type * SDBM_File ;
17typedef datum datum_key ;
18typedef datum datum_value ;
19
a0d0e21e 20#define sdbm_TIEHASH(dbtype,filename,flags,mode) sdbm_open(filename,flags,mode)
9fe6733a
PM
21#define sdbm_FETCH(db,key) sdbm_fetch(db->dbp,key)
22#define sdbm_STORE(db,key,value,flags) sdbm_store(db->dbp,key,value,flags)
23#define sdbm_DELETE(db,key) sdbm_delete(db->dbp,key)
24#define sdbm_EXISTS(db,key) sdbm_exists(db->dbp,key)
25#define sdbm_FIRSTKEY(db) sdbm_firstkey(db->dbp)
26#define sdbm_NEXTKEY(db,key) sdbm_nextkey(db->dbp)
a0d0e21e
LW
27
28
29MODULE = SDBM_File PACKAGE = SDBM_File PREFIX = sdbm_
30
31SDBM_File
32sdbm_TIEHASH(dbtype, filename, flags, mode)
33 char * dbtype
34 char * filename
35 int flags
36 int mode
9fe6733a
PM
37 CODE:
38 {
39 DBM * dbp ;
40
41 RETVAL = NULL ;
8063af02 42 if ((dbp = sdbm_open(filename,flags,mode))) {
a5c6857c 43 RETVAL = (SDBM_File)safecalloc(1, sizeof(SDBM_File_type));
9fe6733a
PM
44 RETVAL->dbp = dbp ;
45 }
46
47 }
48 OUTPUT:
49 RETVAL
a0d0e21e
LW
50
51void
52sdbm_DESTROY(db)
53 SDBM_File db
54 CODE:
8a0b16eb
RGS
55 if (db) {
56 sdbm_close(db->dbp);
57 if (db->filter_fetch_key)
58 SvREFCNT_dec(db->filter_fetch_key) ;
59 if (db->filter_store_key)
60 SvREFCNT_dec(db->filter_store_key) ;
61 if (db->filter_fetch_value)
62 SvREFCNT_dec(db->filter_fetch_value) ;
63 if (db->filter_store_value)
64 SvREFCNT_dec(db->filter_store_value) ;
65 safefree(db) ;
66 }
a0d0e21e 67
9fe6733a 68datum_value
a0d0e21e
LW
69sdbm_FETCH(db, key)
70 SDBM_File db
9fe6733a 71 datum_key key
a0d0e21e
LW
72
73int
74sdbm_STORE(db, key, value, flags = DBM_REPLACE)
75 SDBM_File db
9fe6733a
PM
76 datum_key key
77 datum_value value
a0d0e21e
LW
78 int flags
79 CLEANUP:
80 if (RETVAL) {
81 if (RETVAL < 0 && errno == EPERM)
82 croak("No write permission to sdbm file");
748a9306 83 croak("sdbm store returned %d, errno %d, key \"%s\"",
a0d0e21e 84 RETVAL,errno,key.dptr);
9fe6733a 85 sdbm_clearerr(db->dbp);
a0d0e21e
LW
86 }
87
88int
89sdbm_DELETE(db, key)
90 SDBM_File db
d1a52ffb 91 datum_key key
a0d0e21e 92
f4b9d880
RA
93int
94sdbm_EXISTS(db,key)
95 SDBM_File db
9fe6733a 96 datum_key key
f4b9d880 97
9fe6733a 98datum_key
a0d0e21e
LW
99sdbm_FIRSTKEY(db)
100 SDBM_File db
101
9fe6733a 102datum_key
a0d0e21e
LW
103sdbm_NEXTKEY(db, key)
104 SDBM_File db
aa0165af 105 datum_key key;
a0d0e21e
LW
106
107int
108sdbm_error(db)
109 SDBM_File db
9fe6733a
PM
110 CODE:
111 RETVAL = sdbm_error(db->dbp) ;
112 OUTPUT:
113 RETVAL
a0d0e21e
LW
114
115int
116sdbm_clearerr(db)
117 SDBM_File db
9fe6733a
PM
118 CODE:
119 RETVAL = sdbm_clearerr(db->dbp) ;
120 OUTPUT:
121 RETVAL
122
123
9fe6733a
PM
124SV *
125filter_fetch_key(db, code)
126 SDBM_File db
127 SV * code
128 SV * RETVAL = &PL_sv_undef ;
129 CODE:
6a31061a 130 DBM_setFilter(db->filter_fetch_key, code) ;
9fe6733a
PM
131
132SV *
133filter_store_key(db, code)
134 SDBM_File db
135 SV * code
136 SV * RETVAL = &PL_sv_undef ;
137 CODE:
6a31061a 138 DBM_setFilter(db->filter_store_key, code) ;
9fe6733a
PM
139
140SV *
141filter_fetch_value(db, code)
142 SDBM_File db
143 SV * code
144 SV * RETVAL = &PL_sv_undef ;
145 CODE:
6a31061a 146 DBM_setFilter(db->filter_fetch_value, code) ;
9fe6733a
PM
147
148SV *
149filter_store_value(db, code)
150 SDBM_File db
151 SV * code
152 SV * RETVAL = &PL_sv_undef ;
153 CODE:
6a31061a 154 DBM_setFilter(db->filter_store_value, code) ;
a0d0e21e 155