ext/ODBM_File/ODBM_File.xs

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#ifdef I_DBM
#  include <dbm.h>
#else
#  ifdef I_RPCSVC_DBM
#    include <rpcsvc/dbm.h>
#  endif
#endif

#ifndef HAS_DBMINIT_PROTO
int     dbminit(char* filename);
int     dbmclose(void);
datum   fetch(datum key);
int     store(datum key, datum dat);
int     delete(datum key);
datum   firstkey(void);
datum   nextkey(datum key);
#endif

#ifdef DBM_BUG_DUPLICATE_FREE 
/*
 * DBM on at least Ultrix and HPUX call dbmclose() from dbminit(),
 * resulting in duplicate free() because dbmclose() does *not*
 * check if it has already been called for this DBM.
 * If some malloc/free calls have been done between dbmclose() and
 * the next dbminit(), the memory might be used for something else when
 * it is freed.
 * Verified to work on ultrix4.3.  Probably will work on HP/UX.
 * Set DBM_BUG_DUPLICATE_FREE in the extension hint file.
 */
/* Close the previous dbm, and fail to open a new dbm */
#define dbmclose()      ((void) dbminit("/non/exist/ent"))
#endif

#include <fcntl.h>

typedef struct {
        void *  dbp ;
        SV *    filter_fetch_key ;
        SV *    filter_store_key ;
        SV *    filter_fetch_value ;
        SV *    filter_store_value ;
        int     filtering ;
        } ODBM_File_type;

typedef ODBM_File_type * ODBM_File ;
typedef datum datum_key ;
typedef datum datum_key_copy ;
typedef datum datum_value ;

#define odbm_FETCH(db,key)                      fetch(key)
#define odbm_STORE(db,key,value,flags)          store(key,value)
#define odbm_DELETE(db,key)                     delete(key)
#define odbm_FIRSTKEY(db)                       firstkey()
#define odbm_NEXTKEY(db,key)                    nextkey(key)

#define MY_CXT_KEY "ODBM_File::_guts" XS_VERSION

typedef struct {
    int         x_dbmrefcnt;
} my_cxt_t;

START_MY_CXT

#define dbmrefcnt       (MY_CXT.x_dbmrefcnt)

#ifndef DBM_REPLACE
#define DBM_REPLACE 0
#endif

MODULE = ODBM_File      PACKAGE = ODBM_File     PREFIX = odbm_

BOOT:
{
    MY_CXT_INIT;
}

ODBM_File
odbm_TIEHASH(dbtype, filename, flags, mode)
        char *          dbtype
        char *          filename
        int             flags
        int             mode
        CODE:
        {
            char *tmpbuf;
            void * dbp ;
            dMY_CXT;

            if (dbmrefcnt++)
                croak("Old dbm can only open one database");
            New(0, tmpbuf, strlen(filename) + 5, char);
            SAVEFREEPV(tmpbuf);
            sprintf(tmpbuf,"%s.dir",filename);
            if (stat(tmpbuf, &PL_statbuf) < 0) {
                if (flags & O_CREAT) {
                    if (mode < 0 || close(creat(tmpbuf,mode)) < 0)
                        croak("ODBM_File: Can't create %s", filename);
                    sprintf(tmpbuf,"%s.pag",filename);
                    if (close(creat(tmpbuf,mode)) < 0)
                        croak("ODBM_File: Can't create %s", filename);
                }
                else
                    croak("ODBM_FILE: Can't open %s", filename);
            }
            dbp = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0);
            RETVAL = (ODBM_File)safemalloc(sizeof(ODBM_File_type)) ;
            Zero(RETVAL, 1, ODBM_File_type) ;
            RETVAL->dbp = dbp ;
            ST(0) = sv_mortalcopy(&PL_sv_undef);
            sv_setptrobj(ST(0), RETVAL, dbtype);
        }

void
DESTROY(db)
        ODBM_File       db
        PREINIT:
        dMY_CXT;
        CODE:
        dbmrefcnt--;
        dbmclose();
        safefree(db);

datum_value
odbm_FETCH(db, key)
        ODBM_File       db
        datum_key_copy  key

int
odbm_STORE(db, key, value, flags = DBM_REPLACE)
        ODBM_File       db
        datum_key       key
        datum_value     value
        int             flags
    CLEANUP:
        if (RETVAL) {
            if (RETVAL < 0 && errno == EPERM)
                croak("No write permission to odbm file");
            croak("odbm store returned %d, errno %d, key \"%s\"",
                        RETVAL,errno,key.dptr);
        }

