[Midnightbsd-cvs] src [9592] trunk/contrib/perl: sync up
laffer1 at midnightbsd.org
laffer1 at midnightbsd.org
Sun Oct 1 14:29:25 EDT 2017
Revision: 9592
http://svnweb.midnightbsd.org/src/?rev=9592
Author: laffer1
Date: 2017-10-01 14:29:24 -0400 (Sun, 01 Oct 2017)
Log Message:
-----------
sync up
Modified Paths:
--------------
trunk/contrib/perl/hints/midnightbsd.sh
Added Paths:
-----------
trunk/contrib/perl/ext/GDBM_File/
trunk/contrib/perl/ext/GDBM_File/GDBM_File.pm
trunk/contrib/perl/ext/GDBM_File/GDBM_File.xs
trunk/contrib/perl/ext/GDBM_File/Makefile.PL
trunk/contrib/perl/ext/GDBM_File/hints/
trunk/contrib/perl/ext/GDBM_File/hints/sco.pl
trunk/contrib/perl/ext/GDBM_File/t/
trunk/contrib/perl/ext/GDBM_File/t/fatal.t
trunk/contrib/perl/ext/GDBM_File/t/gdbm.t
trunk/contrib/perl/ext/GDBM_File/typemap
Added: trunk/contrib/perl/ext/GDBM_File/GDBM_File.pm
===================================================================
--- trunk/contrib/perl/ext/GDBM_File/GDBM_File.pm (rev 0)
+++ trunk/contrib/perl/ext/GDBM_File/GDBM_File.pm 2017-10-01 18:29:24 UTC (rev 9592)
@@ -0,0 +1,76 @@
+# 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<ftp.gnu.org>, but you are strongly urged to use one of the many
+mirrors. You can obtain a list of mirror sites from
+http://www.gnu.org/order/ftp.html.
+
+=head1 BUGS
+
+The available functions and the gdbm/perl interface need to be documented.
+
+The GDBM error number and error message interface needs to be added.
+
+=head1 SEE ALSO
+
+L<perl(1)>, L<DB_File(3)>, L<perldbmfilter>.
+
+=cut
+
+package GDBM_File;
+
+use strict;
+use warnings;
+our($VERSION, @ISA, @EXPORT);
+
+require Carp;
+require Tie::Hash;
+require Exporter;
+require XSLoader;
+ at ISA = qw(Tie::Hash Exporter);
+ at EXPORT = qw(
+ GDBM_CACHESIZE
+ GDBM_CENTFREE
+ GDBM_COALESCEBLKS
+ GDBM_FAST
+ GDBM_FASTMODE
+ GDBM_INSERT
+ GDBM_NEWDB
+ GDBM_NOLOCK
+ GDBM_OPENMASK
+ GDBM_READER
+ GDBM_REPLACE
+ GDBM_SYNC
+ GDBM_SYNCMODE
+ GDBM_WRCREAT
+ GDBM_WRITER
+);
+
+# This module isn't dual life, so no need for dev version numbers.
+$VERSION = '1.15';
+
+XSLoader::load();
+
+1;
Property changes on: trunk/contrib/perl/ext/GDBM_File/GDBM_File.pm
___________________________________________________________________
Added: svn:eol-style
## -0,0 +1 ##
+native
\ No newline at end of property
Added: svn:keywords
## -0,0 +1 ##
+MidnightBSD=%H
\ No newline at end of property
Added: svn:mime-type
## -0,0 +1 ##
+text/plain
\ No newline at end of property
Added: trunk/contrib/perl/ext/GDBM_File/GDBM_File.xs
===================================================================
--- trunk/contrib/perl/ext/GDBM_File/GDBM_File.xs (rev 0)
+++ trunk/contrib/perl/ext/GDBM_File/GDBM_File.xs 2017-10-01 18:29:24 UTC (rev 9592)
@@ -0,0 +1,194 @@
+#define PERL_NO_GET_CONTEXT
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include <gdbm.h>
+#include <fcntl.h>
+
+#define fetch_key 0
+#define store_key 1
+#define fetch_value 2
+#define store_value 3
+
+typedef struct {
+ GDBM_FILE dbp ;
+ SV * filter[4];
+ int filtering ;
+ } GDBM_File_type;
+
+typedef GDBM_File_type * GDBM_File ;
+typedef datum datum_key ;
+typedef datum datum_value ;
+typedef datum datum_key_copy;
+
+#define GDBM_BLOCKSIZE 0 /* gdbm defaults to stat blocksize */
+
+#if defined(GDBM_VERSION_MAJOR) && defined(GDBM_VERSION_MINOR) \
+ && GDBM_VERSION_MAJOR > 1 || \
+ (GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 9)
+typedef void (*FATALFUNC)(const char *);
+#else
+typedef void (*FATALFUNC)();
+#endif
+
+#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)
+{
+ sv_setpvn(arg, str, size);
+# undef free
+ free(str);
+}
+
+/* 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 void
+croak_string(const char *message) {
+ Perl_croak_nocontext("%s", message);
+}
+
+#include "const-c.inc"
+
+MODULE = GDBM_File PACKAGE = GDBM_File PREFIX = gdbm_
+
+INCLUDE: const-xs.inc
+
+GDBM_File
+gdbm_TIEHASH(dbtype, name, read_write, mode)
+ char * dbtype
+ char * name
+ int read_write
+ int mode
+ CODE:
+ {
+ GDBM_FILE dbp ;
+
+ RETVAL = NULL ;
+ if ((dbp = gdbm_open(name, GDBM_BLOCKSIZE, read_write, mode,
+ (FATALFUNC) croak_string))) {
+ RETVAL = (GDBM_File)safecalloc(1, sizeof(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
+ PREINIT:
+ int i = store_value;
+ CODE:
+ gdbm_close(db);
+ do {
+ if (db->filter[i])
+ SvREFCNT_dec(db->filter[i]);
+ } while (i-- > 0);
+ safefree(db);
+
+#define gdbm_FETCH(db,key) gdbm_fetch(db->dbp,key)
+datum_value
+gdbm_FETCH(db, key)
+ GDBM_File db
+ datum_key_copy 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
+
+
+SV *
+filter_fetch_key(db, code)
+ GDBM_File db
+ SV * code
+ SV * RETVAL = &PL_sv_undef ;
+ ALIAS:
+ GDBM_File::filter_fetch_key = fetch_key
+ GDBM_File::filter_store_key = store_key
+ GDBM_File::filter_fetch_value = fetch_value
+ GDBM_File::filter_store_value = store_value
+ CODE:
+ DBM_setFilter(db->filter[ix], code);
Added: trunk/contrib/perl/ext/GDBM_File/Makefile.PL
===================================================================
--- trunk/contrib/perl/ext/GDBM_File/Makefile.PL (rev 0)
+++ trunk/contrib/perl/ext/GDBM_File/Makefile.PL 2017-10-01 18:29:24 UTC (rev 9592)
@@ -0,0 +1,20 @@
+use ExtUtils::MakeMaker;
+use ExtUtils::Constant 0.11 'WriteConstants';
+WriteMakefile(
+ NAME => 'GDBM_File',
+ LIBS => ["-lgdbm", "-ldbm"],
+ XSPROTOARG => '-noprototypes', # XXX remove later?
+ VERSION_FROM => 'GDBM_File.pm',
+ realclean => {FILES=> 'const-c.inc const-xs.inc'},
+ XS_VERSION => eval MM->parse_version('GDBM_File.pm'), #silence warnings if we are a dev release
+);
+WriteConstants(
+ NAME => 'GDBM_File',
+ DEFAULT_TYPE => 'IV',
+ BREAKOUT_AT => 8,
+ PROXYSUBS => {autoload => 1},
+ NAMES => [qw(GDBM_CACHESIZE GDBM_CENTFREE GDBM_COALESCEBLKS
+ GDBM_FAST GDBM_FASTMODE GDBM_INSERT GDBM_NEWDB GDBM_NOLOCK
+ GDBM_OPENMASK GDBM_READER GDBM_REPLACE GDBM_SYNC GDBM_SYNCMODE
+ GDBM_WRCREAT GDBM_WRITER)],
+);
Property changes on: trunk/contrib/perl/ext/GDBM_File/Makefile.PL
___________________________________________________________________
Added: svn:eol-style
## -0,0 +1 ##
+native
\ No newline at end of property
Added: svn:keywords
## -0,0 +1 ##
+MidnightBSD=%H
\ No newline at end of property
Added: svn:mime-type
## -0,0 +1 ##
+text/plain
\ No newline at end of property
Added: trunk/contrib/perl/ext/GDBM_File/hints/sco.pl
===================================================================
--- trunk/contrib/perl/ext/GDBM_File/hints/sco.pl (rev 0)
+++ trunk/contrib/perl/ext/GDBM_File/hints/sco.pl 2017-10-01 18:29:24 UTC (rev 9592)
@@ -0,0 +1,2 @@
+# SCO OSR5 needs to link with libc.so again to have C<fsync> defined
+$self->{LIBS} = ['-lgdbm -lc'];
Property changes on: trunk/contrib/perl/ext/GDBM_File/hints/sco.pl
___________________________________________________________________
Added: svn:eol-style
## -0,0 +1 ##
+native
\ No newline at end of property
Added: svn:keywords
## -0,0 +1 ##
+MidnightBSD=%H
\ No newline at end of property
Added: svn:mime-type
## -0,0 +1 ##
+text/plain
\ No newline at end of property
Added: trunk/contrib/perl/ext/GDBM_File/t/fatal.t
===================================================================
--- trunk/contrib/perl/ext/GDBM_File/t/fatal.t (rev 0)
+++ trunk/contrib/perl/ext/GDBM_File/t/fatal.t 2017-10-01 18:29:24 UTC (rev 9592)
@@ -0,0 +1,49 @@
+#!./perl -w
+use strict;
+
+use Test::More;
+use Config;
+
+BEGIN {
+ plan(skip_all => "GDBM_File was not built")
+ unless $Config{extensions} =~ /\bGDBM_File\b/;
+
+ # https://rt.perl.org/Public/Bug/Display.html?id=117967
+ plan(skip_all => "GDBM_File is flaky in $^O")
+ if $^O =~ /darwin/;
+
+ plan(tests => 8);
+ use_ok('GDBM_File');
+}
+
+unlink <Op_dbmx*>;
+
+open my $fh, '<', $^X or die "Can't open $^X: $!";
+my $fileno = fileno $fh;
+isnt($fileno, undef, "Can find next available file descriptor");
+close $fh or die $!;
+
+is((open $fh, "<&=$fileno"), undef,
+ "Check that we cannot open fileno $fileno. \$! is $!");
+
+umask(0);
+my %h;
+isa_ok(tie(%h, 'GDBM_File', 'Op_dbmx', GDBM_WRCREAT, 0640), 'GDBM_File');
+
+isnt((open $fh, "<&=$fileno"), undef, "dup fileno $fileno")
+ or diag("\$! = $!");
+isnt(close $fh, undef,
+ "close fileno $fileno, out from underneath the GDBM_File");
+is(eval {
+ $h{Perl} = 'Rules';
+ untie %h;
+ 1;
+}, undef, 'Trapped error when attempting to write to knobbled GDBM_File');
+
+# Observed "File write error" and "lseek error" from two different systems.
+# So there might be more variants. Important part was that we trapped the error
+# via croak.
+like($@, qr/ at .*\bfatal\.t line \d+\.\n\z/,
+ 'expected error message from GDBM_File');
+
+unlink <Op_dbmx*>;
Added: trunk/contrib/perl/ext/GDBM_File/t/gdbm.t
===================================================================
--- trunk/contrib/perl/ext/GDBM_File/t/gdbm.t (rev 0)
+++ trunk/contrib/perl/ext/GDBM_File/t/gdbm.t 2017-10-01 18:29:24 UTC (rev 9592)
@@ -0,0 +1,6 @@
+#!./perl
+
+$::Create_and_Write = '(GDBM_WRCREAT, GDBM_WRITER)';
+our $DBM_Class = 'GDBM_File';
+
+require '../../t/lib/dbmt_common.pl';
Added: trunk/contrib/perl/ext/GDBM_File/typemap
===================================================================
--- trunk/contrib/perl/ext/GDBM_File/typemap (rev 0)
+++ trunk/contrib/perl/ext/GDBM_File/typemap 2017-10-01 18:29:24 UTC (rev 9592)
@@ -0,0 +1,56 @@
+#
+#################################### DBM SECTION
+#
+
+datum_key T_DATUM_K
+datum_key_copy 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
+
+INPUT
+T_DATUM_K
+ DBM_ckFilter($arg, filter[store_key], \"filter_store_key\");
+ {
+ STRLEN len;
+ $var.dptr = SvPVbyte($arg, len);
+ $var.dsize = (int)len;
+ }
+T_DATUM_K_C
+ {
+ SV * tmpSV;
+ STRLEN len;
+ if (db->filter[store_key]) {
+ tmpSV = sv_2mortal(newSVsv($arg));
+ DBM_ckFilter(tmpSV, filter[store_key], \"filter_store_key\");
+ }
+ else
+ tmpSV = $arg;
+ $var.dptr = SvPVbyte(tmpSV, len);
+ $var.dsize = (int)len;
+ }
+T_DATUM_V
+ DBM_ckFilter($arg, filter[store_value], \"filter_store_value\");
+ if (SvOK($arg)) {
+ STRLEN len;
+ $var.dptr = SvPVbyte($arg, len);
+ $var.dsize = (int)len;
+ }
+ else {
+ $var.dptr = (char *)\"\";
+ /* better would be for .dptr to be const char * */
+ $var.dsize = 0;
+ }
+OUTPUT
+T_DATUM_K
+ output_datum(aTHX_ $arg, $var.dptr, $var.dsize);
+ DBM_ckFilter($arg, filter[fetch_key],\"filter_fetch_key\");
+T_DATUM_V
+ output_datum(aTHX_ $arg, $var.dptr, $var.dsize);
+ DBM_ckFilter($arg, filter[fetch_value],\"filter_fetch_value\");
+T_PTROBJ
+ sv_setref_pv($arg, dbtype, (void*)$var);
Modified: trunk/contrib/perl/hints/midnightbsd.sh
===================================================================
--- trunk/contrib/perl/hints/midnightbsd.sh 2017-10-01 18:26:05 UTC (rev 9591)
+++ trunk/contrib/perl/hints/midnightbsd.sh 2017-10-01 18:29:24 UTC (rev 9592)
@@ -1,4 +1,3 @@
-locincpth=''
usevfork='true'
case "$usemymalloc" in
"") usemymalloc='n'
@@ -6,10 +5,19 @@
esac
libswanted=`echo $libswanted | sed 's/ malloc / /'`
-libpth="/usr/lib /usr/local/lib"
-glibpth="/usr/lib /usr/local/lib"
-ldflags="-Wl,-E "
-lddlflags="-shared "
+objformat=`/usr/bin/objformat`
+if [ x$objformat = xaout ]; then
+ if [ -e /usr/lib/aout ]; then
+ libpth="/usr/lib/aout /usr/local/lib /usr/lib"
+ glibpth="/usr/lib/aout /usr/local/lib /usr/lib"
+ fi
+ lddlflags='-Bshareable'
+else
+ libpth="/usr/lib /usr/local/lib"
+ glibpth="/usr/lib /usr/local/lib"
+ ldflags="-Wl,-E "
+ lddlflags="-shared "
+fi
cccdlflags='-DPIC -fPIC'
ccflags="${ccflags} -DHAS_FPSETMASK -DHAS_FLOATINGPOINT_H"
More information about the Midnightbsd-cvs
mailing list