This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
d23b318e0d61229d6b91bd3909e7ac64ba0d9240
[perl5.git] / ext / ODBM_File / ODBM_File.xs
1 #include "EXTERN.h"
2 #include "perl.h"
3 #include "XSUB.h"
4
5 #ifdef NULL
6 #undef NULL
7 #endif
8 #ifdef I_DBM
9 #  include <dbm.h>
10 #else
11 #  ifdef I_RPCSVC_DBM
12 #    include <rpcsvc/dbm.h>
13 #  endif
14 #endif
15
16 #ifdef DBM_BUG_DUPLICATE_FREE 
17 /*
18  * DBM on at least Ultrix and HPUX call dbmclose() from dbminit(),
19  * resulting in duplicate free() because dbmclose() does *not*
20  * check if it has already been called for this DBM.
21  * If some malloc/free calls have been done between dbmclose() and
22  * the next dbminit(), the memory might be used for something else when
23  * it is freed.
24  * Verified to work on ultrix4.3.  Probably will work on HP/UX.
25  * Set DBM_BUG_DUPLICATE_FREE in the extension hint file.
26  */
27 /* Close the previous dbm, and fail to open a new dbm */
28 #define dbmclose()      ((void) dbminit("/tmp/x/y/z/z/y"))
29 #endif
30
31 #include <fcntl.h>
32
33 typedef void* ODBM_File;
34
35 #define odbm_FETCH(db,key)                      fetch(key)
36 #define odbm_STORE(db,key,value,flags)          store(key,value)
37 #define odbm_DELETE(db,key)                     delete(key)
38 #define odbm_FIRSTKEY(db)                       firstkey()
39 #define odbm_NEXTKEY(db,key)                    nextkey(key)
40
41 static int dbmrefcnt;
42
43 #ifndef DBM_REPLACE
44 #define DBM_REPLACE 0
45 #endif
46
47 MODULE = ODBM_File      PACKAGE = ODBM_File     PREFIX = odbm_
48
49 ODBM_File
50 odbm_TIEHASH(dbtype, filename, flags, mode)
51         char *          dbtype
52         char *          filename
53         int             flags
54         int             mode
55         CODE:
56         {
57             char *tmpbuf;
58             if (dbmrefcnt++)
59                 croak("Old dbm can only open one database");
60             New(0, tmpbuf, strlen(filename) + 5, char);
61             SAVEFREEPV(tmpbuf);
62             sprintf(tmpbuf,"%s.dir",filename);
63             if (stat(tmpbuf, &statbuf) < 0) {
64                 if (flags & O_CREAT) {
65                     if (mode < 0 || close(creat(tmpbuf,mode)) < 0)
66                         croak("ODBM_File: Can't create %s", filename);
67                     sprintf(tmpbuf,"%s.pag",filename);
68                     if (close(creat(tmpbuf,mode)) < 0)
69                         croak("ODBM_File: Can't create %s", filename);
70                 }
71                 else
72                     croak("ODBM_FILE: Can't open %s", filename);
73             }
74             RETVAL = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0);
75             ST(0) = sv_mortalcopy(&sv_undef);
76             sv_setptrobj(ST(0), RETVAL, "ODBM_File");
77         }
78
79 void
80 DESTROY(db)
81         ODBM_File       db
82         CODE:
83         dbmrefcnt--;
84         dbmclose();
85
86 datum
87 odbm_FETCH(db, key)
88         ODBM_File       db
89         datum           key
90
91 int
92 odbm_STORE(db, key, value, flags = DBM_REPLACE)
93         ODBM_File       db
94         datum           key
95         datum           value
96         int             flags
97     CLEANUP:
98         if (RETVAL) {
99             if (RETVAL < 0 && errno == EPERM)
100                 croak("No write permission to odbm file");
101             croak("odbm store returned %d, errno %d, key \"%s\"",
102                         RETVAL,errno,key.dptr);
103         }
104
105 int
106 odbm_DELETE(db, key)
107         ODBM_File       db
108         datum           key
109
110 datum
111 odbm_FIRSTKEY(db)
112         ODBM_File       db
113
114 datum
115 odbm_NEXTKEY(db, key)
116         ODBM_File       db
117         datum           key
118