diff options
Diffstat (limited to 'contrib/perl5/ext/GDBM_File')
| -rw-r--r-- | contrib/perl5/ext/GDBM_File/GDBM_File.pm | 89 | ||||
| -rw-r--r-- | contrib/perl5/ext/GDBM_File/GDBM_File.xs | 363 | ||||
| -rw-r--r-- | contrib/perl5/ext/GDBM_File/Makefile.PL | 8 | ||||
| -rw-r--r-- | contrib/perl5/ext/GDBM_File/hints/sco.pl | 2 | ||||
| -rw-r--r-- | contrib/perl5/ext/GDBM_File/typemap | 38 |
5 files changed, 0 insertions, 500 deletions
diff --git a/contrib/perl5/ext/GDBM_File/GDBM_File.pm b/contrib/perl5/ext/GDBM_File/GDBM_File.pm deleted file mode 100644 index 310243c..0000000 --- a/contrib/perl5/ext/GDBM_File/GDBM_File.pm +++ /dev/null @@ -1,89 +0,0 @@ -# GDBM_File.pm -- Perl 5 interface to GNU gdbm library. - -=head1 NAME - -GDBM_File - Perl5 access to the gdbm library. - -=head1 SYNOPSIS - - use GDBM_File ; - tie %hash, 'GDBM_File', $filename, &GDBM_WRCREAT, 0640; - # Use the %hash array. - untie %hash ; - -=head1 DESCRIPTION - -B<GDBM_File> is a module which allows Perl programs to make use of the -facilities provided by the GNU gdbm library. If you intend to use this -module you should really have a copy of the gdbm manualpage at hand. - -Most of the libgdbm.a functions are available through the GDBM_File -interface. - -=head1 AVAILABILITY - -Gdbm is available from any GNU archive. The master site is -C<prep.ai.mit.edu>, but your are strongly urged to use one of the many -mirrors. You can obtain a list of mirror sites by issuing the -command C<finger fsf@prep.ai.mit.edu>. - -=head1 BUGS - -The available functions and the gdbm/perl interface need to be documented. - -=head1 SEE ALSO - -L<perl(1)>, L<DB_File(3)>, L<perldbmfilter>. - -=cut - -package GDBM_File; - -use strict; -use warnings; -our($VERSION, @ISA, @EXPORT, $AUTOLOAD); - -require Carp; -require Tie::Hash; -require Exporter; -use AutoLoader; -use XSLoader (); -@ISA = qw(Tie::Hash Exporter); -@EXPORT = qw( - GDBM_CACHESIZE - GDBM_FAST - GDBM_INSERT - GDBM_NEWDB - GDBM_NOLOCK - GDBM_READER - GDBM_REPLACE - GDBM_WRCREAT - GDBM_WRITER -); - -$VERSION = "1.05"; - -sub AUTOLOAD { - my($constname); - ($constname = $AUTOLOAD) =~ s/.*:://; - my $val = constant($constname, @_ ? $_[0] : 0); - if ($! != 0) { - if ($! =~ /Invalid/ || $!{EINVAL}) { - $AutoLoader::AUTOLOAD = $AUTOLOAD; - goto &AutoLoader::AUTOLOAD; - } - else { - Carp::croak("Your vendor has not defined GDBM_File macro $constname, used"); - } - } - eval "sub $AUTOLOAD { $val }"; - goto &$AUTOLOAD; -} - -XSLoader::load 'GDBM_File', $VERSION; - -# Preloaded methods go here. Autoload methods go after __END__, and are -# processed by the autosplit program. - -1; -__END__ diff --git a/contrib/perl5/ext/GDBM_File/GDBM_File.xs b/contrib/perl5/ext/GDBM_File/GDBM_File.xs deleted file mode 100644 index 5e426f9..0000000 --- a/contrib/perl5/ext/GDBM_File/GDBM_File.xs +++ /dev/null @@ -1,363 +0,0 @@ -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#include <gdbm.h> -#include <fcntl.h> - -typedef struct { - GDBM_FILE dbp ; - SV * filter_fetch_key ; - SV * filter_store_key ; - SV * filter_fetch_value ; - SV * filter_store_value ; - int filtering ; - } GDBM_File_type; - -typedef GDBM_File_type * GDBM_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 GDBM_BLOCKSIZE 0 /* gdbm defaults to stat blocksize */ - -typedef void (*FATALFUNC)(); - -#ifndef GDBM_FAST -static int -not_here(char *s) -{ - croak("GDBM_File::%s not implemented on this architecture", s); - return -1; -} -#endif - -/* GDBM allocates the datum with system malloc() and expects the user - * to free() it. So we either have to free() it immediately, or have - * perl free() it when it deallocates the SV, depending on whether - * perl uses malloc()/free() or not. */ -static void -output_datum(pTHX_ SV *arg, char *str, int size) -{ -#if !defined(MYMALLOC) || (defined(MYMALLOC) && defined(PERL_POLLUTE_MALLOC) && !defined(LEAKTEST)) - sv_usepvn(arg, str, size); -#else - sv_setpvn(arg, str, size); - safesysfree(str); -#endif -} - -/* Versions of gdbm prior to 1.7x might not have the gdbm_sync, - gdbm_exists, and gdbm_setopt functions. Apparently Slackware - (Linux) 2.1 contains gdbm-1.5 (which dates back to 1991). -*/ -#ifndef GDBM_FAST -#define gdbm_exists(db,key) not_here("gdbm_exists") -#define gdbm_sync(db) (void) not_here("gdbm_sync") -#define gdbm_setopt(db,optflag,optval,optlen) not_here("gdbm_setopt") -#endif - -static double -constant(char *name, int arg) -{ - errno = 0; - switch (*name) { - case 'A': - break; - case 'B': - break; - case 'C': - break; - case 'D': - break; - case 'E': - break; - case 'F': - break; - case 'G': - if (strEQ(name, "GDBM_CACHESIZE")) -#ifdef GDBM_CACHESIZE - return GDBM_CACHESIZE; -#else - goto not_there; -#endif - if (strEQ(name, "GDBM_FAST")) -#ifdef GDBM_FAST - return GDBM_FAST; -#else - goto not_there; -#endif - if (strEQ(name, "GDBM_FASTMODE")) -#ifdef GDBM_FASTMODE - return GDBM_FASTMODE; -#else - goto not_there; -#endif - if (strEQ(name, "GDBM_INSERT")) -#ifdef GDBM_INSERT - return GDBM_INSERT; -#else - goto not_there; -#endif - if (strEQ(name, "GDBM_NEWDB")) -#ifdef GDBM_NEWDB - return GDBM_NEWDB; -#else - goto not_there; -#endif - if (strEQ(name, "GDBM_NOLOCK")) -#ifdef GDBM_NOLOCK - return GDBM_NOLOCK; -#else - goto not_there; -#endif - if (strEQ(name, "GDBM_READER")) -#ifdef GDBM_READER - return GDBM_READER; -#else - goto not_there; -#endif - if (strEQ(name, "GDBM_REPLACE")) -#ifdef GDBM_REPLACE - return GDBM_REPLACE; -#else - goto not_there; -#endif - if (strEQ(name, "GDBM_WRCREAT")) -#ifdef GDBM_WRCREAT - return GDBM_WRCREAT; -#else - goto not_there; -#endif - if (strEQ(name, "GDBM_WRITER")) -#ifdef GDBM_WRITER - return GDBM_WRITER; -#else - goto not_there; -#endif - break; - case 'H': - break; - case 'I': - break; - case 'J': - break; - case 'K': - break; - case 'L': - break; - case 'M': - break; - case 'N': - break; - case 'O': - break; - case 'P': - break; - case 'Q': - break; - case 'R': - break; - case 'S': - break; - case 'T': - break; - case 'U': - break; - case 'V': - break; - case 'W': - break; - case 'X': - break; - case 'Y': - break; - case 'Z': - break; - } - errno = EINVAL; - return 0; - -not_there: - errno = ENOENT; - return 0; -} - -MODULE = GDBM_File PACKAGE = GDBM_File PREFIX = gdbm_ - -double -constant(name,arg) - char * name - int arg - - -GDBM_File -gdbm_TIEHASH(dbtype, name, read_write, mode, fatal_func = (FATALFUNC)croak) - char * dbtype - char * name - int read_write - int mode - FATALFUNC fatal_func - CODE: - { - GDBM_FILE dbp ; - - RETVAL = NULL ; - if ((dbp = gdbm_open(name, GDBM_BLOCKSIZE, read_write, mode, fatal_func))) { - RETVAL = (GDBM_File)safemalloc(sizeof(GDBM_File_type)) ; - Zero(RETVAL, 1, GDBM_File_type) ; - RETVAL->dbp = dbp ; - } - - } - OUTPUT: - RETVAL - - -#define gdbm_close(db) gdbm_close(db->dbp) -void -gdbm_close(db) - GDBM_File db - CLEANUP: - -void -gdbm_DESTROY(db) - GDBM_File db - CODE: - gdbm_close(db); - safefree(db); - -#define gdbm_FETCH(db,key) gdbm_fetch(db->dbp,key) -datum_value -gdbm_FETCH(db, key) - GDBM_File db - datum_key key - -#define gdbm_STORE(db,key,value,flags) gdbm_store(db->dbp,key,value,flags) -int -gdbm_STORE(db, key, value, flags = GDBM_REPLACE) - GDBM_File db - datum_key key - datum_value value - int flags - CLEANUP: - if (RETVAL) { - if (RETVAL < 0 && errno == EPERM) - croak("No write permission to gdbm file"); - croak("gdbm store returned %d, errno %d, key \"%.*s\"", - RETVAL,errno,key.dsize,key.dptr); - } - -#define gdbm_DELETE(db,key) gdbm_delete(db->dbp,key) -int -gdbm_DELETE(db, key) - GDBM_File db - datum_key key - -#define gdbm_FIRSTKEY(db) gdbm_firstkey(db->dbp) -datum_key -gdbm_FIRSTKEY(db) - GDBM_File db - -#define gdbm_NEXTKEY(db,key) gdbm_nextkey(db->dbp,key) -datum_key -gdbm_NEXTKEY(db, key) - GDBM_File db - datum_key key - -#define gdbm_reorganize(db) gdbm_reorganize(db->dbp) -int -gdbm_reorganize(db) - GDBM_File db - - -#define gdbm_sync(db) gdbm_sync(db->dbp) -void -gdbm_sync(db) - GDBM_File db - -#define gdbm_EXISTS(db,key) gdbm_exists(db->dbp,key) -int -gdbm_EXISTS(db, key) - GDBM_File db - datum_key key - -#define gdbm_setopt(db,optflag, optval, optlen) gdbm_setopt(db->dbp,optflag, optval, optlen) -int -gdbm_setopt (db, optflag, optval, optlen) - GDBM_File db - int optflag - int &optval - int optlen - - -#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) - GDBM_File db - SV * code - SV * RETVAL = &PL_sv_undef ; - CODE: - setFilter(filter_fetch_key) ; - -SV * -filter_store_key(db, code) - GDBM_File db - SV * code - SV * RETVAL = &PL_sv_undef ; - CODE: - setFilter(filter_store_key) ; - -SV * -filter_fetch_value(db, code) - GDBM_File db - SV * code - SV * RETVAL = &PL_sv_undef ; - CODE: - setFilter(filter_fetch_value) ; - -SV * -filter_store_value(db, code) - GDBM_File db - SV * code - SV * RETVAL = &PL_sv_undef ; - CODE: - setFilter(filter_store_value) ; - diff --git a/contrib/perl5/ext/GDBM_File/Makefile.PL b/contrib/perl5/ext/GDBM_File/Makefile.PL deleted file mode 100644 index 2a7256f..0000000 --- a/contrib/perl5/ext/GDBM_File/Makefile.PL +++ /dev/null @@ -1,8 +0,0 @@ -use ExtUtils::MakeMaker; -WriteMakefile( - NAME => 'GDBM_File', - LIBS => ["-L/usr/local/lib -lgdbm", "-ldbm"], - MAN3PODS => {}, # Pods will be built by installman. - XSPROTOARG => '-noprototypes', # XXX remove later? - VERSION_FROM => 'GDBM_File.pm', -); diff --git a/contrib/perl5/ext/GDBM_File/hints/sco.pl b/contrib/perl5/ext/GDBM_File/hints/sco.pl deleted file mode 100644 index 5c74a77..0000000 --- a/contrib/perl5/ext/GDBM_File/hints/sco.pl +++ /dev/null @@ -1,2 +0,0 @@ -# SCO OSR5 needs to link with libc.so again to have C<fsync> defined -$self->{LIBS} = ['-lgdbm -lc']; diff --git a/contrib/perl5/ext/GDBM_File/typemap b/contrib/perl5/ext/GDBM_File/typemap deleted file mode 100644 index 1dd0630..0000000 --- a/contrib/perl5/ext/GDBM_File/typemap +++ /dev/null @@ -1,38 +0,0 @@ -# -#################################### DBM SECTION -# - -datum_key T_DATUM_K -datum_value T_DATUM_V -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_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\"); - if (SvOK($arg)) { - $var.dptr = SvPV($arg, PL_na); - $var.dsize = (int)PL_na; - } - else { - $var.dptr = \"\"; - $var.dsize = 0; - } -OUTPUT -T_DATUM_K - output_datum(aTHX_ $arg, $var.dptr, $var.dsize); - ckFilter($arg, filter_fetch_key,\"filter_fetch_key\"); -T_DATUM_V - output_datum(aTHX_ $arg, $var.dptr, $var.dsize); - ckFilter($arg, filter_fetch_value,\"filter_fetch_value\"); -T_PTROBJ - sv_setref_pv($arg, dbtype, (void*)$var); |
