ext/GDBM_File/GDBM_File.xs

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

#include <gdbm.h>
#include <fcntl.h>

typedef struct {
        GDBM_FILE       dbp ;
        SV *    filter_fetch_key ;
        SV *    filter_store_key ;
        SV *    filter_fetch_value ;
        SV *    filter_store_value ;
        int     filtering ;
        } GDBM_File_type;

typedef GDBM_File_type * GDBM_File ;
typedef datum datum_key ;
typedef datum datum_value ;
typedef datum datum_key_copy;

#define GDBM_BLOCKSIZE 0 /* gdbm defaults to stat blocksize */

typedef void (*FATALFUNC)();

#ifndef GDBM_FAST
static int
not_here(char *s)
{
    croak("GDBM_File::%s not implemented on this architecture", s);
    return -1;
}
#endif

/* GDBM allocates the datum with system malloc() and expects the user
 * to free() it.  So we either have to free() it immediately, or have
 * perl free() it when it deallocates the SV, depending on whether
 * perl uses malloc()/free() or not. */
static void
output_datum(pTHX_ SV *arg, char *str, int size)
{
#if (!defined(MYMALLOC) || (defined(MYMALLOC) && defined(PERL_POLLUTE_MALLOC)))
        sv_usepvn(arg, str, size);
#else
        sv_setpvn(arg, str, size);
        safesysfree(str);
#endif
}

/* Versions of gdbm prior to 1.7x might not have the gdbm_sync,
   gdbm_exists, and gdbm_setopt functions.  Apparently Slackware
   (Linux) 2.1 contains gdbm-1.5 (which dates back to 1991).
*/
#ifndef GDBM_FAST
#define gdbm_exists(db,key) not_here("gdbm_exists")
#define gdbm_sync(db) (void) not_here("gdbm_sync")
#define gdbm_setopt(db,optflag,optval,optlen) not_here("gdbm_setopt")
#endif

#include "const-c.inc"

MODULE = GDBM_File      PACKAGE = GDBM_File     PREFIX = gdbm_

INCLUDE: const-xs.inc

GDBM_File
gdbm_TIEHASH(dbtype, name, read_write, mode, fatal_func = (FATALFUNC)croak)
        char *          dbtype
        char *          name
        int             read_write
        int             mode
        FATALFUNC       fatal_func
        CODE:
        {
            GDBM_FILE   dbp ;

            RETVAL = NULL ;
            if ((dbp =  gdbm_open(name, GDBM_BLOCKSIZE, read_write, mode, fatal_func))) {
                RETVAL = (GDBM_File)safemalloc(sizeof(GDBM_File_type)) ;
                Zero(RETVAL, 1, GDBM_File_type) ;
                RETVAL->dbp = dbp ;
            }
            
        }
        OUTPUT:
          RETVAL
        

#define gdbm_close(db)                  gdbm_close(db->dbp)
void
gdbm_close(db)
        GDBM_File       db
        CLEANUP:

void
gdbm_DESTROY(db)
        GDBM_File       db
        CODE:
        gdbm_close(db);
        safefree(db);

#define gdbm_FETCH(db,key)                      gdbm_fetch(db->dbp,key)
datum_value
gdbm_FETCH(db, key)
        GDBM_File       db
        datum_key_copy  key

#define gdbm_STORE(db,key,value,flags)          gdbm_store(db->dbp,key,value,flags)
int
gdbm_STORE(db, key, value, flags = GDBM_REPLACE)
        GDBM_File       db
        datum_key       key
        datum_value     value
        int             flags
    CLEANUP:
        if (RETVAL) {
            if (RETVAL < 0 && errno == EPERM)
                croak("No write permission to gdbm file");
            croak("gdbm store returned %d, errno %d, key \"%.*s\"",
                        RETVAL,errno,key.dsize,key.dptr);
        }

