[p5sagit/p5-mst-13.2.git] / ODBM_File.c

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

#ifdef NULL
#undef NULL
#endif
#include <dbm.h>

#include <fcntl.h>

typedef void* ODBM_File;

#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)

static int dbmrefcnt;

#define DBM_REPLACE 0

static int
XS_ODBM_File_odbm_new(ix, ax, items)
register int ix;
register int ax;
register int items;
{
    if (items != 4) {
	croak("Usage: ODBM_File::new(dbtype, filename, flags, mode)");
    }
    {
	char *	dbtype = SvPV(ST(1),na);
	char *	filename = SvPV(ST(2),na);
	int	flags = (int)SvIV(ST(3));
	int	mode = (int)SvIV(ST(4));
	ODBM_File	RETVAL;
	{
	    char tmpbuf[1025];
	    if (dbmrefcnt++)
		croak("Old dbm can only open one database");
	    sprintf(tmpbuf,"%s.dir",filename);
	    if (stat(tmpbuf, &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);
	    }
	    RETVAL = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0);
	    ST(0) = sv_mortalcopy(&sv_undef);
	    sv_setptrobj(ST(0), RETVAL, "ODBM_File");
	}
    }
    return ax;
}

static int
XS_ODBM_File_DESTROY(ix, ax, items)
register int ix;
register int ax;
register int items;
{
    if (items != 1) {
	croak("Usage: ODBM_File::DESTROY(db)");
    }
    {
	ODBM_File	db;

	if (SvROK(ST(1)))
	    db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
	else
	    croak("db is not a reference");
	dbmrefcnt--;
	dbmclose();
    }
    return ax;
}

static int
XS_ODBM_File_odbm_fetch(ix, ax, items)
register int ix;
register int ax;
register int items;
{
    if (items != 2) {
	croak("Usage: ODBM_File::fetch(db, key)");
    }
    {
	ODBM_File	db;
	datum	key;
	datum	RETVAL;

	if (sv_isa(ST(1), "ODBM_File"))
	    db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
	else
	    croak("db is not of type ODBM_File");

	key.dptr = SvPV(ST(2), na);
	key.dsize = (int)na;;

	RETVAL = odbm_fetch(db, key);
	ST(0) = sv_newmortal();
	sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
    }
    return ax;
}

static int
XS_ODBM_File_odbm_store(ix, ax, items)
register int ix;
register int ax;
register int items;
{
    if (items < 3 || items > 4) {
	croak("Usage: ODBM_File::store(db, key, value, flags = DBM_REPLACE)");
    }
    {
	ODBM_File	db;
	datum	key;
	datum	value;
	int	flags;
	int	RETVAL;

	if (sv_isa(ST(1), "ODBM_File"))
	    db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
	else
	    croak("db is not of type ODBM_File");

	key.dptr = SvPV(ST(2), na);
	key.dsize = (int)na;;

	value.dptr = SvPV(ST(3), na);
	value.dsize = (int)na;;

	if (items < 4)
	    flags = DBM_REPLACE;
	else {
	    flags = (int)SvIV(ST(4));
	}

	RETVAL = odbm_store(db, key, value, flags);
	ST(0) = sv_newmortal();
	sv_setiv(ST(0), (I32)RETVAL);
    }
    return ax;
}

static int
XS_ODBM_File_odbm_delete(ix, ax, items)
register int ix;
register int ax;
register int items;
{
    if (items != 2) {
	croak("Usage: ODBM_File::delete(db, key)");
    }
    {
	ODBM_File	db;
	datum	key;
	int	RETVAL;

	if (sv_isa(ST(1), "ODBM_File"))
	    db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
	else
	    croak("db is not of type ODBM_File");

	key.dptr = SvPV(ST(2), na);
	key.dsize = (int)na;;

	RETVAL = odbm_delete(db, key);
	ST(0) = sv_newmortal();
	sv_setiv(ST(0), (I32)RETVAL);
    }
    return ax;
}

