diff options
Diffstat (limited to 'contrib/perl5/ext/SDBM_File')
| -rw-r--r-- | contrib/perl5/ext/SDBM_File/Makefile.PL | 20 | ||||
| -rw-r--r-- | contrib/perl5/ext/SDBM_File/SDBM_File.pm | 12 | ||||
| -rw-r--r-- | contrib/perl5/ext/SDBM_File/SDBM_File.xs | 152 | ||||
| -rw-r--r-- | contrib/perl5/ext/SDBM_File/sdbm/Makefile.PL | 8 | ||||
| -rw-r--r-- | contrib/perl5/ext/SDBM_File/sdbm/README.too | 5 | ||||
| -rw-r--r-- | contrib/perl5/ext/SDBM_File/sdbm/dba.c | 14 | ||||
| -rw-r--r-- | contrib/perl5/ext/SDBM_File/sdbm/dbd.c | 18 | ||||
| -rw-r--r-- | contrib/perl5/ext/SDBM_File/sdbm/dbe.c | 34 | ||||
| -rw-r--r-- | contrib/perl5/ext/SDBM_File/sdbm/dbm.c | 23 | ||||
| -rw-r--r-- | contrib/perl5/ext/SDBM_File/sdbm/dbu.c | 18 | ||||
| -rw-r--r-- | contrib/perl5/ext/SDBM_File/sdbm/pair.c | 17 | ||||
| -rw-r--r-- | contrib/perl5/ext/SDBM_File/sdbm/pair.h | 2 | ||||
| -rw-r--r-- | contrib/perl5/ext/SDBM_File/sdbm/sdbm.3 | 7 | ||||
| -rw-r--r-- | contrib/perl5/ext/SDBM_File/sdbm/sdbm.c | 35 | ||||
| -rw-r--r-- | contrib/perl5/ext/SDBM_File/sdbm/sdbm.h | 39 | ||||
| -rw-r--r-- | contrib/perl5/ext/SDBM_File/typemap | 16 |
16 files changed, 302 insertions, 118 deletions
diff --git a/contrib/perl5/ext/SDBM_File/Makefile.PL b/contrib/perl5/ext/SDBM_File/Makefile.PL index 7494785..a1debb9 100644 --- a/contrib/perl5/ext/SDBM_File/Makefile.PL +++ b/contrib/perl5/ext/SDBM_File/Makefile.PL @@ -16,16 +16,30 @@ WriteMakefile( XSPROTOARG => '-noprototypes', # XXX remove later? VERSION_FROM => 'SDBM_File.pm', DEFINE => $define, + PERL_MALLOC_OK => 1, ); sub MY::postamble { - if ($^O ne 'VMS') { + if ($^O =~ /MSWin32/ && Win32::IsWin95()) { + # XXX: dmake-specific, like rest of Win95 port + return + ' +$(MYEXTLIB): sdbm/Makefile +@[ + cd sdbm + $(MAKE) all + cd .. +] +'; + } + elsif ($^O ne 'VMS') { ' $(MYEXTLIB): sdbm/Makefile cd sdbm && $(MAKE) all '; - } else { - ' + } + else { + ' $(MYEXTLIB) : [.sdbm]descrip.mms set def [.sdbm] $(MMS) all diff --git a/contrib/perl5/ext/SDBM_File/SDBM_File.pm b/contrib/perl5/ext/SDBM_File/SDBM_File.pm index a2d4df8..c5e26c8 100644 --- a/contrib/perl5/ext/SDBM_File/SDBM_File.pm +++ b/contrib/perl5/ext/SDBM_File/SDBM_File.pm @@ -1,16 +1,14 @@ package SDBM_File; use strict; -use vars qw($VERSION @ISA); require Tie::Hash; -require DynaLoader; +use XSLoader (); -@ISA = qw(Tie::Hash DynaLoader); +our @ISA = qw(Tie::Hash); +our $VERSION = "1.02" ; -$VERSION = "1.00" ; - -bootstrap SDBM_File $VERSION; +XSLoader::load 'SDBM_File', $VERSION; 1; @@ -30,6 +28,6 @@ SDBM_File - Tied access to sdbm files =head1 DESCRIPTION -See L<perlfunc/tie> +See L<perlfunc/tie>, L<perldbmfilter> =cut diff --git a/contrib/perl5/ext/SDBM_File/SDBM_File.xs b/contrib/perl5/ext/SDBM_File/SDBM_File.xs index 38eaebf..a4b9045 100644 --- a/contrib/perl5/ext/SDBM_File/SDBM_File.xs +++ b/contrib/perl5/ext/SDBM_File/SDBM_File.xs @@ -1,15 +1,47 @@ +#define PERL_NO_GET_CONTEXT #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "sdbm/sdbm.h" -typedef DBM* SDBM_File; +typedef struct { + DBM * dbp ; + SV * filter_fetch_key ; + SV * filter_store_key ; + SV * filter_fetch_value ; + SV * filter_store_value ; + int filtering ; + } SDBM_File_type; + +typedef SDBM_File_type * SDBM_File ; +typedef datum datum_key ; +typedef datum datum_value ; + +#define ckFilter(arg,type,name) \ + if (db->type) { \ + SV * save_defsv ; \ + /* printf("filtering %s\n", name) ;*/ \ + if (db->filtering) \ + croak("recursion detected in %s", name) ; \ + db->filtering = TRUE ; \ + save_defsv = newSVsv(DEFSV) ; \ + sv_setsv(DEFSV, arg) ; \ + PUSHMARK(sp) ; \ + (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS); \ + sv_setsv(arg, DEFSV) ; \ + sv_setsv(DEFSV, save_defsv) ; \ + SvREFCNT_dec(save_defsv) ; \ + db->filtering = FALSE ; \ + /*printf("end of filtering %s\n", name) ;*/ \ + } + #define sdbm_TIEHASH(dbtype,filename,flags,mode) sdbm_open(filename,flags,mode) -#define sdbm_FETCH(db,key) sdbm_fetch(db,key) -#define sdbm_STORE(db,key,value,flags) sdbm_store(db,key,value,flags) -#define sdbm_DELETE(db,key) sdbm_delete(db,key) -#define sdbm_FIRSTKEY(db) sdbm_firstkey(db) -#define sdbm_NEXTKEY(db,key) sdbm_nextkey(db) +#define sdbm_FETCH(db,key) sdbm_fetch(db->dbp,key) +#define sdbm_STORE(db,key,value,flags) sdbm_store(db->dbp,key,value,flags) +#define sdbm_DELETE(db,key) sdbm_delete(db->dbp,key) +#define sdbm_EXISTS(db,key) sdbm_exists(db->dbp,key) +#define sdbm_FIRSTKEY(db) sdbm_firstkey(db->dbp) +#define sdbm_NEXTKEY(db,key) sdbm_nextkey(db->dbp) MODULE = SDBM_File PACKAGE = SDBM_File PREFIX = sdbm_ @@ -20,23 +52,46 @@ sdbm_TIEHASH(dbtype, filename, flags, mode) char * filename int flags int mode + CODE: + { + DBM * dbp ; + + RETVAL = NULL ; + if (dbp = sdbm_open(filename,flags,mode) ) { + RETVAL = (SDBM_File)safemalloc(sizeof(SDBM_File_type)) ; + Zero(RETVAL, 1, SDBM_File_type) ; + RETVAL->dbp = dbp ; + } + + } + OUTPUT: + RETVAL void sdbm_DESTROY(db) SDBM_File db CODE: - sdbm_close(db); + sdbm_close(db->dbp); + if (db->filter_fetch_key) + SvREFCNT_dec(db->filter_fetch_key) ; + if (db->filter_store_key) + SvREFCNT_dec(db->filter_store_key) ; + if (db->filter_fetch_value) + SvREFCNT_dec(db->filter_fetch_value) ; + if (db->filter_store_value) + SvREFCNT_dec(db->filter_store_value) ; + safefree(db) ; -datum +datum_value sdbm_FETCH(db, key) SDBM_File db - datum key + datum_key key int sdbm_STORE(db, key, value, flags = DBM_REPLACE) SDBM_File db - datum key - datum value + datum_key key + datum_value value int flags CLEANUP: if (RETVAL) { @@ -44,28 +99,93 @@ sdbm_STORE(db, key, value, flags = DBM_REPLACE) croak("No write permission to sdbm file"); croak("sdbm store returned %d, errno %d, key \"%s\"", RETVAL,errno,key.dptr); - sdbm_clearerr(db); + sdbm_clearerr(db->dbp); } int sdbm_DELETE(db, key) SDBM_File db - datum key + datum_key key -datum +int +sdbm_EXISTS(db,key) + SDBM_File db + datum_key key + +datum_key sdbm_FIRSTKEY(db) SDBM_File db -datum +datum_key sdbm_NEXTKEY(db, key) SDBM_File db - datum key + datum_key key int sdbm_error(db) SDBM_File db + CODE: + RETVAL = sdbm_error(db->dbp) ; + OUTPUT: + RETVAL int sdbm_clearerr(db) SDBM_File db + CODE: + RETVAL = sdbm_clearerr(db->dbp) ; + OUTPUT: + RETVAL + + +#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 = NULL ; \ + } \ + else if (code) { \ + if (db->type) \ + sv_setsv(db->type, code) ; \ + else \ + db->type = newSVsv(code) ; \ + } \ + } + + + +SV * +filter_fetch_key(db, code) + SDBM_File db + SV * code + SV * RETVAL = &PL_sv_undef ; + CODE: + setFilter(filter_fetch_key) ; + +SV * +filter_store_key(db, code) + SDBM_File db + SV * code + SV * RETVAL = &PL_sv_undef ; + CODE: + setFilter(filter_store_key) ; + +SV * +filter_fetch_value(db, code) + SDBM_File db + SV * code + SV * RETVAL = &PL_sv_undef ; + CODE: + setFilter(filter_fetch_value) ; + +SV * +filter_store_value(db, code) + SDBM_File db + SV * code + SV * RETVAL = &PL_sv_undef ; + CODE: + setFilter(filter_store_value) ; diff --git a/contrib/perl5/ext/SDBM_File/sdbm/Makefile.PL b/contrib/perl5/ext/SDBM_File/sdbm/Makefile.PL index e6fdcf9..4453dea 100644 --- a/contrib/perl5/ext/SDBM_File/sdbm/Makefile.PL +++ b/contrib/perl5/ext/SDBM_File/sdbm/Makefile.PL @@ -42,12 +42,14 @@ INST_STATIC = libsdbm$(LIB_EXT) } sub MY::top_targets { + my $noecho = shift->{NOECHO}; + my $r = ' all :: static - $(NOECHO) $(NOOP) + ' . $noecho . '$(NOOP) config :: - $(NOECHO) $(NOOP) + ' . $noecho . '$(NOOP) lint: lint -abchx $(LIBSRCS) @@ -58,7 +60,7 @@ lint: # variables into the environment so $(MYEXTLIB) is set in here to this # value which can not be built. sdbm/libsdbm.a: - $(NOECHO) $(NOOP) + ' . $noecho . '$(NOOP) ' unless $^O eq 'VMS'; return $r; diff --git a/contrib/perl5/ext/SDBM_File/sdbm/README.too b/contrib/perl5/ext/SDBM_File/sdbm/README.too index c2d0959..1fec315 100644 --- a/contrib/perl5/ext/SDBM_File/sdbm/README.too +++ b/contrib/perl5/ext/SDBM_File/sdbm/README.too @@ -7,3 +7,8 @@ Fri Apr 15 10:15:30 EDT 1994. Additional portability/configuration changes for libsdbm by Andy Dougherty doughera@lafcol.lafayette.edu. + + +Mon Mar 22 03:24:47 PST 1999. + +sdbm_exists added to the library by Russ Allbery <rra@stanford.edu>. diff --git a/contrib/perl5/ext/SDBM_File/sdbm/dba.c b/contrib/perl5/ext/SDBM_File/sdbm/dba.c index 05e70c8..7406776 100644 --- a/contrib/perl5/ext/SDBM_File/sdbm/dba.c +++ b/contrib/perl5/ext/SDBM_File/sdbm/dba.c @@ -11,8 +11,7 @@ char *progname; extern void oops(); int -main(argc, argv) -char **argv; +main(int argc, char **argv) { int n; char *p; @@ -23,6 +22,9 @@ char **argv; if (p = argv[1]) { name = (char *) malloc((n = strlen(p)) + 5); + if (!name) + oops("cannot get memory"); + strcpy(name, p); strcpy(name + n, ".pag"); @@ -37,8 +39,8 @@ char **argv; return 0; } -sdump(pagf) -int pagf; +void +sdump(int pagf) { register b; register n = 0; @@ -67,8 +69,8 @@ int pagf; oops("read failed: block %d", n); } -pagestat(pag) -char *pag; +int +pagestat(char *pag) { register n; register free; diff --git a/contrib/perl5/ext/SDBM_File/sdbm/dbd.c b/contrib/perl5/ext/SDBM_File/sdbm/dbd.c index 04ab842..0a58d9a 100644 --- a/contrib/perl5/ext/SDBM_File/sdbm/dbd.c +++ b/contrib/perl5/ext/SDBM_File/sdbm/dbd.c @@ -14,8 +14,7 @@ extern void oops(); #define empty(page) (((short *) page)[0] == 0) int -main(argc, argv) -char **argv; +main(int argc, char **argv) { int n; char *p; @@ -26,6 +25,9 @@ char **argv; if (p = argv[1]) { name = (char *) malloc((n = strlen(p)) + 5); + if (!name) + oops("cannot get memory"); + strcpy(name, p); strcpy(name + n, ".pag"); @@ -39,8 +41,8 @@ char **argv; return 0; } -sdump(pagf) -int pagf; +void +sdump(int pagf) { register r; register n = 0; @@ -65,8 +67,8 @@ int pagf; #ifdef OLD -dispage(pag) -char *pag; +int +dispage(char *pag) { register i, n; register off; @@ -87,8 +89,8 @@ char *pag; } } #else -dispage(pag) -char *pag; +void +dispage(char *pag) { register i, n; register off; diff --git a/contrib/perl5/ext/SDBM_File/sdbm/dbe.c b/contrib/perl5/ext/SDBM_File/sdbm/dbe.c index 2a306f2..166e64e 100644 --- a/contrib/perl5/ext/SDBM_File/sdbm/dbe.c +++ b/contrib/perl5/ext/SDBM_File/sdbm/dbe.c @@ -52,10 +52,7 @@ char *optarg; /* Global argument pointer. */ #endif char -getopt(argc, argv, optstring) -int argc; -char **argv; -char *optstring; +getopt(int argc, char **argv, char *optstring) { register int c; register char *place; @@ -131,14 +128,13 @@ char *optstring; void -print_datum(db) -datum db; +print_datum(datum db) { int i; putchar('"'); for (i = 0; i < db.dsize; i++) { - if (isprint(db.dptr[i])) + if (isprint((unsigned char)db.dptr[i])) putchar(db.dptr[i]); else { putchar('\\'); @@ -152,8 +148,7 @@ datum db; datum -read_datum(s) -char *s; +read_datum(char *s) { datum db; char *p; @@ -161,6 +156,9 @@ char *s; db.dsize = 0; db.dptr = (char *) malloc(strlen(s) * sizeof(char)); + if (!db.dptr) + oops("cannot get memory"); + for (p = db.dptr; *s != '\0'; p++, db.dsize++, s++) { if (*s == '\\') { if (*++s == 'n') @@ -171,7 +169,10 @@ char *s; *p = '\f'; else if (*s == 't') *p = '\t'; - else if (isdigit(*s) && isdigit(*(s + 1)) && isdigit(*(s + 2))) { + else if (isdigit((unsigned char)*s) + && isdigit((unsigned char)*(s + 1)) + && isdigit((unsigned char)*(s + 2))) + { i = (*s++ - '0') << 6; i |= (*s++ - '0') << 3; i |= *s - '0'; @@ -191,22 +192,21 @@ char *s; char * -key2s(db) -datum db; +key2s(datum db) { char *buf; char *p1, *p2; buf = (char *) malloc((db.dsize + 1) * sizeof(char)); + if (!buf) + oops("cannot get memory"); for (p1 = buf, p2 = db.dptr; *p2 != '\0'; *p1++ = *p2++); *p1 = '\0'; return buf; } - -main(argc, argv) -int argc; -char **argv; +int +main(int argc, char **argv) { typedef enum { YOW, FETCH, STORE, DELETE, SCAN, REGEXP @@ -285,7 +285,7 @@ char **argv; } } - if (giveusage | what == YOW | argn < 1) { + if (giveusage || what == YOW || argn < 1) { fprintf(stderr, "Usage: %s databse [-m r|w|rw] [-crtx] -a|-d|-f|-F|-s [key [content]]\n", argv[0]); exit(-1); } diff --git a/contrib/perl5/ext/SDBM_File/sdbm/dbm.c b/contrib/perl5/ext/SDBM_File/sdbm/dbm.c index 1388230..dc47d70 100644 --- a/contrib/perl5/ext/SDBM_File/sdbm/dbm.c +++ b/contrib/perl5/ext/SDBM_File/sdbm/dbm.c @@ -27,8 +27,8 @@ static DBM *cur_db = NODB; static char no_db[] = "dbm: no open database\n"; -dbminit(file) - char *file; +int +dbminit(char *file) { if (cur_db != NODB) dbm_close(cur_db); @@ -43,8 +43,7 @@ dbminit(file) } long -forder(key) -datum key; +forder(datum key) { if (cur_db == NODB) { printf(no_db); @@ -54,8 +53,7 @@ datum key; } datum -fetch(key) -datum key; +fetch(datum key) { datum item; @@ -67,8 +65,8 @@ datum key; return (dbm_fetch(cur_db, key)); } -delete(key) -datum key; +int +delete(datum key) { if (cur_db == NODB) { printf(no_db); @@ -79,8 +77,8 @@ datum key; return (dbm_delete(cur_db, key)); } -store(key, dat) -datum key, dat; +int +store(datum key, datum dat) { if (cur_db == NODB) { printf(no_db); @@ -93,7 +91,7 @@ datum key, dat; } datum -firstkey() +firstkey(void) { datum item; @@ -106,8 +104,7 @@ firstkey() } datum -nextkey(key) -datum key; +nextkey(datum key) { datum item; diff --git a/contrib/perl5/ext/SDBM_File/sdbm/dbu.c b/contrib/perl5/ext/SDBM_File/sdbm/dbu.c index a3c0004..e68b78d 100644 --- a/contrib/perl5/ext/SDBM_File/sdbm/dbu.c +++ b/contrib/perl5/ext/SDBM_File/sdbm/dbu.c @@ -65,9 +65,7 @@ static cmd *parse(); static void badk(), doit(), prdatum(); int -main(argc, argv) -int argc; -char *argv[]; +main(int argc, char **argv) { int c; register cmd *act; @@ -98,9 +96,7 @@ char *argv[]; } static void -doit(act, file) -register cmd *act; -char *file; +doit(register cmd *act, char *file) { datum key; datum val; @@ -197,8 +193,7 @@ char *file; } static void -badk(word) -char *word; +badk(char *word) { register int i; @@ -214,8 +209,7 @@ char *word; } static cmd * -parse(str) -register char *str; +parse(register char *str) { register int i = CTABSIZ; register cmd *p; @@ -227,9 +221,7 @@ register char *str; } static void -prdatum(stream, d) -FILE *stream; -datum d; +prdatum(FILE *stream, datum d) { register int c; register char *p = d.dptr; diff --git a/contrib/perl5/ext/SDBM_File/sdbm/pair.c b/contrib/perl5/ext/SDBM_File/sdbm/pair.c index a9a805a..4f0fde2 100644 --- a/contrib/perl5/ext/SDBM_File/sdbm/pair.c +++ b/contrib/perl5/ext/SDBM_File/sdbm/pair.c @@ -8,7 +8,11 @@ */ #include "config.h" -#include "EXTERN.h" +#ifdef __CYGWIN__ +# define EXTCONST extern const +#else +# include "EXTERN.h" +#endif #include "sdbm.h" #include "tune.h" #include "pair.h" @@ -102,6 +106,17 @@ getpair(char *pag, datum key) return val; } +int +exipair(char *pag, datum key) +{ + register short *ino = (short *) pag; + + if (ino[0] == 0) + return 0; + + return (seepair(pag, ino[0], key.dptr, key.dsize) != 0); +} + #ifdef SEEDUPS int duppair(char *pag, datum key) diff --git a/contrib/perl5/ext/SDBM_File/sdbm/pair.h b/contrib/perl5/ext/SDBM_File/sdbm/pair.h index 8a675b9..b6944ed 100644 --- a/contrib/perl5/ext/SDBM_File/sdbm/pair.h +++ b/contrib/perl5/ext/SDBM_File/sdbm/pair.h @@ -2,6 +2,7 @@ #define chkpage sdbm__chkpage #define delpair sdbm__delpair #define duppair sdbm__duppair +#define exipair sdbm__exipair #define fitpair sdbm__fitpair #define getnkey sdbm__getnkey #define getpair sdbm__getpair @@ -11,6 +12,7 @@ extern int fitpair proto((char *, int)); extern void putpair proto((char *, datum, datum)); extern datum getpair proto((char *, datum)); +extern int exipair proto((char *, datum)); extern int delpair proto((char *, datum)); extern int chkpage proto((char *)); extern datum getnkey proto((char *, int)); diff --git a/contrib/perl5/ext/SDBM_File/sdbm/sdbm.3 b/contrib/perl5/ext/SDBM_File/sdbm/sdbm.3 index 7e5c176..fe6fe76 100644 --- a/contrib/perl5/ext/SDBM_File/sdbm/sdbm.3 +++ b/contrib/perl5/ext/SDBM_File/sdbm/sdbm.3 @@ -1,7 +1,7 @@ .\" $Id: sdbm.3,v 1.2 90/12/13 13:00:57 oz Exp $ .TH SDBM 3 "1 March 1990" .SH NAME -sdbm, sdbm_open, sdbm_prep, sdbm_close, sdbm_fetch, sdbm_store, sdbm_delete, sdbm_firstkey, sdbm_nextkey, sdbm_hash, sdbm_rdonly, sdbm_error, sdbm_clearerr, sdbm_dirfno, sdbm_pagfno \- data base subroutines +sdbm, sdbm_open, sdbm_prep, sdbm_close, sdbm_fetch, sdbm_store, sdbm_delete, sdbm_exists, sdbm_firstkey, sdbm_nextkey, sdbm_hash, sdbm_rdonly, sdbm_error, sdbm_clearerr, sdbm_dirfno, sdbm_pagfno \- data base subroutines .SH SYNOPSIS .nf .ft B @@ -26,6 +26,8 @@ int sdbm_store(\s-1DBM\s0 *db, datum key, datum val, int flags) .sp int sdbm_delete(\s-1DBM\s0 *db, datum key) .sp +int sdbm_exists(\s-1DBM\s0 *db, datum key) +.sp datum sdbm_firstkey(\s-1DBM\s0 *db) .sp datum sdbm_nextkey(\s-1DBM\s0 *db) @@ -47,6 +49,7 @@ int sdbm_pagfno(\s-1DBM\s0 *db) .IX sdbm_fetch "" "\fLsdbm_fetch\fR \(em fetch \fLsdbm\fR database data" .IX sdbm_store "" "\fLsdbm_store\fR \(em add data to \fLsdbm\fR database" .IX sdbm_delete "" "\fLsdbm_delete\fR \(em remove data from \fLsdbm\fR database" +.IX sdbm_exists "" "\fLsdbm_exists\fR \(em test \fLsdbm\fR key existence" .IX sdbm_firstkey "" "\fLsdbm_firstkey\fR \(em access \fLsdbm\fR database" .IX sdbm_nextkey "" "\fLsdbm_nextkey\fR \(em access \fLsdbm\fR database" .IX sdbm_hash "" "\fLsdbm_hash\fR \(em string hash for \fLsdbm\fR database" @@ -149,6 +152,8 @@ Given a handle, one can retrieve data associated with a key by using the routine, and associate data with a key by using the .BR sdbm_store (\|) routine. +.BR sdbm_exists (\|) +will say whether a given key exists in the database. .LP The values of the .I flags diff --git a/contrib/perl5/ext/SDBM_File/sdbm/sdbm.c b/contrib/perl5/ext/SDBM_File/sdbm/sdbm.c index c147e45..64c75cb 100644 --- a/contrib/perl5/ext/SDBM_File/sdbm/sdbm.c +++ b/contrib/perl5/ext/SDBM_File/sdbm/sdbm.c @@ -9,6 +9,9 @@ #include "INTERN.h" #include "config.h" +#ifdef WIN32 +#include "io.h" +#endif #include "sdbm.h" #include "tune.h" #include "pair.h" @@ -36,7 +39,7 @@ extern int errno; extern Malloc_t malloc proto((MEM_SIZE)); extern Free_t free proto((Malloc_t)); -extern Off_t lseek(int, Off_t, int); + #endif /* @@ -125,7 +128,7 @@ sdbm_prep(char *dirname, char *pagname, int flags, int mode) * open the files in sequence, and stat the dirfile. * If we fail anywhere, undo everything, return NULL. */ -#if defined(OS2) || defined(MSDOS) || defined(WIN32) +#if defined(OS2) || defined(MSDOS) || defined(WIN32) || defined(__CYGWIN__) flags |= O_BINARY; # endif if ((db->pagf = open(pagname, flags, mode)) > -1) { @@ -182,6 +185,18 @@ sdbm_fetch(register DBM *db, datum key) } int +sdbm_exists(register DBM *db, datum key) +{ + if (db == NULL || bad(key)) + return errno = EINVAL, -1; + + if (getpage(db, exhash(key))) + return exipair(db->pagbuf, key); + + return ioerr(db), -1; +} + +int sdbm_delete(register DBM *db, datum key) { if (db == NULL || bad(key)) @@ -416,9 +431,12 @@ getdbit(register DBM *db, register long int dbit) dirb = c / DBLKSIZ; if (dirb != db->dirbno) { + int got; if (lseek(db->dirf, OFF_DIR(dirb), SEEK_SET) < 0 - || read(db->dirf, db->dirbuf, DBLKSIZ) < 0) + || (got=read(db->dirf, db->dirbuf, DBLKSIZ)) < 0) return 0; + if (got==0) + memset(db->dirbuf,0,DBLKSIZ); db->dirbno = dirb; debug(("dir read: %d\n", dirb)); @@ -437,10 +455,12 @@ setdbit(register DBM *db, register long int dbit) dirb = c / DBLKSIZ; if (dirb != db->dirbno) { - (void) memset(db->dirbuf, 0, DBLKSIZ); + int got; if (lseek(db->dirf, OFF_DIR(dirb), SEEK_SET) < 0 - || read(db->dirf, db->dirbuf, DBLKSIZ) < 0) + || (got=read(db->dirf, db->dirbuf, DBLKSIZ)) < 0) return 0; + if (got==0) + memset(db->dirbuf,0,DBLKSIZ); db->dirbno = dirb; debug(("dir read: %d\n", dirb)); @@ -448,8 +468,13 @@ setdbit(register DBM *db, register long int dbit) db->dirbuf[c % DBLKSIZ] |= (1 << dbit % BYTESIZ); +#if 0 if (dbit >= db->maxbno) db->maxbno += DBLKSIZ * BYTESIZ; +#else + if (OFF_DIR((dirb+1))*BYTESIZ > db->maxbno) + db->maxbno=OFF_DIR((dirb+1))*BYTESIZ; +#endif if (lseek(db->dirf, OFF_DIR(dirb), SEEK_SET) < 0 || write(db->dirf, db->dirbuf, DBLKSIZ) < 0) diff --git a/contrib/perl5/ext/SDBM_File/sdbm/sdbm.h b/contrib/perl5/ext/SDBM_File/sdbm/sdbm.h index 84d5f75..86ba82d 100644 --- a/contrib/perl5/ext/SDBM_File/sdbm/sdbm.h +++ b/contrib/perl5/ext/SDBM_File/sdbm/sdbm.h @@ -79,6 +79,7 @@ extern int sdbm_delete proto((DBM *, datum)); extern int sdbm_store proto((DBM *, datum, datum, int)); extern datum sdbm_firstkey proto((DBM *)); extern datum sdbm_nextkey proto((DBM *)); +extern int sdbm_exists proto((DBM *, datum)); /* * other @@ -98,8 +99,12 @@ extern long sdbm_hash proto((char *, int)); #define dbm_clearerr sdbm_clearerr #endif -/* Most of the following is stolen from perl.h. */ +/* Most of the following is stolen from perl.h. We don't include + perl.h here because we just want the portability parts of perl.h, + not everything else. +*/ #ifndef H_PERL /* Include guard */ +#include "embed.h" /* Follow all the global renamings. */ /* * The following contortions are brought to you on behalf of all the @@ -168,27 +173,17 @@ extern long sdbm_hash proto((char *, int)); /* This comes after <stdlib.h> so we don't try to change the standard * library prototypes; we'll use our own instead. */ -#if defined(MYMALLOC) && (defined(HIDEMYMALLOC) || defined(EMBEDMYMALLOC)) - -# ifdef HIDEMYMALLOC -# define malloc Mymalloc -# define calloc Mycalloc -# define realloc Myremalloc -# define free Myfree -# endif -# ifdef EMBEDMYMALLOC -# define malloc Perl_malloc -# define calloc Perl_calloc -# define realloc Perl_realloc -# define free Perl_free -# endif - - Malloc_t malloc proto((MEM_SIZE nbytes)); - Malloc_t calloc proto((MEM_SIZE elements, MEM_SIZE size)); - Malloc_t realloc proto((Malloc_t where, MEM_SIZE nbytes)); - Free_t free proto((Malloc_t where)); - -#endif /* MYMALLOC && (HIDEMYMALLOC || EMBEDMYMALLOC) */ +#if defined(MYMALLOC) && !defined(PERL_POLLUTE_MALLOC) +# define malloc Perl_malloc +# define calloc Perl_calloc +# define realloc Perl_realloc +# define free Perl_mfree + +Malloc_t Perl_malloc proto((MEM_SIZE nbytes)); +Malloc_t Perl_calloc proto((MEM_SIZE elements, MEM_SIZE size)); +Malloc_t Perl_realloc proto((Malloc_t where, MEM_SIZE nbytes)); +Free_t Perl_mfree proto((Malloc_t where)); +#endif /* MYMALLOC */ #ifdef I_STRING #include <string.h> diff --git a/contrib/perl5/ext/SDBM_File/typemap b/contrib/perl5/ext/SDBM_File/typemap index 317a8f3..eeb5d59 100644 --- a/contrib/perl5/ext/SDBM_File/typemap +++ b/contrib/perl5/ext/SDBM_File/typemap @@ -2,7 +2,8 @@ #################################### DBM SECTION # -datum T_DATUM +datum_key T_DATUM_K +datum_value T_DATUM_V gdatum T_GDATUM NDBM_File T_PTROBJ GDBM_File T_PTROBJ @@ -13,14 +14,23 @@ DBZ_File T_PTROBJ FATALFUNC T_OPAQUEPTR INPUT -T_DATUM +T_DATUM_K + ckFilter($arg, filter_store_key, \"filter_store_key\"); + $var.dptr = SvPV($arg, PL_na); + $var.dsize = (int)PL_na; +T_DATUM_V + ckFilter($arg, filter_store_value, \"filter_store_value\"); $var.dptr = SvPV($arg, PL_na); $var.dsize = (int)PL_na; T_GDATUM UNIMPLEMENTED OUTPUT -T_DATUM +T_DATUM_K + sv_setpvn($arg, $var.dptr, $var.dsize); + ckFilter($arg, filter_fetch_key,\"filter_fetch_key\"); +T_DATUM_V sv_setpvn($arg, $var.dptr, $var.dsize); + ckFilter($arg, filter_fetch_value,\"filter_fetch_value\"); T_GDATUM sv_usepvn($arg, $var.dptr, $var.dsize); T_PTROBJ |