#define gdbm_DELETE(db,key)                     gdbm_delete(db->dbp,key)
int
gdbm_DELETE(db, key)
        GDBM_File       db
        datum_key       key

#define gdbm_FIRSTKEY(db)                       gdbm_firstkey(db->dbp)
datum_key
gdbm_FIRSTKEY(db)
        GDBM_File       db

#define gdbm_NEXTKEY(db,key)                    gdbm_nextkey(db->dbp,key)
datum_key
gdbm_NEXTKEY(db, key)
        GDBM_File       db
        datum_key       key 

#define gdbm_reorganize(db)                     gdbm_reorganize(db->dbp)
int
gdbm_reorganize(db)
        GDBM_File       db


#define gdbm_sync(db)                           gdbm_sync(db->dbp)
void
gdbm_sync(db)
        GDBM_File       db

#define gdbm_EXISTS(db,key)                     gdbm_exists(db->dbp,key)
int
gdbm_EXISTS(db, key)
        GDBM_File       db
        datum_key       key

#define gdbm_setopt(db,optflag, optval, optlen) gdbm_setopt(db->dbp,optflag, optval, optlen)
int
gdbm_setopt (db, optflag, optval, optlen)
        GDBM_File       db
        int             optflag
        int             &optval
        int             optlen


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

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

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