static int
XS_ODBM_File_odbm_firstkey(ix, ax, items)
register int ix;
register int ax;
register int items;
{
    if (items != 1) {
	croak("Usage: ODBM_File::firstkey(db)");
    }
    {
	ODBM_File	db;
	datum	RETVAL;

	if (sv_isa(ST(1), "ODBM_File"))
	    db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
	else
	    croak("db is not of type ODBM_File");

	RETVAL = odbm_firstkey(db);
	ST(0) = sv_newmortal();
	sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
    }
    return ax;
}

static int
XS_ODBM_File_odbm_nextkey(ix, ax, items)
register int ix;
register int ax;
register int items;
{
    if (items != 2) {
	croak("Usage: ODBM_File::nextkey(db, key)");
    }
    {
	ODBM_File	db;
	datum	key;
	datum	RETVAL;

	if (sv_isa(ST(1), "ODBM_File"))
	    db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
	else
	    croak("db is not of type ODBM_File");

	key.dptr = SvPV(ST(2), na);
	key.dsize = (int)na;;

	RETVAL = odbm_nextkey(db, key);
	ST(0) = sv_newmortal();
	sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
    }
    return ax;
}

int boot_ODBM_File(ix,ax,items)
int ix;
int ax;
int items;
{
    char* file = __FILE__;

    newXSUB("ODBM_File::new", 0, XS_ODBM_File_odbm_new, file);
    newXSUB("ODBM_File::DESTROY", 0, XS_ODBM_File_DESTROY, file);
    newXSUB("ODBM_File::fetch", 0, XS_ODBM_File_odbm_fetch, file);
    newXSUB("ODBM_File::store", 0, XS_ODBM_File_odbm_store, file);
    newXSUB("ODBM_File::delete", 0, XS_ODBM_File_odbm_delete, file);
    newXSUB("ODBM_File::firstkey", 0, XS_ODBM_File_odbm_firstkey, file);
    newXSUB("ODBM_File::nextkey", 0, XS_ODBM_File_odbm_nextkey, file);
}
Commit	Line	Data
463ee0b2	1	#include "EXTERN.h"
	2	#include "perl.h"
	3	#include "XSUB.h"
	4
	5	#ifdef NULL
	6	#undef NULL
	7	#endif
	8	#include <dbm.h>
	9
	10	#include <fcntl.h>
	11
	12	typedef void* ODBM_File;
	13
	14	#define odbm_fetch(db,key) fetch(key)
	15	#define odbm_store(db,key,value,flags) store(key,value)
	16	#define odbm_delete(db,key) delete(key)
	17	#define odbm_firstkey(db) firstkey()
	18	#define odbm_nextkey(db,key) nextkey(key)
	19
	20	static int dbmrefcnt;
	21
	22	#define DBM_REPLACE 0
	23
	24	static int
8990e307	25	XS_ODBM_File_odbm_new(ix, ax, items)
463ee0b2	26	register int ix;
8990e307	27	register int ax;
463ee0b2	28	register int items;
463ee0b2	29	{
8990e307	30	if (items != 4) {
463ee0b2	31	croak("Usage: ODBM_File::new(dbtype, filename, flags, mode)");
	32	}
	33	{
	34	char * dbtype = SvPV(ST(1),na);
	35	char * filename = SvPV(ST(2),na);
	36	int flags = (int)SvIV(ST(3));
	37	int mode = (int)SvIV(ST(4));
	38	ODBM_File RETVAL;
	39	{
	40	char tmpbuf[1025];
	41	if (dbmrefcnt++)
	42	croak("Old dbm can only open one database");
	43	sprintf(tmpbuf,"%s.dir",filename);
	44	if (stat(tmpbuf, &statbuf) < 0) {
	45	if (flags & O_CREAT) {
	46	if (mode < 0 \|\| close(creat(tmpbuf,mode)) < 0)
	47	croak("ODBM_File: Can't create %s", filename);
	48	sprintf(tmpbuf,"%s.pag",filename);
	49	if (close(creat(tmpbuf,mode)) < 0)
	50	croak("ODBM_File: Can't create %s", filename);
	51	}
	52	else
	53	croak("ODBM_FILE: Can't open %s", filename);
	54	}
	55	RETVAL = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0);
	56	ST(0) = sv_mortalcopy(&sv_undef);
	57	sv_setptrobj(ST(0), RETVAL, "ODBM_File");
	58	}
	59	}
