yyparse(): extend parser stack before every shift.
[perl.git] / ext / SDBM_File / SDBM_File.xs
1 #define PERL_NO_GET_CONTEXT
2 #include "EXTERN.h"
3 #include "perl.h"
4 #include "XSUB.h"
5 #include "sdbm.h"
6
7 #define fetch_key 0
8 #define store_key 1
9 #define fetch_value 2
10 #define store_value 3
11
12 typedef struct {
13         DBM *   dbp ;
14         SV *    filter[4];
15         int     filtering ;
16         } SDBM_File_type;
17
18 typedef SDBM_File_type * SDBM_File ;
19 typedef datum datum_key ;
20 typedef datum datum_value ;
21
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)
28
29
30 MODULE = SDBM_File      PACKAGE = SDBM_File     PREFIX = sdbm_
31
32 PROTOTYPES: DISABLE
33
34 SDBM_File
35 sdbm_TIEHASH(dbtype, filename, flags, mode, pagname=NULL)
36         char *          dbtype
37         char *          filename
38         int             flags
39         int             mode
40         char *          pagname
41         CODE:
42         {
43             DBM *       dbp ;
44
45             RETVAL = NULL ;
46             if (pagname == NULL) {
47                 dbp = sdbm_open(filename, flags, mode);
48             }
49             else {
50                 dbp = sdbm_prep(filename, pagname, flags, mode);
51             }
52             if (dbp) {
53                 RETVAL = (SDBM_File)safecalloc(1, sizeof(SDBM_File_type));
54                 RETVAL->dbp = dbp ;
55             }
56             
57         }
58         OUTPUT:
59           RETVAL
60
61 void
62 sdbm_DESTROY(db)
63         SDBM_File       db
64         CODE:
65         if (db) {
66             int i = store_value;
67             sdbm_close(db->dbp);
68             do {
69                 if (db->filter[i])
70                     SvREFCNT_dec_NN(db->filter[i]);
71             } while (i-- > 0);
72             safefree(db) ;
73         }
74
75 datum_value
76 sdbm_FETCH(db, key)
77         SDBM_File       db
78         datum_key       key
79
80 int
81 sdbm_STORE(db, key, value, flags = DBM_REPLACE)
82         SDBM_File       db
83         datum_key       key
84         datum_value     value
85         int             flags
86     CLEANUP:
87         if (RETVAL) {
88             if (RETVAL < 0 && errno == EPERM)
89                 croak("No write permission to sdbm file");
90             croak("sdbm store returned %d, errno %d, key \"%s\"",
91                         RETVAL,errno,key.dptr);
92             sdbm_clearerr(db->dbp);
93         }
94
95 int
96 sdbm_DELETE(db, key)
97         SDBM_File       db
98         datum_key       key
99
100 int
101 sdbm_EXISTS(db,key)
102         SDBM_File       db
103         datum_key       key
104
105 datum_key
106 sdbm_FIRSTKEY(db)
107         SDBM_File       db
108
109 datum_key
110 sdbm_NEXTKEY(db, key)
111         SDBM_File       db
112
113 int
114 sdbm_error(db)
115         SDBM_File       db
116         ALIAS:
117         sdbm_clearerr = 1
118         CODE:
119         RETVAL = ix ? sdbm_clearerr(db->dbp) : sdbm_error(db->dbp);
120         OUTPUT:
121           RETVAL
122
123 SV *
124 filter_fetch_key(db, code)
125         SDBM_File       db
126         SV *            code
127         SV *            RETVAL = &PL_sv_undef ;
128         ALIAS:
129         SDBM_File::filter_fetch_key = fetch_key
130         SDBM_File::filter_store_key = store_key
131         SDBM_File::filter_fetch_value = fetch_value
132         SDBM_File::filter_store_value = store_value
133         CODE:
134             DBM_setFilter(db->filter[ix], code);
135
136 BOOT:
137         {
138             HV *stash = gv_stashpvs("SDBM_File", 1);
139             newCONSTSUB(stash, "PAGFEXT", newSVpvs(PAGFEXT));
140             newCONSTSUB(stash, "DIRFEXT", newSVpvs(DIRFEXT));
141             newCONSTSUB(stash, "PAIRMAX", newSVuv(PAIRMAX));
142         }