diff options
Diffstat (limited to 'contrib/perl5/ext/ODBM_File')
| -rw-r--r-- | contrib/perl5/ext/ODBM_File/Makefile.PL | 8 | ||||
| -rw-r--r-- | contrib/perl5/ext/ODBM_File/ODBM_File.pm | 35 | ||||
| -rw-r--r-- | contrib/perl5/ext/ODBM_File/ODBM_File.xs | 122 | ||||
| -rw-r--r-- | contrib/perl5/ext/ODBM_File/hints/dec_osf.pl | 9 | ||||
| -rw-r--r-- | contrib/perl5/ext/ODBM_File/hints/hpux.pl | 4 | ||||
| -rw-r--r-- | contrib/perl5/ext/ODBM_File/hints/sco.pl | 4 | ||||
| -rw-r--r-- | contrib/perl5/ext/ODBM_File/hints/solaris.pl | 3 | ||||
| -rw-r--r-- | contrib/perl5/ext/ODBM_File/hints/svr4.pl | 4 | ||||
| -rw-r--r-- | contrib/perl5/ext/ODBM_File/hints/ultrix.pl | 4 | ||||
| -rw-r--r-- | contrib/perl5/ext/ODBM_File/typemap | 25 |
10 files changed, 218 insertions, 0 deletions
diff --git a/contrib/perl5/ext/ODBM_File/Makefile.PL b/contrib/perl5/ext/ODBM_File/Makefile.PL new file mode 100644 index 0000000..76a5d19 --- /dev/null +++ b/contrib/perl5/ext/ODBM_File/Makefile.PL @@ -0,0 +1,8 @@ +use ExtUtils::MakeMaker; +WriteMakefile( + NAME => 'ODBM_File', + LIBS => ["-ldbm -lucb"], + MAN3PODS => ' ', # Pods will be built by installman. + XSPROTOARG => '-noprototypes', # XXX remove later? + VERSION_FROM => 'ODBM_File.pm', +); diff --git a/contrib/perl5/ext/ODBM_File/ODBM_File.pm b/contrib/perl5/ext/ODBM_File/ODBM_File.pm new file mode 100644 index 0000000..923640f --- /dev/null +++ b/contrib/perl5/ext/ODBM_File/ODBM_File.pm @@ -0,0 +1,35 @@ +package ODBM_File; + +use strict; +use vars qw($VERSION @ISA); + +require Tie::Hash; +require DynaLoader; + +@ISA = qw(Tie::Hash DynaLoader); + +$VERSION = "1.00"; + +bootstrap ODBM_File $VERSION; + +1; + +__END__ + +=head1 NAME + +ODBM_File - Tied access to odbm files + +=head1 SYNOPSIS + + use ODBM_File; + + tie(%h, 'ODBM_File', 'Op.dbmx', O_RDWR|O_CREAT, 0640); + + untie %h; + +=head1 DESCRIPTION + +See L<perlfunc/tie> + +=cut diff --git a/contrib/perl5/ext/ODBM_File/ODBM_File.xs b/contrib/perl5/ext/ODBM_File/ODBM_File.xs new file mode 100644 index 0000000..892c038 --- /dev/null +++ b/contrib/perl5/ext/ODBM_File/ODBM_File.xs @@ -0,0 +1,122 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#ifdef NULL +#undef NULL /* XXX Why? */ +#endif +#ifdef I_DBM +# include <dbm.h> +#else +# ifdef I_RPCSVC_DBM +# include <rpcsvc/dbm.h> +# endif +#endif + +#ifdef DBM_BUG_DUPLICATE_FREE +/* + * DBM on at least Ultrix and HPUX call dbmclose() from dbminit(), + * resulting in duplicate free() because dbmclose() does *not* + * check if it has already been called for this DBM. + * If some malloc/free calls have been done between dbmclose() and + * the next dbminit(), the memory might be used for something else when + * it is freed. + * Verified to work on ultrix4.3. Probably will work on HP/UX. + * Set DBM_BUG_DUPLICATE_FREE in the extension hint file. + */ +/* Close the previous dbm, and fail to open a new dbm */ +#define dbmclose() ((void) dbminit("/tmp/x/y/z/z/y")) +#endif + +#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; + +#ifndef DBM_REPLACE +#define DBM_REPLACE 0 +#endif + +MODULE = ODBM_File PACKAGE = ODBM_File PREFIX = odbm_ + +#ifndef NULL +# define NULL 0 +#endif + +ODBM_File +odbm_TIEHASH(dbtype, filename, flags, mode) + char * dbtype + char * filename + int flags + int mode + CODE: + { + char *tmpbuf; + if (dbmrefcnt++) + croak("Old dbm can only open one database"); + New(0, tmpbuf, strlen(filename) + 5, char); + SAVEFREEPV(tmpbuf); + sprintf(tmpbuf,"%s.dir",filename); + if (stat(tmpbuf, &PL_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(&PL_sv_undef); + sv_setptrobj(ST(0), RETVAL, dbtype); + } + +void +DESTROY(db) + ODBM_File db + CODE: + dbmrefcnt--; + dbmclose(); + +datum +odbm_FETCH(db, key) + ODBM_File db + datum key + +int +odbm_STORE(db, key, value, flags = DBM_REPLACE) + ODBM_File db + datum key + datum value + int flags + CLEANUP: + if (RETVAL) { + if (RETVAL < 0 && errno == EPERM) + croak("No write permission to odbm file"); + croak("odbm store returned %d, errno %d, key \"%s\"", + RETVAL,errno,key.dptr); + } + +int +odbm_DELETE(db, key) + ODBM_File db + datum key + +datum +odbm_FIRSTKEY(db) + ODBM_File db + +datum +odbm_NEXTKEY(db, key) + ODBM_File db + datum key + diff --git a/contrib/perl5/ext/ODBM_File/hints/dec_osf.pl b/contrib/perl5/ext/ODBM_File/hints/dec_osf.pl new file mode 100644 index 0000000..febb7cd --- /dev/null +++ b/contrib/perl5/ext/ODBM_File/hints/dec_osf.pl @@ -0,0 +1,9 @@ +# The -hidden option causes compilation to fail on Digital Unix. +# Andy Dougherty <doughera@lafcol.lafayette.edu> +# Sat Jan 13 16:29:52 EST 1996 +$self->{LDDLFLAGS} = $Config{lddlflags}; +$self->{LDDLFLAGS} =~ s/-hidden//; +# As long as we're hinting, note the known location of the dbm routines. +# Spider Boardman <spider@Orb.Nashua.NH.US> +# Fri Feb 21 14:50:31 EST 1997 +$self->{LIBS} = ['-ldbm']; diff --git a/contrib/perl5/ext/ODBM_File/hints/hpux.pl b/contrib/perl5/ext/ODBM_File/hints/hpux.pl new file mode 100644 index 0000000..31f9d24 --- /dev/null +++ b/contrib/perl5/ext/ODBM_File/hints/hpux.pl @@ -0,0 +1,4 @@ +# Try to work around "bad free" messages. See note in ODBM_File.xs. +# Andy Dougherty <doughera@lafcol.lafayette.edu> +# Sun Sep 8 12:57:52 EDT 1996 +$self->{CCFLAGS} = $Config{ccflags} . ' -DDBM_BUG_DUPLICATE_FREE' ; diff --git a/contrib/perl5/ext/ODBM_File/hints/sco.pl b/contrib/perl5/ext/ODBM_File/hints/sco.pl new file mode 100644 index 0000000..4664f2b --- /dev/null +++ b/contrib/perl5/ext/ODBM_File/hints/sco.pl @@ -0,0 +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']; diff --git a/contrib/perl5/ext/ODBM_File/hints/solaris.pl b/contrib/perl5/ext/ODBM_File/hints/solaris.pl new file mode 100644 index 0000000..ac57393 --- /dev/null +++ b/contrib/perl5/ext/ODBM_File/hints/solaris.pl @@ -0,0 +1,3 @@ +# -lucb has been reported to be fatal for perl5 on Solaris. +# Thus we deliberately don't include it here. +$self->{LIBS} = ['-ldbm']; diff --git a/contrib/perl5/ext/ODBM_File/hints/svr4.pl b/contrib/perl5/ext/ODBM_File/hints/svr4.pl new file mode 100644 index 0000000..3285d9a --- /dev/null +++ b/contrib/perl5/ext/ODBM_File/hints/svr4.pl @@ -0,0 +1,4 @@ +# Some SVR4 systems may need to link against routines in -lucb for +# odbm. Some may also need to link against -lc to pick up things like +# ecvt. +$self->{LIBS} = ['-ldbm -lucb -lc']; diff --git a/contrib/perl5/ext/ODBM_File/hints/ultrix.pl b/contrib/perl5/ext/ODBM_File/hints/ultrix.pl new file mode 100644 index 0000000..31f9d24 --- /dev/null +++ b/contrib/perl5/ext/ODBM_File/hints/ultrix.pl @@ -0,0 +1,4 @@ +# Try to work around "bad free" messages. See note in ODBM_File.xs. +# Andy Dougherty <doughera@lafcol.lafayette.edu> +# Sun Sep 8 12:57:52 EDT 1996 +$self->{CCFLAGS} = $Config{ccflags} . ' -DDBM_BUG_DUPLICATE_FREE' ; diff --git a/contrib/perl5/ext/ODBM_File/typemap b/contrib/perl5/ext/ODBM_File/typemap new file mode 100644 index 0000000..5e12e73 --- /dev/null +++ b/contrib/perl5/ext/ODBM_File/typemap @@ -0,0 +1,25 @@ +# +#################################### 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, PL_na); + $var.dsize = (int)PL_na; +T_GDATUM + UNIMPLEMENTED +OUTPUT +T_DATUM + sv_setpvn($arg, $var.dptr, $var.dsize); +T_GDATUM + sv_usepvn($arg, $var.dptr, $var.dsize); |