8990e307	60	return ax;
463ee0b2	61	}
	62
	63	static int
8990e307	64	XS_ODBM_File_DESTROY(ix, ax, items)
463ee0b2	65	register int ix;
8990e307	66	register int ax;
463ee0b2	67	register int items;
463ee0b2	68	{
8990e307	69	if (items != 1) {
463ee0b2	70	croak("Usage: ODBM_File::DESTROY(db)");
	71	}
	72	{
	73	ODBM_File db;
	74
8990e307	75	if (SvROK(ST(1)))
8990e307	76	db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
463ee0b2	77	else
8990e307	78	croak("db is not a reference");
463ee0b2	79	dbmrefcnt--;
	80	dbmclose();
	81	}
8990e307	82	return ax;
463ee0b2	83	}
	84
	85	static int
8990e307	86	XS_ODBM_File_odbm_fetch(ix, ax, items)
463ee0b2	87	register int ix;
8990e307	88	register int ax;
463ee0b2	89	register int items;
463ee0b2	90	{
8990e307	91	if (items != 2) {
463ee0b2	92	croak("Usage: ODBM_File::fetch(db, key)");
	93	}
	94	{
	95	ODBM_File db;
	96	datum key;
	97	datum RETVAL;
	98
	99	if (sv_isa(ST(1), "ODBM_File"))
8990e307	100	db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
463ee0b2	101	else
	102	croak("db is not of type ODBM_File");
	103
2304df62	104	key.dptr = SvPV(ST(2), na);
2304df62	105	key.dsize = (int)na;;
463ee0b2	106
463ee0b2	107	RETVAL = odbm_fetch(db, key);
8990e307	108	ST(0) = sv_newmortal();
463ee0b2	109	sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
463ee0b2	110	}
8990e307	111	return ax;
463ee0b2	112	}
	113
	114	static int
8990e307	115	XS_ODBM_File_odbm_store(ix, ax, items)
463ee0b2	116	register int ix;
8990e307	117	register int ax;
463ee0b2	118	register int items;
	119	{
	120	if (items < 3 \|\| items > 4) {
	121	croak("Usage: ODBM_File::store(db, key, value, flags = DBM_REPLACE)");
	122	}
	123	{
	124	ODBM_File db;
	125	datum key;
	126	datum value;
	127	int flags;
	128	int RETVAL;
	129
	130	if (sv_isa(ST(1), "ODBM_File"))
8990e307	131	db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
463ee0b2	132	else
	133	croak("db is not of type ODBM_File");
	134
2304df62	135	key.dptr = SvPV(ST(2), na);
2304df62	136	key.dsize = (int)na;;
463ee0b2	137
2304df62	138	value.dptr = SvPV(ST(3), na);
2304df62	139	value.dsize = (int)na;;
463ee0b2	140
	141	if (items < 4)
	142	flags = DBM_REPLACE;
	143	else {
	144	flags = (int)SvIV(ST(4));
	145	}
	146
	147	RETVAL = odbm_store(db, key, value, flags);
8990e307	148	ST(0) = sv_newmortal();
463ee0b2	149	sv_setiv(ST(0), (I32)RETVAL);
463ee0b2	150	}
8990e307	151	return ax;
463ee0b2	152	}
	153
	154	static int
