perl 5.000perl-5.000

[editor's note: this commit combines approximate 4 months of furious
releases of Andy Dougherty and Larry Wall - see pod/perlhist.pod for
details.  Andy notes that;
 
Alas neither my "Irwin AccuTrack" nor my DC 600A quarter-inch cartridge 
backup tapes from that era seem to be readable anymore.  I guess 13 years 
exceeds the shelf life for that backup technology :-(.
]

4 files changed, 503 insertions, 0 deletions

diff --git a/ext/GDBM_File/GDBM_File.pm b/ext/GDBM_File/GDBM_File.pm
new file mode 100644
index 0000000000..23422f7a2e
--- /dev/null
+++ b/ext/GDBM_File/GDBM_File.pm
@@ -0,0 +1,47 @@
+package GDBM_File;
+
+require Carp;
+require TieHash;
+require Exporter;
+require AutoLoader;
+require DynaLoader;
+@ISA = (TieHash, Exporter, AutoLoader, DynaLoader);
+@EXPORT = qw(
+	GDBM_CACHESIZE
+	GDBM_FAST
+	GDBM_INSERT
+	GDBM_NEWDB
+	GDBM_READER
+	GDBM_REPLACE
+	GDBM_WRCREAT
+	GDBM_WRITER
+);
+
+sub AUTOLOAD {
+    if (@_ > 1) {
+	$AutoLoader::AUTOLOAD = $AUTOLOAD;
+	goto &AutoLoader::AUTOLOAD;
+    }
+    local($constname);
+    ($constname = $AUTOLOAD) =~ s/.*:://;
+    $val = constant($constname, @_ ? $_[0] : 0);
+    if ($! != 0) {
+	if ($! =~ /Invalid/) {
+	    $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;
+}
+
+bootstrap GDBM_File;
+
+# Preloaded methods go here.  Autoload methods go after __END__, and are
+# processed by the autosplit program.
+
+1;
+__END__
diff --git a/ext/GDBM_File/GDBM_File.xs b/ext/GDBM_File/GDBM_File.xs
new file mode 100644
index 0000000000..c6dc484fa1
--- /dev/null
+++ b/ext/GDBM_File/GDBM_File.xs
@@ -0,0 +1,218 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include <gdbm.h>
+#include <fcntl.h>
+
+typedef GDBM_FILE GDBM_File;
+
+#define GDBM_BLOCKSIZE 0 /* gdbm defaults to stat blocksize */
+#define gdbm_TIEHASH(dbtype, name, read_write, mode, fatal_func) \
+	gdbm_open(name, GDBM_BLOCKSIZE, read_write, mode, fatal_func)
+
+#define gdbm_FETCH(db,key)			gdbm_fetch(db,key)
+#define gdbm_STORE(db,key,value,flags)		gdbm_store(db,key,value,flags)
+#define gdbm_DELETE(db,key)			gdbm_delete(db,key)
+#define gdbm_FIRSTKEY(db)			gdbm_firstkey(db)
+#define gdbm_NEXTKEY(db,key)			gdbm_nextkey(db,key)
+
+typedef datum gdatum;
+
+typedef void (*FATALFUNC)();
+
+static int
+not_here(s)
+char *s;
+{
+    croak("GDBM_File::%s not implemented on this architecture", s);
+    return -1;
+}
+
+static double
+constant(name, arg)
+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_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
+
+void
+gdbm_close(db)
+	GDBM_File	db
+	CLEANUP:
+
+void
+gdbm_DESTROY(db)
+	GDBM_File	db
+	CODE:
+	gdbm_close(db);
+
+gdatum
+gdbm_FETCH(db, key)
+	GDBM_File	db
+	datum		key
+
+int
+gdbm_STORE(db, key, value, flags = GDBM_REPLACE)
+	GDBM_File	db
+	datum		key
+	datum		value
+	int		flags
+    CLEANUP:
+	if (RETVAL) {
+	    if (RETVAL < 0 && errno == EPERM)
+		croak("No write permission to gdbm file");
+	    warn("gdbm store returned %d, errno %d, key \"%.*s\"",
+			RETVAL,errno,key.dsize,key.dptr);
+	    /* gdbm_clearerr(db); */
+	}
+
+int
+gdbm_DELETE(db, key)
+	GDBM_File	db
+	datum		key
+
+gdatum
+gdbm_FIRSTKEY(db)
+	GDBM_File	db
+
+gdatum
+gdbm_NEXTKEY(db, key)
+	GDBM_File	db
+	datum		key
+
+int
+gdbm_reorganize(db)
+	GDBM_File	db
+
diff --git a/ext/GDBM_File/Makefile.SH b/ext/GDBM_File/Makefile.SH
new file mode 100644
index 0000000000..974c8deef8
--- /dev/null
+++ b/ext/GDBM_File/Makefile.SH
@@ -0,0 +1,213 @@
+: This forces SH files to create target in same directory as SH file.
+: This is so that make depend always knows where to find SH derivatives.
+
+case "$0" in
+*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
+esac
+
+if test -f config.sh; then TOP=.;
+elif test -f ../config.sh; then TOP=..;
+elif test -f ../../config.sh; then TOP=../..;
+elif test -f ../../../config.sh; then TOP=../../..;
+elif test -f ../../../../config.sh; then TOP=../../../..;
+else
+	echo "Can't find config.sh."; exit 1
+fi
+
+: Find absolute path name for TOP.  This is needed when we cd to TOP
+: to run perl on autosplit.
+oldpwd=`pwd`; cd $TOP; ABSTOP=`pwd`; cd $oldpwd
+
+case $CONFIG in
+'')
+	. $TOP/config.sh
+	;;
+esac
+
+: Find out directory name.  This is also the extension name.
+ext=`pwd | $sed -e 's@.*/@@'`
+
+: This extension might have its own typemap
+if test -f typemap; then
+	exttypemap='typemap'
+else
+	exttypemap=''
+fi
+
+: This extension might need additional libraries.
+potential_libs="-lgdbm"
+. $TOP/ext/util/extliblist
+case "${extralibs}${dynaloadlibs}${statloadlibs}" in
+'') : Try again.  Maybe they have -ldbm instead
+	potential_libs='-ldbm'
+	. $TOP/ext/util/extliblist
+	;;
+esac
+
+: This extension might need bootstrap support
+if test -f ${ext}_BS; then
+	bootdep=${ext}_BS
+else
+	bootdep=''
+fi
+
+case "$dlsrc" in
+dl_aix*)
+    echo "#!" > $ext.exp
+    echo "boot_$ext" >> $ext.exp
+    ;;
+esac
+
+echo "Extracting ext/$ext/Makefile (with variable substitutions)"
+: This section of the file will have variable substitutions done on it.
+: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!.
+: Protect any dollar signs and backticks that you do not want interpreted
+: by putting a backslash in front.  You may delete these comments.
+$spitshell >Makefile << !GROK!THIS!
+#
+# This Makefile is for the $ext extension to perl.
+# 
+CC = $cc
+RANLIB = $ranlib
+TOP = $TOP
+ABSTOP = $ABSTOP
+LDFLAGS = $ldflags
+CLDFLAGS = $ldflags
+SMALL = $small
+LARGE = $large $split
+
+# To use an alternate make, set \$altmake in config.sh.
+MAKE = ${altmake-make}
+
+EXT = $ext
+
+# $ext might have its own typemap
+EXTTYPEMAP = $exttypemap
+
+# $ext might have its own bootstrap support
+BOOTDEP  = $bootdep
+BOOTSTRAP  = $ext.bs
+
+# The following are used to build and install shared libraries for
+# dynamic loading.
+LDDLFLAGS = $lddlflags
+CCDLFLAGS = $ccdlflags
+CCCDLFLAGS = $cccdlflags
+SO = $so
+DLEXT = $dlext
+
+# $ext might need to be linked with some extra libraries.
+# EXTRALIBS =  full list of libraries needed for static linking.
+#		Only those libraries that actually exist are included.
+# DYNLOADLIBS = list of those libraries that are needed but can be
+#		linked in dynamically on this platform.  On SunOS, for
+#		example, this would be .so* libraries, but not archive
+#		libraries.  The bootstrap file is installed only if
+#		this list is not empty.
+# STATLOADLIBS = list of those libraries which must be statically
+#		linked into the shared library.  On SunOS 4.1.3, 
+#		for example,  I have only an archive version of
+#		-lm, and it must be linked in statically.
+EXTRALIBS = $extralibs
+DYNALOADLIBS  = $dynaloadlibs
+STATLOADLIBS = $statloadlibs
+
+!GROK!THIS!
+
+$spitshell >>Makefile <<'!NO!SUBS!'
+
+# Where to put things:
+AUTO = $(TOP)/lib/auto
+INSTALLBOOT = $(AUTO)/$(EXT)/$(EXT).bs
+INSTALLDYNAMIC = $(AUTO)/$(EXT)/$(EXT).$(DLEXT)
+INSTALLSTATIC = $(EXT).a
+INSTALLPM = $(TOP)/lib/$(EXT).pm
+
+PERL = $(ABSTOP)/miniperl
+XSUBPP = $(TOP)/ext/xsubpp
+SHELL = /bin/sh
+CCCMD = `sh $(shellflags) $(TOP)/cflags $@`
+
+.c.o:
+	$(CCCMD) $(CCCDLFLAGS) -I$(TOP) $*.c
+
+all:	dynamic
+# Phony target to force checking subdirectories.
+FORCE:
+
+config:
+
+# Target for Dynamic Loading:
+dynamic:	$(INSTALLDYNAMIC) $(INSTALLPM) $(INSTALLBOOT)
+
+$(INSTALLDYNAMIC): $(EXT).o
+	@test -d $(AUTO) || mkdir $(AUTO)
+	@test -d $(AUTO)/$(EXT) || mkdir $(AUTO)/$(EXT)
+	ld $(LDDLFLAGS) -o $@ $(EXT).o $(STATLOADLIBS)
+
+$(BOOTSTRAP):	Makefile $(BOOTDEP)
+	$(PERL) -I$(TOP)/lib $(TOP)/ext/util/mkbootstrap $(DYNALOADLIBS)
+	touch $(BOOTSTRAP)
+
+$(INSTALLBOOT):	$(BOOTSTRAP)
+	@test ! -s $(BOOTSTRAP) || cp $(BOOTSTRAP) $@
+
+# Target for Static Loading:
+static: $(INSTALLSTATIC) $(INSTALLPM)
+
+$(INSTALLSTATIC):	$(EXT).o
+	ar cr $@ $(EXT).o
+	$(RANLIB) $@
+	echo $(EXTRALIBS) >> $(TOP)/ext.libs
+
+$(EXT).c:	$(EXT).xs $(XSUBPP) $(TOP)/ext/typemap $(EXTTYPEMAP) $(TOP)/cflags Makefile
+	$(PERL) $(XSUBPP) $(EXT).xs >tmp
+	mv tmp $@
+
+$(INSTALLPM):	$(EXT).pm
+	rm -f $@
+	cp $(EXT).pm $@
+	cd $(TOP); $(PERL) autosplit $(EXT)
+
+clean:
+	rm -f *.o *.a mon.out core $(EXT).c so_locations $(BOOTSTRAP) $(EXT).exp
+
+realclean: 	clean
+	rm -f makefile Makefile
+	rm -f $(INSTALLPM) $(INSTALLDYNAMIC) $(INSTALLSTATIC) $(INSTALLBOOT)
+	rm -rf $(AUTO)/$(EXT)
+
+purge:	realclean
+
+$(EXT).o :	$(TOP)/EXTERN.h
+$(EXT).o :	$(TOP)/perl.h
+$(EXT).o :	$(TOP)/embed.h
+$(EXT).o :	$(TOP)/config.h
+$(EXT).o :	$(TOP)/unixish.h
+$(EXT).o :	$(TOP)/handy.h
+$(EXT).o :	$(TOP)/regexp.h
+$(EXT).o :	$(TOP)/sv.h
+$(EXT).o :	$(TOP)/util.h
+$(EXT).o :	$(TOP)/form.h
+$(EXT).o :	$(TOP)/gv.h
+$(EXT).o :	$(TOP)/cv.h
+$(EXT).o :	$(TOP)/opcode.h
+$(EXT).o :	$(TOP)/op.h
+$(EXT).o :	$(TOP)/cop.h
+$(EXT).o :	$(TOP)/av.h
+$(EXT).o :	$(TOP)/hv.h
+$(EXT).o :	$(TOP)/mg.h
+$(EXT).o :	$(TOP)/scope.h
+$(EXT).o :	$(TOP)/pp.h
+$(EXT).o :	$(TOP)/proto.h
+$(EXT).o :	$(TOP)/XSUB.h 
+
+Makefile:	Makefile.SH $(TOP)/config.sh ; /bin/sh Makefile.SH
+$(TOP)/config.h:	$(TOP)/config.sh; cd $(TOP); /bin/sh config_h.SH
+$(TOP)/embed.h:	$(TOP)/config.sh; cd $(TOP); /bin/sh embed_h.SH
+$(TOP)/cflags:	$(TOP)/config.sh; cd $(TOP); /bin/sh cflags.SH
+
+!NO!SUBS!
+chmod 644 Makefile
+$eunicefix Makefile
+
diff --git a/ext/GDBM_File/typemap b/ext/GDBM_File/typemap
new file mode 100644
index 0000000000..a6b0e5faa8
--- /dev/null
+++ b/ext/GDBM_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, na);
+	$var.dsize = (int)na;
+T_GDATUM
+	UNIMPLEMENTED
+OUTPUT
+T_DATUM
+	sv_setpvn($arg, $var.dptr, $var.dsize);
+T_GDATUM
+	sv_usepvn($arg, $var.dptr, $var.dsize);