int
odbm_DELETE(db, key)
        ODBM_File       db
        datum_key       key

datum_key
odbm_FIRSTKEY(db)
        ODBM_File       db

datum_key
odbm_NEXTKEY(db, key)
        ODBM_File       db
        datum_key       key


#define setFilter(type)                                 \
        {                                               \
            if (db->type)                               \
                RETVAL = sv_mortalcopy(db->type) ;      \
            ST(0) = RETVAL ;                            \
            if (db->type && (code == &PL_sv_undef)) {   \
                SvREFCNT_dec(db->type) ;                \
                db->type = Nullsv ;                     \
            }                                           \
            else if (code) {                            \
                if (db->type)                           \
                    sv_setsv(db->type, code) ;          \
                else                                    \
                    db->type = newSVsv(code) ;          \
            }                                           \
        }


SV *
filter_fetch_key(db, code)
        ODBM_File       db
        SV *            code
        SV *            RETVAL = &PL_sv_undef ;
        CODE:
            DBM_setFilter(db->filter_fetch_key, code) ;

SV *
filter_store_key(db, code)
        ODBM_File       db
        SV *            code
        SV *            RETVAL =  &PL_sv_undef ;
        CODE:
            DBM_setFilter(db->filter_store_key, code) ;

SV *
filter_fetch_value(db, code)
        ODBM_File       db
        SV *            code
        SV *            RETVAL =  &PL_sv_undef ;
        CODE:
            DBM_setFilter(db->filter_fetch_value, code) ;

SV *
filter_store_value(db, code)
        ODBM_File       db
        SV *            code
        SV *            RETVAL =  &PL_sv_undef ;
        CODE:
            DBM_setFilter(db->filter_store_value, code) ;

