diff options
Diffstat (limited to 'ext/dbm')
-rw-r--r-- | ext/dbm/GDBM_File.c | 58 | ||||
-rw-r--r-- | ext/dbm/Makefile | 14 | ||||
-rw-r--r-- | ext/dbm/ODBM_File.c | 48 | ||||
-rw-r--r-- | ext/dbm/SDBM_File.c | 266 | ||||
-rw-r--r-- | ext/dbm/sdbm/makefile | 2 | ||||
-rw-r--r-- | ext/dbm/typemap | 24 |
6 files changed, 88 insertions, 324 deletions
diff --git a/ext/dbm/GDBM_File.c b/ext/dbm/GDBM_File.c index b5d4a8884a..f940a594cc 100644 --- a/ext/dbm/GDBM_File.c +++ b/ext/dbm/GDBM_File.c @@ -21,7 +21,7 @@ register int sp; register int items; { if (items < 5 || items > 6) { - fatal("Usage: GDBM_File::new(dbtype, name, block_size, read_write, mode, fatal_func = (FATALFUNC)fatal)"); + croak("Usage: GDBM_File::new(dbtype, name, block_size, read_write, mode, fatal_func = (FATALFUNC)croak)"); } { char * dbtype = SvPV(ST(1),na); @@ -33,7 +33,7 @@ register int items; GDBM_File RETVAL; if (items < 6) - fatal_func = (FATALFUNC)fatal; + fatal_func = (FATALFUNC)croak; else { fatal_func = (FATALFUNC)SvPV(ST(6),na); } @@ -52,7 +52,7 @@ register int sp; register int items; { if (items < 4 || items > 5) { - fatal("Usage: GDBM_File::open(name, block_size, read_write, mode, fatal_func = (FATALFUNC)fatal)"); + croak("Usage: GDBM_File::open(name, block_size, read_write, mode, fatal_func = (FATALFUNC)croak)"); } { char * name = SvPV(ST(1),na); @@ -63,7 +63,7 @@ register int items; GDBM_File RETVAL; if (items < 5) - fatal_func = (FATALFUNC)fatal; + fatal_func = (FATALFUNC)croak; else { fatal_func = (FATALFUNC)SvPV(ST(5),na); } @@ -82,15 +82,15 @@ register int sp; register int items; { if (items < 1 || items > 1) { - fatal("Usage: GDBM_File::close(db)"); + croak("Usage: GDBM_File::close(db)"); } { GDBM_File db; if (sv_isa(ST(1), "GDBM_File")) - db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else - fatal("db is not of type GDBM_File"); + croak("db is not of type GDBM_File"); gdbm_close(db); } @@ -104,15 +104,15 @@ register int sp; register int items; { if (items < 1 || items > 1) { - fatal("Usage: GDBM_File::DESTROY(db)"); + croak("Usage: GDBM_File::DESTROY(db)"); } { GDBM_File db; if (sv_isa(ST(1), "GDBM_File")) - db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else - fatal("db is not of type GDBM_File"); + croak("db is not of type GDBM_File"); gdbm_close(db); } return sp; @@ -125,7 +125,7 @@ register int sp; register int items; { if (items < 2 || items > 2) { - fatal("Usage: GDBM_File::fetch(db, key)"); + croak("Usage: GDBM_File::fetch(db, key)"); } { GDBM_File db; @@ -133,9 +133,9 @@ register int items; gdatum RETVAL; if (sv_isa(ST(1), "GDBM_File")) - db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else - fatal("db is not of type GDBM_File"); + croak("db is not of type GDBM_File"); key.dptr = SvPV(ST(2), key.dsize);; @@ -153,7 +153,7 @@ register int sp; register int items; { if (items < 3 || items > 4) { - fatal("Usage: GDBM_File::store(db, key, value, flags = GDBM_REPLACE)"); + croak("Usage: GDBM_File::store(db, key, value, flags = GDBM_REPLACE)"); } { GDBM_File db; @@ -163,9 +163,9 @@ register int items; int RETVAL; if (sv_isa(ST(1), "GDBM_File")) - db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else - fatal("db is not of type GDBM_File"); + croak("db is not of type GDBM_File"); key.dptr = SvPV(ST(2), key.dsize);; @@ -191,7 +191,7 @@ register int sp; register int items; { if (items < 2 || items > 2) { - fatal("Usage: GDBM_File::delete(db, key)"); + croak("Usage: GDBM_File::delete(db, key)"); } { GDBM_File db; @@ -199,9 +199,9 @@ register int items; int RETVAL; if (sv_isa(ST(1), "GDBM_File")) - db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else - fatal("db is not of type GDBM_File"); + croak("db is not of type GDBM_File"); key.dptr = SvPV(ST(2), key.dsize);; @@ -219,16 +219,16 @@ register int sp; register int items; { if (items < 1 || items > 1) { - fatal("Usage: GDBM_File::firstkey(db)"); + croak("Usage: GDBM_File::firstkey(db)"); } { GDBM_File db; gdatum RETVAL; if (sv_isa(ST(1), "GDBM_File")) - db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else - fatal("db is not of type GDBM_File"); + croak("db is not of type GDBM_File"); RETVAL = gdbm_firstkey(db); ST(0) = sv_mortalcopy(&sv_undef); @@ -244,7 +244,7 @@ register int sp; register int items; { if (items < 2 || items > 2) { - fatal("Usage: GDBM_File::nextkey(db, key)"); + croak("Usage: GDBM_File::nextkey(db, key)"); } { GDBM_File db; @@ -252,9 +252,9 @@ register int items; gdatum RETVAL; if (sv_isa(ST(1), "GDBM_File")) - db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else - fatal("db is not of type GDBM_File"); + croak("db is not of type GDBM_File"); key.dptr = SvPV(ST(2), key.dsize);; @@ -272,16 +272,16 @@ register int sp; register int items; { if (items < 1 || items > 1) { - fatal("Usage: GDBM_File::reorganize(db)"); + croak("Usage: GDBM_File::reorganize(db)"); } { GDBM_File db; int RETVAL; if (sv_isa(ST(1), "GDBM_File")) - db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else - fatal("db is not of type GDBM_File"); + croak("db is not of type GDBM_File"); RETVAL = gdbm_reorganize(db); ST(0) = sv_mortalcopy(&sv_undef); @@ -290,7 +290,7 @@ register int items; return sp; } -int init_GDBM_File(ix,sp,items) +int boot_GDBM_File(ix,sp,items) int ix; int sp; int items; diff --git a/ext/dbm/Makefile b/ext/dbm/Makefile index 61afe01e64..970724dd2a 100644 --- a/ext/dbm/Makefile +++ b/ext/dbm/Makefile @@ -1,14 +1,20 @@ all: NDBM_File.c ODBM_File.c GDBM_File.c SDBM_File.c NDBM_File.c: NDBM_File.xs - ../xsubpp ../typemap NDBM_File.xs >NDBM_File.c + ../xsubpp NDBM_File.xs >NDBM_File.c SDBM_File.c: SDBM_File.xs - ../xsubpp ../typemap SDBM_File.xs >SDBM_File.c + ../xsubpp SDBM_File.xs >SDBM_File.c + +SDBM_File.o: SDBM_File.c + cc -g -I../.. -pic -c SDBM_File.c + +SDBM_File.so: SDBM_File.o sdbm/libsdbm.a + ld -o SDBM_File.so SDBM_File.o sdbm/libsdbm.a ODBM_File.c: ODBM_File.xs - ../xsubpp ../typemap ODBM_File.xs >ODBM_File.c + ../xsubpp ODBM_File.xs >ODBM_File.c GDBM_File.c: GDBM_File.xs - ../xsubpp ../typemap GDBM_File.xs >GDBM_File.c + ../xsubpp GDBM_File.xs >GDBM_File.c diff --git a/ext/dbm/ODBM_File.c b/ext/dbm/ODBM_File.c index b2fa7ddcba..1aea2cec53 100644 --- a/ext/dbm/ODBM_File.c +++ b/ext/dbm/ODBM_File.c @@ -28,7 +28,7 @@ register int sp; register int items; { if (items < 4 || items > 4) { - fatal("Usage: ODBM_File::new(dbtype, filename, flags, mode)"); + croak("Usage: ODBM_File::new(dbtype, filename, flags, mode)"); } { char * dbtype = SvPV(ST(1),na); @@ -39,18 +39,18 @@ register int items; { char tmpbuf[1025]; if (dbmrefcnt++) - fatal("Old dbm can only open one database"); + 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) - fatal("ODBM_File: Can't create %s", filename); + croak("ODBM_File: Can't create %s", filename); sprintf(tmpbuf,"%s.pag",filename); if (close(creat(tmpbuf,mode)) < 0) - fatal("ODBM_File: Can't create %s", filename); + croak("ODBM_File: Can't create %s", filename); } else - fatal("ODBM_FILE: Can't open %s", filename); + croak("ODBM_FILE: Can't open %s", filename); } RETVAL = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0); ST(0) = sv_mortalcopy(&sv_undef); @@ -67,15 +67,15 @@ register int sp; register int items; { if (items < 1 || items > 1) { - fatal("Usage: ODBM_File::DESTROY(db)"); + croak("Usage: ODBM_File::DESTROY(db)"); } { ODBM_File db; if (sv_isa(ST(1), "ODBM_File")) - db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else - fatal("db is not of type ODBM_File"); + croak("db is not of type ODBM_File"); dbmrefcnt--; dbmclose(); } @@ -89,7 +89,7 @@ register int sp; register int items; { if (items < 2 || items > 2) { - fatal("Usage: ODBM_File::fetch(db, key)"); + croak("Usage: ODBM_File::fetch(db, key)"); } { ODBM_File db; @@ -97,9 +97,9 @@ register int items; datum RETVAL; if (sv_isa(ST(1), "ODBM_File")) - db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else - fatal("db is not of type ODBM_File"); + croak("db is not of type ODBM_File"); key.dptr = SvPV(ST(2), key.dsize);; @@ -117,7 +117,7 @@ register int sp; register int items; { if (items < 3 || items > 4) { - fatal("Usage: ODBM_File::store(db, key, value, flags = DBM_REPLACE)"); + croak("Usage: ODBM_File::store(db, key, value, flags = DBM_REPLACE)"); } { ODBM_File db; @@ -127,9 +127,9 @@ register int items; int RETVAL; if (sv_isa(ST(1), "ODBM_File")) - db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else - fatal("db is not of type ODBM_File"); + croak("db is not of type ODBM_File"); key.dptr = SvPV(ST(2), key.dsize);; @@ -155,7 +155,7 @@ register int sp; register int items; { if (items < 2 || items > 2) { - fatal("Usage: ODBM_File::delete(db, key)"); + croak("Usage: ODBM_File::delete(db, key)"); } { ODBM_File db; @@ -163,9 +163,9 @@ register int items; int RETVAL; if (sv_isa(ST(1), "ODBM_File")) - db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else - fatal("db is not of type ODBM_File"); + croak("db is not of type ODBM_File"); key.dptr = SvPV(ST(2), key.dsize);; @@ -183,16 +183,16 @@ register int sp; register int items; { if (items < 1 || items > 1) { - fatal("Usage: ODBM_File::firstkey(db)"); + 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*)SvANY(ST(1))); + db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else - fatal("db is not of type ODBM_File"); + croak("db is not of type ODBM_File"); RETVAL = odbm_firstkey(db); ST(0) = sv_mortalcopy(&sv_undef); @@ -208,7 +208,7 @@ register int sp; register int items; { if (items < 2 || items > 2) { - fatal("Usage: ODBM_File::nextkey(db, key)"); + croak("Usage: ODBM_File::nextkey(db, key)"); } { ODBM_File db; @@ -216,9 +216,9 @@ register int items; datum RETVAL; if (sv_isa(ST(1), "ODBM_File")) - db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); else - fatal("db is not of type ODBM_File"); + croak("db is not of type ODBM_File"); key.dptr = SvPV(ST(2), key.dsize);; @@ -229,7 +229,7 @@ register int items; return sp; } -int init_ODBM_File(ix,sp,items) +int boot_ODBM_File(ix,sp,items) int ix; int sp; int items; diff --git a/ext/dbm/SDBM_File.c b/ext/dbm/SDBM_File.c index 7baafc4a98..e69de29bb2 100644 --- a/ext/dbm/SDBM_File.c +++ b/ext/dbm/SDBM_File.c @@ -1,266 +0,0 @@ -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" -#include "ext/dbm/sdbm/sdbm.h" - -typedef DBM* SDBM_File; -#define sdbm_new(dbtype,filename,flags,mode) sdbm_open(filename,flags,mode) - -static int -XS_SDBM_File_sdbm_new(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 4 || items > 4) { - fatal("Usage: SDBM_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)); - SDBM_File RETVAL; - - RETVAL = sdbm_new(dbtype, filename, flags, mode); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setptrobj(ST(0), RETVAL, "SDBM_File"); - } - return sp; -} - -static int -XS_SDBM_File_sdbm_DESTROY(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 1 || items > 1) { - fatal("Usage: SDBM_File::DESTROY(db)"); - } - { - SDBM_File db; - - if (sv_isa(ST(1), "SDBM_File")) - db = (SDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); - else - fatal("db is not of type SDBM_File"); - sdbm_close(db); - } - return sp; -} - -static int -XS_SDBM_File_sdbm_fetch(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 2 || items > 2) { - fatal("Usage: SDBM_File::fetch(db, key)"); - } - { - SDBM_File db; - datum key; - datum RETVAL; - - if (sv_isa(ST(1), "SDBM_File")) - db = (SDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); - else - fatal("db is not of type SDBM_File"); - - key.dptr = SvPV(ST(2), key.dsize);; - - RETVAL = sdbm_fetch(db, key); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); - } - return sp; -} - -static int -XS_SDBM_File_sdbm_store(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 3 || items > 4) { - fatal("Usage: SDBM_File::store(db, key, value, flags = DBM_REPLACE)"); - } - { - SDBM_File db; - datum key; - datum value; - int flags; - int RETVAL; - - if (sv_isa(ST(1), "SDBM_File")) - db = (SDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); - else - fatal("db is not of type SDBM_File"); - - key.dptr = SvPV(ST(2), key.dsize);; - - value.dptr = SvPV(ST(3), value.dsize);; - - if (items < 4) - flags = DBM_REPLACE; - else { - flags = (int)SvIV(ST(4)); - } - - RETVAL = sdbm_store(db, key, value, flags); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setiv(ST(0), (I32)RETVAL); - } - return sp; -} - -static int -XS_SDBM_File_sdbm_delete(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 2 || items > 2) { - fatal("Usage: SDBM_File::delete(db, key)"); - } - { - SDBM_File db; - datum key; - int RETVAL; - - if (sv_isa(ST(1), "SDBM_File")) - db = (SDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); - else - fatal("db is not of type SDBM_File"); - - key.dptr = SvPV(ST(2), key.dsize);; - - RETVAL = sdbm_delete(db, key); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setiv(ST(0), (I32)RETVAL); - } - return sp; -} - -static int -XS_SDBM_File_sdbm_firstkey(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 1 || items > 1) { - fatal("Usage: SDBM_File::firstkey(db)"); - } - { - SDBM_File db; - datum RETVAL; - - if (sv_isa(ST(1), "SDBM_File")) - db = (SDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); - else - fatal("db is not of type SDBM_File"); - - RETVAL = sdbm_firstkey(db); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); - } - return sp; -} - -static int -XS_SDBM_File_sdbm_nextkey(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 2 || items > 2) { - fatal("Usage: SDBM_File::nextkey(db, key)"); - } - { - SDBM_File db; - datum key; - datum RETVAL; - - if (sv_isa(ST(1), "SDBM_File")) - db = (SDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); - else - fatal("db is not of type SDBM_File"); - - key.dptr = SvPV(ST(2), key.dsize);; - - RETVAL = sdbm_nextkey(db, key); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); - } - return sp; -} - -static int -XS_SDBM_File_sdbm_error(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 1 || items > 1) { - fatal("Usage: SDBM_File::error(db)"); - } - { - SDBM_File db; - int RETVAL; - - if (sv_isa(ST(1), "SDBM_File")) - db = (SDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); - else - fatal("db is not of type SDBM_File"); - - RETVAL = sdbm_error(db); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setiv(ST(0), (I32)RETVAL); - } - return sp; -} - -static int -XS_SDBM_File_sdbm_clearerr(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 1 || items > 1) { - fatal("Usage: SDBM_File::clearerr(db)"); - } - { - SDBM_File db; - int RETVAL; - - if (sv_isa(ST(1), "SDBM_File")) - db = (SDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); - else - fatal("db is not of type SDBM_File"); - - RETVAL = sdbm_clearerr(db); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setiv(ST(0), (I32)RETVAL); - } - return sp; -} - -int init_SDBM_File(ix,sp,items) -int ix; -int sp; -int items; -{ - char* file = __FILE__; - - newXSUB("SDBM_File::new", 0, XS_SDBM_File_sdbm_new, file); - newXSUB("SDBM_File::DESTROY", 0, XS_SDBM_File_sdbm_DESTROY, file); - newXSUB("SDBM_File::fetch", 0, XS_SDBM_File_sdbm_fetch, file); - newXSUB("SDBM_File::store", 0, XS_SDBM_File_sdbm_store, file); - newXSUB("SDBM_File::delete", 0, XS_SDBM_File_sdbm_delete, file); - newXSUB("SDBM_File::firstkey", 0, XS_SDBM_File_sdbm_firstkey, file); - newXSUB("SDBM_File::nextkey", 0, XS_SDBM_File_sdbm_nextkey, file); - newXSUB("SDBM_File::error", 0, XS_SDBM_File_sdbm_error, file); - newXSUB("SDBM_File::clearerr", 0, XS_SDBM_File_sdbm_clearerr, file); -} diff --git a/ext/dbm/sdbm/makefile b/ext/dbm/sdbm/makefile index 5dabe40242..c959c1fab5 100644 --- a/ext/dbm/sdbm/makefile +++ b/ext/dbm/sdbm/makefile @@ -2,7 +2,7 @@ # makefile for public domain ndbm-clone: sdbm # DUFF: use duff's device (loop unroll) in parts of the code # -CFLAGS = -O -DSDBM -DDUFF -DBSD42 +CFLAGS = -O -DSDBM -DDUFF -DBSD42 -pic #LDFLAGS = -p OBJS = sdbm.o pair.o hash.o diff --git a/ext/dbm/typemap b/ext/dbm/typemap new file mode 100644 index 0000000000..13147faa45 --- /dev/null +++ b/ext/dbm/typemap @@ -0,0 +1,24 @@ +# +#################################### DBM SECTION +# + +datum T_DATUM +gdatum T_GDATUM +NDBM_File T_PTROBJ +GDBM_File T_PTROBJ +SDBM_File T_PTROBJ +ODBM_File T_PTROBJ +DB_File T_PTROBJ +DBZ_File T_PTROBJ +FATALFUNC T_OPAQUEPTR + +INPUT +T_DATUM + $var.dptr = SvPV($arg, $var.dsize); +T_GDATUM + UNIMPLEMENTED +OUTPUT +T_DATUM + sv_setpvn($arg, $var.dptr, $var.dsize); +T_GDATUM + sv_usepvn($arg, $var.dptr, $var.dsize); |