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 / NDBM_File / NDBM_File.xs
1 #include "EXTERN.h"
2 #include "perl.h"
3 #include "XSUB.h"
4 #include <ndbm.h>
5
6 typedef struct {
7         DBM *   dbp ;
8         SV *    filter_fetch_key ;
9         SV *    filter_store_key ;
10         SV *    filter_fetch_value ;
11         SV *    filter_store_value ;
12         int     filtering ;
13         } NDBM_File_type;
14
15 typedef NDBM_File_type * NDBM_File ;
16 typedef datum datum_key ;
17 typedef datum datum_value ;
18
19 #define ckFilter(arg,type,name)                                 \
20         if (db->type) {                                         \
21             SV * save_defsv ;                                   \
22             /* printf("filtering %s\n", name) ;*/               \
23             if (db->filtering)                                  \
24                 croak("recursion detected in %s", name) ;       \
25             db->filtering = TRUE ;                              \
26             save_defsv = newSVsv(DEFSV) ;                       \
27             sv_setsv(DEFSV, arg) ;                              \
28             PUSHMARK(sp) ;                                      \
29             (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS);  \
30             sv_setsv(arg, DEFSV) ;                              \
31             sv_setsv(DEFSV, save_defsv) ;                       \
32             SvREFCNT_dec(save_defsv) ;                          \
33             db->filtering = FALSE ;                             \
34             /*printf("end of filtering %s\n", name) ;*/         \
35         }
36
37
38 MODULE = NDBM_File      PACKAGE = NDBM_File     PREFIX = ndbm_
39
40 NDBM_File
41 ndbm_TIEHASH(dbtype, filename, flags, mode)
42         char *          dbtype
43         char *          filename
44         int             flags
45         int             mode
46         CODE:
47         {
48             DBM *       dbp ;
49
50             RETVAL = NULL ;
51             if (dbp =  dbm_open(filename, flags, mode)) {
52                 RETVAL = (NDBM_File)safemalloc(sizeof(NDBM_File_type)) ;
53                 Zero(RETVAL, 1, NDBM_File_type) ;
54                 RETVAL->dbp = dbp ;
55             }
56             
57         }
58         OUTPUT:
59           RETVAL
60
61 void
62 ndbm_DESTROY(db)
63         NDBM_File       db
64         CODE:
65         dbm_close(db->dbp);
66         safefree(db);
67
68 #define ndbm_FETCH(db,key)                      dbm_fetch(db->dbp,key)
69 datum_value
70 ndbm_FETCH(db, key)
71         NDBM_File       db
72         datum_key       key
73
74 #define ndbm_STORE(db,key,value,flags)          dbm_store(db->dbp,key,value,flags)
75 int
76 ndbm_STORE(db, key, value, flags = DBM_REPLACE)
77         NDBM_File       db
78         datum_key       key
79         datum_value     value
80         int             flags
81     CLEANUP:
82         if (RETVAL) {
83             if (RETVAL < 0 && errno == EPERM)
84                 croak("No write permission to ndbm file");
85             croak("ndbm store returned %d, errno %d, key \"%s\"",
86                         RETVAL,errno,key.dptr);
87             dbm_clearerr(db->dbp);
88         }
89
90 #define ndbm_DELETE(db,key)                     dbm_delete(db->dbp,key)
91 int
92 ndbm_DELETE(db, key)
93         NDBM_File       db
94         datum_key       key
95
96 #define ndbm_FIRSTKEY(db)                       dbm_firstkey(db->dbp)
97 datum_key
98 ndbm_FIRSTKEY(db)
99         NDBM_File       db
100
101 #define ndbm_NEXTKEY(db,key)                    dbm_nextkey(db->dbp)
102 datum_key
103 ndbm_NEXTKEY(db, key)
104         NDBM_File       db
105         datum_key       key
106
107 #define ndbm_error(db)                          dbm_error(db->dbp)
108 int
109 ndbm_error(db)
110         NDBM_File       db
111
112 #define ndbm_clearerr(db)                       dbm_clearerr(db->dbp)
113 void
114 ndbm_clearerr(db)
115         NDBM_File       db
116
117
118 #define setFilter(type)                                 \
119         {                                               \
120             if (db->type)                               \
121                 RETVAL = sv_mortalcopy(db->type) ;      \
122             ST(0) = RETVAL ;                            \
123             if (db->type && (code == &PL_sv_undef)) {   \
124                 SvREFCNT_dec(db->type) ;                \
125                 db->type = NULL ;                       \
126             }                                           \
127             else if (code) {                            \
128                 if (db->type)                           \
129                     sv_setsv(db->type, code) ;          \
130                 else                                    \
131                     db->type = newSVsv(code) ;          \
132             }                                           \
133         }
134
135
136
137 SV *
138 filter_fetch_key(db, code)
139         NDBM_File       db
140         SV *            code
141         SV *            RETVAL = &PL_sv_undef ;
142         CODE:
143             setFilter(filter_fetch_key) ;
144
145 SV *
146 filter_store_key(db, code)
147         NDBM_File       db
148         SV *            code
149         SV *            RETVAL =  &PL_sv_undef ;
150         CODE:
151             setFilter(filter_store_key) ;
152
153 SV *
154 filter_fetch_value(db, code)
155         NDBM_File       db
156         SV *            code
157         SV *            RETVAL =  &PL_sv_undef ;
158         CODE:
159             setFilter(filter_fetch_value) ;
160
161 SV *
162 filter_store_value(db, code)
163         NDBM_File       db
164         SV *            code
165         SV *            RETVAL =  &PL_sv_undef ;
166         CODE:
167             setFilter(filter_store_value) ;
168