This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Remove another dead function in vms/vms.c.
[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"
ac0e53cd 5#include "sdbm.h"
a0d0e21e 6
f4603e30
NC
7#define fetch_key 0
8#define store_key 1
9#define fetch_value 2
10#define store_value 3
11
9fe6733a
PM
12typedef struct {
13 DBM * dbp ;
f4603e30 14 SV * filter[4];
9fe6733a
PM
15 int filtering ;
16 } SDBM_File_type;
17
18typedef SDBM_File_type * SDBM_File ;
19typedef datum datum_key ;
20typedef datum datum_value ;
21
9fe6733a
PM
22#define sdbm_FETCH(db,key) sdbm_fetch(db->dbp,key)
23#define sdbm_STORE(db,key,value,flags) sdbm_store(db->dbp,key,value,flags)
24#define sdbm_DELETE(db,key) sdbm_delete(db->dbp,key)
25#define sdbm_EXISTS(db,key) sdbm_exists(db->dbp,key)
26#define sdbm_FIRSTKEY(db) sdbm_firstkey(db->dbp)
27#define sdbm_NEXTKEY(db,key) sdbm_nextkey(db->dbp)
a0d0e21e
LW
28
29
30MODULE = SDBM_File PACKAGE = SDBM_File PREFIX = sdbm_
31
32SDBM_File
5ab2cf16 33sdbm_TIEHASH(dbtype, filename, flags, mode, pagname=NULL)
a0d0e21e
LW
34 char * dbtype
35 char * filename
36 int flags
37 int mode
5ab2cf16 38 char * pagname
9fe6733a
PM
39 CODE:
40 {
41 DBM * dbp ;
42
43 RETVAL = NULL ;
5ab2cf16
TC
44 if (pagname == NULL) {
45 dbp = sdbm_open(filename, flags, mode);
46 }
47 else {
48 dbp = sdbm_prep(filename, pagname, flags, mode);
49 }
50 if (dbp) {
a5c6857c 51 RETVAL = (SDBM_File)safecalloc(1, sizeof(SDBM_File_type));
9fe6733a
PM
52 RETVAL->dbp = dbp ;
53 }
54
55 }
56 OUTPUT:
57 RETVAL
a0d0e21e
LW
58
59void
60sdbm_DESTROY(db)
61 SDBM_File db
62 CODE:
8a0b16eb 63 if (db) {
f4603e30 64 int i = store_value;
8a0b16eb 65 sdbm_close(db->dbp);
f4603e30
NC
66 do {
67 if (db->filter[i])
1cbe4e6f 68 SvREFCNT_dec_NN(db->filter[i]);
f4603e30 69 } while (i-- > 0);
8a0b16eb
RGS
70 safefree(db) ;
71 }
a0d0e21e 72
9fe6733a 73datum_value
a0d0e21e
LW
74sdbm_FETCH(db, key)
75 SDBM_File db
9fe6733a 76 datum_key key
a0d0e21e
LW
77
78int
79sdbm_STORE(db, key, value, flags = DBM_REPLACE)
80 SDBM_File db
9fe6733a
PM
81 datum_key key
82 datum_value value
a0d0e21e
LW
83 int flags
84 CLEANUP:
85 if (RETVAL) {
86 if (RETVAL < 0 && errno == EPERM)
87 croak("No write permission to sdbm file");
748a9306 88 croak("sdbm store returned %d, errno %d, key \"%s\"",
a0d0e21e 89 RETVAL,errno,key.dptr);
9fe6733a 90 sdbm_clearerr(db->dbp);
a0d0e21e
LW
91 }
92
93int
94sdbm_DELETE(db, key)
95 SDBM_File db
d1a52ffb 96 datum_key key
a0d0e21e 97
f4b9d880
RA
98int
99sdbm_EXISTS(db,key)
100 SDBM_File db
9fe6733a 101 datum_key key
f4b9d880 102
9fe6733a 103datum_key
a0d0e21e
LW
104sdbm_FIRSTKEY(db)
105 SDBM_File db
106
9fe6733a 107datum_key
a0d0e21e
LW
108sdbm_NEXTKEY(db, key)
109 SDBM_File db
a0d0e21e
LW
110
111int
112sdbm_error(db)
113 SDBM_File db
157486ae
NC
114 ALIAS:
115 sdbm_clearerr = 1
9fe6733a 116 CODE:
157486ae 117 RETVAL = ix ? sdbm_clearerr(db->dbp) : sdbm_error(db->dbp);
9fe6733a
PM
118 OUTPUT:
119 RETVAL
120
9fe6733a
PM
121SV *
122filter_fetch_key(db, code)
123 SDBM_File db
124 SV * code
125 SV * RETVAL = &PL_sv_undef ;
f4603e30
NC
126 ALIAS:
127 SDBM_File::filter_fetch_key = fetch_key
128 SDBM_File::filter_store_key = store_key
129 SDBM_File::filter_fetch_value = fetch_value
130 SDBM_File::filter_store_value = store_value
9fe6733a 131 CODE:
f4603e30 132 DBM_setFilter(db->filter[ix], code);
17b33ba0
TC
133
134BOOT:
135 {
136 HV *stash = gv_stashpvs("SDBM_File", 1);
137 newCONSTSUB(stash, "PAGFEXT", newSVpvs(PAGFEXT));
138 newCONSTSUB(stash, "DIRFEXT", newSVpvs(DIRFEXT));
139 newCONSTSUB(stash, "PAIRMAX", newSVuv(PAIRMAX));
140 }