8990e307	155	XS_ODBM_File_odbm_delete(ix, ax, items)
463ee0b2	156	register int ix;
8990e307	157	register int ax;
463ee0b2	158	register int items;
463ee0b2	159	{
8990e307	160	if (items != 2) {
463ee0b2	161	croak("Usage: ODBM_File::delete(db, key)");
	162	}
	163	{
	164	ODBM_File db;
	165	datum key;
	166	int RETVAL;
	167
	168	if (sv_isa(ST(1), "ODBM_File"))
8990e307	169	db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
463ee0b2	170	else
	171	croak("db is not of type ODBM_File");
	172
2304df62	173	key.dptr = SvPV(ST(2), na);
2304df62	174	key.dsize = (int)na;;
463ee0b2	175
463ee0b2	176	RETVAL = odbm_delete(db, key);
8990e307	177	ST(0) = sv_newmortal();
463ee0b2	178	sv_setiv(ST(0), (I32)RETVAL);
463ee0b2	179	}
8990e307	180	return ax;
463ee0b2	181	}
	182
	183	static int
8990e307	184	XS_ODBM_File_odbm_firstkey(ix, ax, items)
463ee0b2	185	register int ix;
8990e307	186	register int ax;
463ee0b2	187	register int items;
463ee0b2	188	{
8990e307	189	if (items != 1) {
463ee0b2	190	croak("Usage: ODBM_File::firstkey(db)");
	191	}
	192	{
	193	ODBM_File db;
	194	datum RETVAL;
	195
	196	if (sv_isa(ST(1), "ODBM_File"))
8990e307	197	db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
463ee0b2	198	else
	199	croak("db is not of type ODBM_File");
	200
	201	RETVAL = odbm_firstkey(db);
8990e307	202	ST(0) = sv_newmortal();
463ee0b2	203	sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
463ee0b2	204	}
8990e307	205	return ax;
463ee0b2	206	}
	207
	208	static int
8990e307	209	XS_ODBM_File_odbm_nextkey(ix, ax, items)
463ee0b2	210	register int ix;
8990e307	211	register int ax;
463ee0b2	212	register int items;
463ee0b2	213	{
8990e307	214	if (items != 2) {
463ee0b2	215	croak("Usage: ODBM_File::nextkey(db, key)");
	216	}
	217	{
	218	ODBM_File db;
	219	datum key;
	220	datum RETVAL;
	221
	222	if (sv_isa(ST(1), "ODBM_File"))
8990e307	223	db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
463ee0b2	224	else
	225	croak("db is not of type ODBM_File");
	226
2304df62	227	key.dptr = SvPV(ST(2), na);
2304df62	228	key.dsize = (int)na;;
463ee0b2	229
463ee0b2	230	RETVAL = odbm_nextkey(db, key);
8990e307	231	ST(0) = sv_newmortal();
463ee0b2	232	sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
463ee0b2	233	}
8990e307	234	return ax;
463ee0b2	235	}
463ee0b2	236
8990e307	237	int boot_ODBM_File(ix,ax,items)
463ee0b2	238	int ix;
8990e307	239	int ax;
463ee0b2	240	int items;
	241	{
	242	char* file = __FILE__;
	243
	244	newXSUB("ODBM_File::new", 0, XS_ODBM_File_odbm_new, file);
	245	newXSUB("ODBM_File::DESTROY", 0, XS_ODBM_File_DESTROY, file);
	246	newXSUB("ODBM_File::fetch", 0, XS_ODBM_File_odbm_fetch, file);
	247	newXSUB("ODBM_File::store", 0, XS_ODBM_File_odbm_store, file);
	248	newXSUB("ODBM_File::delete", 0, XS_ODBM_File_odbm_delete, file);
	249	newXSUB("ODBM_File::firstkey", 0, XS_ODBM_File_odbm_firstkey, file);
	250	newXSUB("ODBM_File::nextkey", 0, XS_ODBM_File_odbm_nextkey, file);
	251	}