SV *
filter_store_value(db, code)
        GDBM_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:02 2005 UTC (21 years, 4 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			#include <gdbm.h>
6			#include <fcntl.h>
7
8			typedef struct {
9			GDBM_FILE dbp ;
10			SV * filter_fetch_key ;
11			SV * filter_store_key ;
12			SV * filter_fetch_value ;
13			SV * filter_store_value ;
14			int filtering ;
15			} GDBM_File_type;
16
17			typedef GDBM_File_type * GDBM_File ;
18			typedef datum datum_key ;
19			typedef datum datum_value ;
20			typedef datum datum_key_copy;
21
22			#define GDBM_BLOCKSIZE 0 /* gdbm defaults to stat blocksize */
23
24			typedef void (*FATALFUNC)();
25
26			#ifndef GDBM_FAST
27			static int
28			not_here(char *s)
29			{
30			croak("GDBM_File::%s not implemented on this architecture", s);
31			return -1;
32			}
33			#endif
34
35			/* GDBM allocates the datum with system malloc() and expects the user
36			* to free() it. So we either have to free() it immediately, or have
37			* perl free() it when it deallocates the SV, depending on whether
38			* perl uses malloc()/free() or not. */
39			static void
40			output_datum(pTHX_ SV arg, char str, int size)
41			{
42			#if (!defined(MYMALLOC) \|\| (defined(MYMALLOC) && defined(PERL_POLLUTE_MALLOC)))
43			sv_usepvn(arg, str, size);
44			#else
45			sv_setpvn(arg, str, size);
46			safesysfree(str);
47			#endif
48			}
49
50			/* Versions of gdbm prior to 1.7x might not have the gdbm_sync,
51			gdbm_exists, and gdbm_setopt functions. Apparently Slackware
52			(Linux) 2.1 contains gdbm-1.5 (which dates back to 1991).
53			*/
54			#ifndef GDBM_FAST
55			#define gdbm_exists(db,key) not_here("gdbm_exists")
56			#define gdbm_sync(db) (void) not_here("gdbm_sync")
57			#define gdbm_setopt(db,optflag,optval,optlen) not_here("gdbm_setopt")
58			#endif
59
60			#include "const-c.inc"
61
62			MODULE = GDBM_File PACKAGE = GDBM_File PREFIX = gdbm_
63
64			INCLUDE: const-xs.inc
65
66			GDBM_File
67			gdbm_TIEHASH(dbtype, name, read_write, mode, fatal_func = (FATALFUNC)croak)
68			char * dbtype
69			char * name
70			int read_write
71			int mode
72			FATALFUNC fatal_func
73			CODE:
74			{
75			GDBM_FILE dbp ;
76
77			RETVAL = NULL ;
78			if ((dbp = gdbm_open(name, GDBM_BLOCKSIZE, read_write, mode, fatal_func))) {
79			RETVAL = (GDBM_File)safemalloc(sizeof(GDBM_File_type)) ;
80			Zero(RETVAL, 1, GDBM_File_type) ;
81			RETVAL->dbp = dbp ;
82			}
83
84			}
85			OUTPUT:
86			RETVAL
87
88
89			#define gdbm_close(db) gdbm_close(db->dbp)
90			void
91			gdbm_close(db)
92			GDBM_File db
93			CLEANUP:
94
95			void
96			gdbm_DESTROY(db)
97			GDBM_File db
98			CODE:
99			gdbm_close(db);
100			safefree(db);
101
102			#define gdbm_FETCH(db,key) gdbm_fetch(db->dbp,key)
103			datum_value
104			gdbm_FETCH(db, key)
105			GDBM_File db
106			datum_key_copy key
107
108			#define gdbm_STORE(db,key,value,flags) gdbm_store(db->dbp,key,value,flags)
109			int
110			gdbm_STORE(db, key, value, flags = GDBM_REPLACE)
111			GDBM_File db
112			datum_key key
113			datum_value value
114			int flags
115			CLEANUP:
116			if (RETVAL) {
117			if (RETVAL < 0 && errno == EPERM)
118			croak("No write permission to gdbm file");
119			croak("gdbm store returned %d, errno %d, key \"%.*s\"",
120			RETVAL,errno,key.dsize,key.dptr);
121			}
122
123			#define gdbm_DELETE(db,key) gdbm_delete(db->dbp,key)
124			int
125			gdbm_DELETE(db, key)
126			GDBM_File db
127			datum_key key
128
129			#define gdbm_FIRSTKEY(db) gdbm_firstkey(db->dbp)
130			datum_key
131			gdbm_FIRSTKEY(db)
132			GDBM_File db
133
134			#define gdbm_NEXTKEY(db,key) gdbm_nextkey(db->dbp,key)
135			datum_key
136			gdbm_NEXTKEY(db, key)
137			GDBM_File db
138			datum_key key
139
140			#define gdbm_reorganize(db) gdbm_reorganize(db->dbp)
141			int
142			gdbm_reorganize(db)
143			GDBM_File db
144
145
146			#define gdbm_sync(db) gdbm_sync(db->dbp)
147			void
148			gdbm_sync(db)
149			GDBM_File db
150
151			#define gdbm_EXISTS(db,key) gdbm_exists(db->dbp,key)
152			int
153			gdbm_EXISTS(db, key)
154			GDBM_File db
155			datum_key key
156
157			#define gdbm_setopt(db,optflag, optval, optlen) gdbm_setopt(db->dbp,optflag, optval, optlen)
158			int
159			gdbm_setopt (db, optflag, optval, optlen)
160			GDBM_File db
161			int optflag
162			int &optval
163			int optlen
164
165
166			SV *
167			filter_fetch_key(db, code)
168			GDBM_File db
169			SV * code
170			SV * RETVAL = &PL_sv_undef ;
171			CODE:
172			DBM_setFilter(db->filter_fetch_key, code) ;
173
174			SV *
175			filter_store_key(db, code)
176			GDBM_File db
177			SV * code
178			SV * RETVAL = &PL_sv_undef ;
179			CODE:
180			DBM_setFilter(db->filter_store_key, code) ;
181
182			SV *
183			filter_fetch_value(db, code)
184			GDBM_File db
185			SV * code
186			SV * RETVAL = &PL_sv_undef ;
187			CODE:
188			DBM_setFilter(db->filter_fetch_value, code) ;
189
190			SV *
191			filter_store_value(db, code)
192			GDBM_File db
193			SV * code
194			SV * RETVAL = &PL_sv_undef ;
195			CODE:
196			DBM_setFilter(db->filter_store_value, code) ;
197