summaryrefslogtreecommitdiffstats
path: root/contrib/perl5/ext/ODBM_File
diff options
context:
space:
mode:
Diffstat (limited to 'contrib/perl5/ext/ODBM_File')
-rw-r--r--contrib/perl5/ext/ODBM_File/ODBM_File.pm12
-rw-r--r--contrib/perl5/ext/ODBM_File/ODBM_File.xs114
-rw-r--r--contrib/perl5/ext/ODBM_File/hints/cygwin.pl2
-rw-r--r--contrib/perl5/ext/ODBM_File/hints/sco.pl8
-rw-r--r--contrib/perl5/ext/ODBM_File/typemap16
5 files changed, 121 insertions, 31 deletions
diff --git a/contrib/perl5/ext/ODBM_File/ODBM_File.pm b/contrib/perl5/ext/ODBM_File/ODBM_File.pm
index 923640f..57fe4c3 100644
--- a/contrib/perl5/ext/ODBM_File/ODBM_File.pm
+++ b/contrib/perl5/ext/ODBM_File/ODBM_File.pm
@@ -1,16 +1,14 @@
package ODBM_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 ODBM_File $VERSION;
+XSLoader::load 'ODBM_File', $VERSION;
1;
@@ -30,6 +28,6 @@ ODBM_File - Tied access to odbm files
=head1 DESCRIPTION
-See L<perlfunc/tie>
+See L<perlfunc/tie>, L<perldbmfilter>
=cut
diff --git a/contrib/perl5/ext/ODBM_File/ODBM_File.xs b/contrib/perl5/ext/ODBM_File/ODBM_File.xs
index 892c038..150f2ef 100644
--- a/contrib/perl5/ext/ODBM_File/ODBM_File.xs
+++ b/contrib/perl5/ext/ODBM_File/ODBM_File.xs
@@ -2,9 +2,6 @@
#include "perl.h"
#include "XSUB.h"
-#ifdef NULL
-#undef NULL /* XXX Why? */
-#endif
#ifdef I_DBM
# include <dbm.h>
#else
@@ -30,7 +27,37 @@
#include <fcntl.h>
-typedef void* ODBM_File;
+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_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 odbm_FETCH(db,key) fetch(key)
#define odbm_STORE(db,key,value,flags) store(key,value)
@@ -46,10 +73,6 @@ static int dbmrefcnt;
MODULE = ODBM_File PACKAGE = ODBM_File PREFIX = odbm_
-#ifndef NULL
-# define NULL 0
-#endif
-
ODBM_File
odbm_TIEHASH(dbtype, filename, flags, mode)
char * dbtype
@@ -59,6 +82,7 @@ odbm_TIEHASH(dbtype, filename, flags, mode)
CODE:
{
char *tmpbuf;
+ void * dbp ;
if (dbmrefcnt++)
croak("Old dbm can only open one database");
New(0, tmpbuf, strlen(filename) + 5, char);
@@ -75,7 +99,10 @@ odbm_TIEHASH(dbtype, filename, flags, mode)
else
croak("ODBM_FILE: Can't open %s", filename);
}
- RETVAL = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0);
+ 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);
}
@@ -86,17 +113,18 @@ DESTROY(db)
CODE:
dbmrefcnt--;
dbmclose();
+ safefree(db);
-datum
+datum_value
odbm_FETCH(db, key)
ODBM_File db
- datum key
+ datum_key key
int
odbm_STORE(db, key, value, flags = DBM_REPLACE)
ODBM_File db
- datum key
- datum value
+ datum_key key
+ datum_value value
int flags
CLEANUP:
if (RETVAL) {
@@ -109,14 +137,66 @@ odbm_STORE(db, key, value, flags = DBM_REPLACE)
int
odbm_DELETE(db, key)
ODBM_File db
- datum key
+ datum_key key
-datum
+datum_key
odbm_FIRSTKEY(db)
ODBM_File db
-datum
+datum_key
odbm_NEXTKEY(db, key)
ODBM_File db
- datum key
+ 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:
+ setFilter(filter_fetch_key) ;
+
+SV *
+filter_store_key(db, code)
+ ODBM_File db
+ SV * code
+ SV * RETVAL = &PL_sv_undef ;
+ CODE:
+ setFilter(filter_store_key) ;
+
+SV *
+filter_fetch_value(db, code)
+ ODBM_File db
+ SV * code
+ SV * RETVAL = &PL_sv_undef ;
+ CODE:
+ setFilter(filter_fetch_value) ;
+
+SV *
+filter_store_value(db, code)
+ ODBM_File db
+ SV * code
+ SV * RETVAL = &PL_sv_undef ;
+ CODE:
+ setFilter(filter_store_value) ;
diff --git a/contrib/perl5/ext/ODBM_File/hints/cygwin.pl b/contrib/perl5/ext/ODBM_File/hints/cygwin.pl
new file mode 100644
index 0000000..a0d33c8
--- /dev/null
+++ b/contrib/perl5/ext/ODBM_File/hints/cygwin.pl
@@ -0,0 +1,2 @@
+# uses GDBM dbm compatibility feature
+$self->{LIBS} = ['-lgdbm'];
diff --git a/contrib/perl5/ext/ODBM_File/hints/sco.pl b/contrib/perl5/ext/ODBM_File/hints/sco.pl
index 4664f2b..f551578 100644
--- a/contrib/perl5/ext/ODBM_File/hints/sco.pl
+++ b/contrib/perl5/ext/ODBM_File/hints/sco.pl
@@ -1,4 +1,4 @@
-# Some versions of SCO contain a broken -ldbm library that is missing
-# dbmclose. Some of those might have a fixed library installed as
-# -ldbm.nfs.
-$self->{LIBS} = ['-ldbm.nfs', '-ldbm'];
+# SCO ODT 3.2v4.2 has a -ldbm library that is missing dbmclose.
+# This system should have a complete library installed as -ldbm.nfs which
+# should be used instead (Probably need the networking product add-on)
+$self->{LIBS} = ['-lndbm',-e "/usr/lib/libdbm.nfs.a"?'-ldbm.nfs':'-ldbm'];
diff --git a/contrib/perl5/ext/ODBM_File/typemap b/contrib/perl5/ext/ODBM_File/typemap
index 5e12e73..7c23815 100644
--- a/contrib/perl5/ext/ODBM_File/typemap
+++ b/contrib/perl5/ext/ODBM_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,13 +14,22 @@ 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);
OpenPOWER on IntegriCloud