Revision:	1.1
Committed:	Thu Jun 30 14:27:03 2005 UTC (21 years, 3 months ago) by root
Branch:	MAIN
CVS Tags:	PERL-5-8-7, HEAD
Branch point for:	PERL
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	#include "EXTERN.h"
2			#include "perl.h"
3			#include "XSUB.h"
4
5			#ifdef I_DBM
6			# include <dbm.h>
7			#else
8			# ifdef I_RPCSVC_DBM
9			# include <rpcsvc/dbm.h>
10			# endif
11			#endif
12
13			#ifndef HAS_DBMINIT_PROTO
14			int dbminit(char* filename);
15			int dbmclose(void);
16			datum fetch(datum key);
17			int store(datum key, datum dat);
18			int delete(datum key);
19			datum firstkey(void);
20			datum nextkey(datum key);
21			#endif
22
23			#ifdef DBM_BUG_DUPLICATE_FREE
24			/*
25			* DBM on at least Ultrix and HPUX call dbmclose() from dbminit(),
26			* resulting in duplicate free() because dbmclose() does not
27			* check if it has already been called for this DBM.
28			* If some malloc/free calls have been done between dbmclose() and
29			* the next dbminit(), the memory might be used for something else when
30			* it is freed.
31			* Verified to work on ultrix4.3. Probably will work on HP/UX.
32			* Set DBM_BUG_DUPLICATE_FREE in the extension hint file.
33			*/
34			/* Close the previous dbm, and fail to open a new dbm */
35			#define dbmclose() ((void) dbminit("/non/exist/ent"))
36			#endif
37
38			#include <fcntl.h>
39
40			typedef struct {
41			void * dbp ;
42			SV * filter_fetch_key ;
43			SV * filter_store_key ;
44			SV * filter_fetch_value ;
45			SV * filter_store_value ;
46			int filtering ;
47			} ODBM_File_type;
48
49			typedef ODBM_File_type * ODBM_File ;
50			typedef datum datum_key ;
51			typedef datum datum_key_copy ;
52			typedef datum datum_value ;
53
54			#define odbm_FETCH(db,key) fetch(key)
55			#define odbm_STORE(db,key,value,flags) store(key,value)
56			#define odbm_DELETE(db,key) delete(key)
57			#define odbm_FIRSTKEY(db) firstkey()
58			#define odbm_NEXTKEY(db,key) nextkey(key)
59
60			#define MY_CXT_KEY "ODBM_File::_guts" XS_VERSION
61
62			typedef struct {
63			int x_dbmrefcnt;
64			} my_cxt_t;
65
66			START_MY_CXT
67
68			#define dbmrefcnt (MY_CXT.x_dbmrefcnt)
69
70			#ifndef DBM_REPLACE
71			#define DBM_REPLACE 0
72			#endif
73
74			MODULE = ODBM_File PACKAGE = ODBM_File PREFIX = odbm_
75
76			BOOT:
77			{
78			MY_CXT_INIT;
79			}
80
81			ODBM_File
82			odbm_TIEHASH(dbtype, filename, flags, mode)
83			char * dbtype
84			char * filename
85			int flags
86			int mode
87			CODE:
88			{
89			char *tmpbuf;
90			void * dbp ;
91			dMY_CXT;
92
93			if (dbmrefcnt++)
94			croak("Old dbm can only open one database");
95			New(0, tmpbuf, strlen(filename) + 5, char);
96			SAVEFREEPV(tmpbuf);
97			sprintf(tmpbuf,"%s.dir",filename);
98			if (stat(tmpbuf, &PL_statbuf) < 0) {
99			if (flags & O_CREAT) {
100			if (mode < 0 \|\| close(creat(tmpbuf,mode)) < 0)
101			croak("ODBM_File: Can't create %s", filename);
102			sprintf(tmpbuf,"%s.pag",filename);
103			if (close(creat(tmpbuf,mode)) < 0)
104			croak("ODBM_File: Can't create %s", filename);
105			}
106			else
107			croak("ODBM_FILE: Can't open %s", filename);
108			}
109			dbp = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0);
110			RETVAL = (ODBM_File)safemalloc(sizeof(ODBM_File_type)) ;
111			Zero(RETVAL, 1, ODBM_File_type) ;
112			RETVAL->dbp = dbp ;
113			ST(0) = sv_mortalcopy(&PL_sv_undef);
114			sv_setptrobj(ST(0), RETVAL, dbtype);
115			}
116
117			void
118			DESTROY(db)
119			ODBM_File db
120			PREINIT:
121			dMY_CXT;
122			CODE:
123			dbmrefcnt--;
124			dbmclose();
125			safefree(db);
126
127			datum_value
128			odbm_FETCH(db, key)
129			ODBM_File db
130			datum_key_copy key
131
132			int
133			odbm_STORE(db, key, value, flags = DBM_REPLACE)
134			ODBM_File db
135			datum_key key
136			datum_value value
137			int flags
138			CLEANUP:
139			if (RETVAL) {
140			if (RETVAL < 0 && errno == EPERM)
141			croak("No write permission to odbm file");
142			croak("odbm store returned %d, errno %d, key \"%s\"",
143			RETVAL,errno,key.dptr);
144			}
145
146			int
147			odbm_DELETE(db, key)
148			ODBM_File db
149			datum_key key
150
151			datum_key
152			odbm_FIRSTKEY(db)
153			ODBM_File db
154
155			datum_key
156			odbm_NEXTKEY(db, key)
157			ODBM_File db
158			datum_key key
159
160
161			#define setFilter(type) \
162			{ \
163			if (db->type) \
164			RETVAL = sv_mortalcopy(db->type) ; \
165			ST(0) = RETVAL ; \
166			if (db->type && (code == &PL_sv_undef)) { \
167			SvREFCNT_dec(db->type) ; \
168			db->type = Nullsv ; \
169			} \
170			else if (code) { \
171			if (db->type) \
172			sv_setsv(db->type, code) ; \
173			else \
174			db->type = newSVsv(code) ; \
175			} \
176			}
177
178
179
180			SV *
181			filter_fetch_key(db, code)
182			ODBM_File db
183			SV * code
184			SV * RETVAL = &PL_sv_undef ;
185			CODE:
186			DBM_setFilter(db->filter_fetch_key, code) ;
187
188			SV *
189			filter_store_key(db, code)
190			ODBM_File db
191			SV * code
192			SV * RETVAL = &PL_sv_undef ;
193			CODE:
194			DBM_setFilter(db->filter_store_key, code) ;
195
196			SV *
197			filter_fetch_value(db, code)
198			ODBM_File db
199			SV * code
200			SV * RETVAL = &PL_sv_undef ;
201			CODE:
202			DBM_setFilter(db->filter_fetch_value, code) ;
203
204			SV *
205			filter_store_value(db, code)
206			ODBM_File db
207			SV * code
208			SV * RETVAL = &PL_sv_undef ;
209			CODE:
210			DBM_setFilter(db->filter_store_value, code) ;
211