From: Paul Marquess Date: Sat, 24 Nov 2001 11:41:41 +0000 (+0000) Subject: DB_File 1.800 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=07200f1b93ada43b41fbed10c30b4e657f5b0c60;p=p5sagit%2Fp5-mst-13.2.git DB_File 1.800 Message-ID: p4raw-id: //depot/perl@13233 --- diff --git a/ext/DB_File/Changes b/ext/DB_File/Changes index be6e6e3..e3b0a5d 100644 --- a/ext/DB_File/Changes +++ b/ext/DB_File/Changes @@ -343,8 +343,8 @@ 1.77 26th April 2001 - * AIX is reported to need -lpthreads, so Makefile.PL now checks for AIX and - adds it to the link options. + * AIX is reported to need -lpthreads, so Makefile.PL now checks for + AIX and adds it to the link options. * Minor documentation updates. @@ -368,9 +368,23 @@ 1.79 22nd October 2001 - * Added a "local $SIG{__DIE__}" inside the eval that checks for the presence - of XSLoader s suggested by Andrew Hryckowin. + * Added a "local $SIG{__DIE__}" inside the eval that checks for + the presence of XSLoader s suggested by Andrew Hryckowin. * merged core patch 12277. * Changed NEXTKEY to not initialise the input key. It isn't used anyway. + +1.79 22nd October 2001 + + * Fixed test harness for cygwin + + +1.800 23rd November 2001 + + * use pport.h for perl backward compatability code. + + * use new ExtUtils::Constant module to generate XS constants. + + * upgrade Makefile.PL upgrade/downgrade code to toggle "our" with + "use vars" diff --git a/ext/DB_File/DB_File.pm b/ext/DB_File/DB_File.pm index a76927b..b00b500 100644 --- a/ext/DB_File/DB_File.pm +++ b/ext/DB_File/DB_File.pm @@ -1,8 +1,8 @@ # DB_File.pm -- Perl 5 interface to Berkeley DB # # written by Paul Marquess (Paul.Marquess@btinternet.com) -# last modified 22nc Oct 2001 -# version 1.79 +# last modified 23rd Nov 2001 +# version 1.800 # # Copyright (c) 1995-2001 Paul Marquess. All rights reserved. # This program is free software; you can redistribute it and/or @@ -145,13 +145,12 @@ package DB_File ; use warnings; use strict; -use vars qw($VERSION @ISA @EXPORT $AUTOLOAD $DB_BTREE $DB_HASH $DB_RECNO - $db_version $use_XSLoader - ) ; +our ($VERSION, @ISA, @EXPORT, $AUTOLOAD, $DB_BTREE, $DB_HASH, $DB_RECNO); +our ($db_version, $use_XSLoader); use Carp; -$VERSION = "1.79" ; +$VERSION = "1.800" ; #typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE; $DB_BTREE = new DB_File::BTREEINFO ; @@ -210,22 +209,12 @@ push @ISA, qw(Tie::Hash Exporter); 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 { - my($pack,$file,$line) = caller; - croak "Your vendor has not defined DB macro $constname, used at $file line $line. -"; - } - } + my ($error, $val) = constant($constname); + Carp::croak $error if $error; no strict 'refs'; *{$AUTOLOAD} = sub { $val }; goto &{$AUTOLOAD}; -} +} eval { @@ -839,7 +828,7 @@ contents of the database. use warnings ; use strict ; use DB_File ; - use vars qw( %h $k $v ) ; + our (%h, $k, $v) ; unlink "fruit" ; tie %h, "DB_File", "fruit", O_RDWR|O_CREAT, 0666, $DB_HASH @@ -989,7 +978,7 @@ code: use strict ; use DB_File ; - use vars qw($filename %h ) ; + our ($filename, %h) ; $filename = "tree" ; unlink $filename ; @@ -1044,7 +1033,7 @@ Here is the script above rewritten using the C API method. use strict ; use DB_File ; - use vars qw($filename $x %h $status $key $value) ; + our ($filename, $x, %h, $status, $key, $value) ; $filename = "tree" ; unlink $filename ; @@ -1116,7 +1105,7 @@ this: use strict ; use DB_File ; - use vars qw($filename $x %h ) ; + our ($filename, $x, %h) ; $filename = "tree" ; @@ -1166,9 +1155,9 @@ Assuming the database from the previous example: use strict ; use DB_File ; - use vars qw($filename $x %h $found) ; + our ($filename, $x, %h, $found) ; - my $filename = "tree" ; + $filename = "tree" ; # Enable duplicate records $DB_BTREE->{'flags'} = R_DUP ; @@ -1205,9 +1194,9 @@ Again assuming the existence of the C database use strict ; use DB_File ; - use vars qw($filename $x %h $found) ; + our ($filename, $x, %h, $found) ; - my $filename = "tree" ; + $filename = "tree" ; # Enable duplicate records $DB_BTREE->{'flags'} = R_DUP ; @@ -1251,7 +1240,7 @@ and print the first matching key/value pair given a partial key. use DB_File ; use Fcntl ; - use vars qw($filename $x %h $st $key $value) ; + our ($filename, $x, %h, $st, $key, $value) ; sub match { @@ -1450,7 +1439,7 @@ L). use warnings ; use strict ; - use vars qw(@h $H $file $i) ; + our (@h, $H, $file, $i) ; use DB_File ; use Fcntl ; @@ -2015,7 +2004,7 @@ F). use DB_File ; use Fcntl ; - use vars qw( $dotdir $HISTORY %hist_db $href $binary_time $date ) ; + our ($dotdir, $HISTORY, %hist_db, $href, $binary_time, $date) ; $dotdir = $ENV{HOME} || $ENV{LOGNAME}; $HISTORY = "$dotdir/.netscape/history.db"; @@ -2170,7 +2159,7 @@ Consider this script: use warnings ; use strict ; use DB_File ; - use vars qw(%x) ; + my %x ; tie %x, DB_File, "filename" ; Running it produces the error in question: diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs index 0beb9f6..5894f7e 100644 --- a/ext/DB_File/DB_File.xs +++ b/ext/DB_File/DB_File.xs @@ -3,8 +3,8 @@ DB_File.xs -- Perl 5 interface to Berkeley DB written by Paul Marquess - last modified 22nd Oct 2001 - version 1.79 + last modified 23rd Nov 2001 + version 1.800 All comments/suggestions/problems are welcome @@ -95,6 +95,8 @@ 1.78 - Core patch 10335, 10372, 10534, 10549, 11051 included. 1.79 - NEXTKEY ignores the input key. Added lots of casts + 1.800 - Moved backward compatability code into ppport.h. + Use the new constants code. */ @@ -103,23 +105,8 @@ #include "perl.h" #include "XSUB.h" -#ifndef PERL_VERSION -# include "patchlevel.h" -# define PERL_REVISION 5 -# define PERL_VERSION PATCHLEVEL -# define PERL_SUBVERSION SUBVERSION -#endif - -#if PERL_REVISION == 5 && (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION <= 75 )) - -# define PL_sv_undef sv_undef -# define PL_na na - -#endif - -/* DEFSV appears first in 5.004_56 */ -#ifndef DEFSV -# define DEFSV GvSV(defgv) +#ifdef _NOT_CORE +# include "ppport.h" #endif /* Mention DB_VERSION_MAJOR_CFG, DB_VERSION_MINOR_CFG, and @@ -136,13 +123,6 @@ -/* If Perl has been compiled with Threads support,the symbol op will - be defined here. This clashes with a field name in db.h, so get rid of it. - */ -#ifdef op -# undef op -#endif - #ifdef COMPAT185 # include #else @@ -177,17 +157,6 @@ #endif /* Perl >= 5.7 */ -#ifndef pTHX -# define pTHX -# define pTHX_ -# define aTHX -# define aTHX_ -#endif - -#ifndef newSVpvn -# define newSVpvn(a,b) newSVpv(a,b) -#endif - #include /* #define TRACE */ @@ -463,6 +432,7 @@ extern void __getBerkeleyDBInfo(void); #endif /* Internal Global Data */ + #define MY_CXT_KEY "DB_File::_guts" XS_VERSION typedef struct { @@ -1415,244 +1385,12 @@ SV * sv ; } /* ParseOpenInfo */ -static double -#ifdef CAN_PROTOTYPE -constant(char *name, int arg) -#else -constant(name, arg) -char *name; -int arg; -#endif -{ - errno = 0; - switch (*name) { - case 'A': - break; - case 'B': - if (strEQ(name, "BTREEMAGIC")) -#ifdef BTREEMAGIC - return BTREEMAGIC; -#else - goto not_there; -#endif - if (strEQ(name, "BTREEVERSION")) -#ifdef BTREEVERSION - return BTREEVERSION; -#else - goto not_there; -#endif - break; - case 'C': - break; - case 'D': - if (strEQ(name, "DB_LOCK")) -#ifdef DB_LOCK - return DB_LOCK; -#else - goto not_there; -#endif - if (strEQ(name, "DB_SHMEM")) -#ifdef DB_SHMEM - return DB_SHMEM; -#else - goto not_there; -#endif - if (strEQ(name, "DB_TXN")) -#ifdef DB_TXN - return (U32)DB_TXN; -#else - goto not_there; -#endif - break; - case 'E': - break; - case 'F': - break; - case 'G': - break; - case 'H': - if (strEQ(name, "HASHMAGIC")) -#ifdef HASHMAGIC - return HASHMAGIC; -#else - goto not_there; -#endif - if (strEQ(name, "HASHVERSION")) -#ifdef HASHVERSION - return HASHVERSION; -#else - goto not_there; -#endif - break; - case 'I': - break; - case 'J': - break; - case 'K': - break; - case 'L': - break; - case 'M': - if (strEQ(name, "MAX_PAGE_NUMBER")) -#ifdef MAX_PAGE_NUMBER - return (U32)MAX_PAGE_NUMBER; -#else - goto not_there; -#endif - if (strEQ(name, "MAX_PAGE_OFFSET")) -#ifdef MAX_PAGE_OFFSET - return MAX_PAGE_OFFSET; -#else - goto not_there; -#endif - if (strEQ(name, "MAX_REC_NUMBER")) -#ifdef MAX_REC_NUMBER - return (U32)MAX_REC_NUMBER; -#else - goto not_there; -#endif - break; - case 'N': - break; - case 'O': - break; - case 'P': - break; - case 'Q': - break; - case 'R': - if (strEQ(name, "RET_ERROR")) -#ifdef RET_ERROR - return RET_ERROR; -#else - goto not_there; -#endif - if (strEQ(name, "RET_SPECIAL")) -#ifdef RET_SPECIAL - return RET_SPECIAL; -#else - goto not_there; -#endif - if (strEQ(name, "RET_SUCCESS")) -#ifdef RET_SUCCESS - return RET_SUCCESS; -#else - goto not_there; -#endif - if (strEQ(name, "R_CURSOR")) -#ifdef R_CURSOR - return R_CURSOR; -#else - goto not_there; -#endif - if (strEQ(name, "R_DUP")) -#ifdef R_DUP - return R_DUP; -#else - goto not_there; -#endif - if (strEQ(name, "R_FIRST")) -#ifdef R_FIRST - return R_FIRST; -#else - goto not_there; -#endif - if (strEQ(name, "R_FIXEDLEN")) -#ifdef R_FIXEDLEN - return R_FIXEDLEN; -#else - goto not_there; -#endif - if (strEQ(name, "R_IAFTER")) -#ifdef R_IAFTER - return R_IAFTER; -#else - goto not_there; -#endif - if (strEQ(name, "R_IBEFORE")) -#ifdef R_IBEFORE - return R_IBEFORE; -#else - goto not_there; -#endif - if (strEQ(name, "R_LAST")) -#ifdef R_LAST - return R_LAST; -#else - goto not_there; -#endif - if (strEQ(name, "R_NEXT")) -#ifdef R_NEXT - return R_NEXT; -#else - goto not_there; -#endif - if (strEQ(name, "R_NOKEY")) -#ifdef R_NOKEY - return R_NOKEY; -#else - goto not_there; -#endif - if (strEQ(name, "R_NOOVERWRITE")) -#ifdef R_NOOVERWRITE - return R_NOOVERWRITE; -#else - goto not_there; -#endif - if (strEQ(name, "R_PREV")) -#ifdef R_PREV - return R_PREV; -#else - goto not_there; -#endif - if (strEQ(name, "R_RECNOSYNC")) -#ifdef R_RECNOSYNC - return R_RECNOSYNC; -#else - goto not_there; -#endif - if (strEQ(name, "R_SETCURSOR")) -#ifdef R_SETCURSOR - return R_SETCURSOR; -#else - goto not_there; -#endif - if (strEQ(name, "R_SNAPSHOT")) -#ifdef R_SNAPSHOT - return R_SNAPSHOT; -#else - goto not_there; -#endif - 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; - case '_': - break; - } - errno = EINVAL; - return 0; - -not_there: - errno = ENOENT; - return 0; -} +#include "constants.h" MODULE = DB_File PACKAGE = DB_File PREFIX = db_ +INCLUDE: constants.xs + BOOT: { MY_CXT_INIT; @@ -1663,10 +1401,6 @@ BOOT: empty.size = sizeof(recno_t) ; } -double -constant(name,arg) - char * name - int arg DB_File @@ -1759,8 +1493,8 @@ db_FETCH(db, key, flags=0) DBTKEY key u_int flags PREINIT: - dMY_CXT ; - int RETVAL ; + dMY_CXT ; + int RETVAL ; CODE: { DBT value ; @@ -1789,8 +1523,8 @@ void db_FIRSTKEY(db) DB_File db PREINIT: - dMY_CXT ; - int RETVAL ; + dMY_CXT ; + int RETVAL ; CODE: { DBTKEY key ; @@ -1809,8 +1543,8 @@ db_NEXTKEY(db, key) DB_File db DBTKEY key = NO_INIT PREINIT: - dMY_CXT ; - int RETVAL ; + dMY_CXT ; + int RETVAL ; CODE: { DBT value ; @@ -1877,7 +1611,7 @@ pop(db) dMY_CXT; ALIAS: POP = 1 PREINIT: - I32 RETVAL; + I32 RETVAL; CODE: { DBTKEY key ; @@ -1908,7 +1642,7 @@ shift(db) dMY_CXT; ALIAS: SHIFT = 1 PREINIT: - I32 RETVAL; + I32 RETVAL; CODE: { DBT value ; @@ -2060,7 +1794,7 @@ int db_fd(db) DB_File db PREINIT: - dMY_CXT ; + dMY_CXT ; CODE: CurrentDB = db ; #ifdef DB_VERSION_MAJOR diff --git a/ext/DB_File/Makefile.PL b/ext/DB_File/Makefile.PL index 0414160..b1580e9 100644 --- a/ext/DB_File/Makefile.PL +++ b/ext/DB_File/Makefile.PL @@ -1,4 +1,8 @@ +use strict; +use warnings; + use ExtUtils::MakeMaker 5.16 ; +use ExtUtils::Constant qw(WriteConstants); use Config ; # OS2 is a special case, so check for it now. @@ -17,13 +21,67 @@ WriteMakefile( OBJECT => 'version$(OBJ_EXT) DB_File$(OBJ_EXT)', XSPROTOARG => '-noprototypes', DEFINE => $OS2 || "", - INC => ($^O eq "MacOS" ? "-i ::::db:include" : "") + INC => ($^O eq "MacOS" ? "-i ::::db:include" : ""), + 'depend' => {"version$(OBJ_EXT)" => 'version.c'}, + ); + +my @names = qw( + BTREEMAGIC + BTREEVERSION + DB_LOCK + DB_SHMEM + DB_TXN + HASHMAGIC + HASHVERSION + MAX_PAGE_NUMBER + MAX_PAGE_OFFSET + MAX_REC_NUMBER + RET_ERROR + RET_SPECIAL + RET_SUCCESS + R_CURSOR + R_DUP + R_FIRST + R_FIXEDLEN + R_IAFTER + R_IBEFORE + R_LAST + R_NEXT + R_NOKEY + R_NOOVERWRITE + R_PREV + R_RECNOSYNC + R_SETCURSOR + R_SNAPSHOT + __R_UNUSED ); -sub MY::postamble { - ' -version$(OBJ_EXT): version.c + # Check the constants above all appear in @EXPORT in DB_File.pm + my %names = map { $_, 1} @names; + open F, ") + { + last if /^\s*\@EXPORT\s+=\s+qw\(/ ; + } + + while () + { + last if /^\s*\)/ ; + /(\S+)/ ; + delete $names{$1} if defined $1 ; + } + close F ; -' ; -} + if ( keys %names ) + { + my $missing = join ("\n\t", sort keys %names) ; + die "The following names are missing from \@EXPORT in DB_File.pm\n" . + "\t$missing\n" ; + } + + WriteConstants( NAME => 'DB_File', + NAMES => \@names, + C_FILE => 'constants.h', + XS_FILE => 'constants.xs', + ); diff --git a/ext/DB_File/t/db-btree.t b/ext/DB_File/t/db-btree.t index 7e0bb2b..62cccd7 100755 --- a/ext/DB_File/t/db-btree.t +++ b/ext/DB_File/t/db-btree.t @@ -619,7 +619,7 @@ unlink $Dfile1 ; use warnings ; use strict ; - use vars qw( @ISA @EXPORT) ; + our (@ISA, @EXPORT); require Exporter ; use DB_File; @@ -957,7 +957,7 @@ EOM use strict ; use DB_File ; - use vars qw($filename %h ) ; + our ($filename, %h); $filename = "tree" ; unlink $filename ; @@ -1009,7 +1009,7 @@ EOM use strict ; use DB_File ; - use vars qw($filename $x %h $status $key $value) ; + our ($filename, $x, %h, $status, $key, $value); $filename = "tree" ; unlink $filename ; @@ -1065,7 +1065,7 @@ EOM use strict ; use DB_File ; - use vars qw($filename $x %h ) ; + our ($filename, $x, %h); $filename = "tree" ; @@ -1114,9 +1114,9 @@ EOM use strict ; use DB_File ; - use vars qw($filename $x %h $found) ; + our ($filename, $x, %h, $found); - my $filename = "tree" ; + $filename = "tree" ; # Enable duplicate records $DB_BTREE->{'flags'} = R_DUP ; @@ -1149,9 +1149,9 @@ EOM use strict ; use DB_File ; - use vars qw($filename $x %h $found) ; + our ($filename, $x, %h, $found); - my $filename = "tree" ; + $filename = "tree" ; # Enable duplicate records $DB_BTREE->{'flags'} = R_DUP ; @@ -1185,7 +1185,7 @@ EOM use DB_File ; use Fcntl ; - use vars qw($filename $x %h $st $key $value) ; + our ($filename, $x, %h, $st, $key, $value); sub match { diff --git a/ext/DB_File/t/db-hash.t b/ext/DB_File/t/db-hash.t index 2413c0e..81851e1 100755 --- a/ext/DB_File/t/db-hash.t +++ b/ext/DB_File/t/db-hash.t @@ -20,8 +20,6 @@ BEGIN { } } -use strict; -use warnings; use DB_File; use Fcntl; @@ -409,7 +407,7 @@ untie %h ; use warnings ; use strict ; - use vars qw( @ISA @EXPORT) ; + our (@ISA, @EXPORT); require Exporter ; use DB_File; @@ -689,7 +687,7 @@ EOM use warnings FATAL => qw(all); use strict ; use DB_File ; - use vars qw( %h $k $v ) ; + our (%h, $k, $v); unlink "fruit" ; tie %h, "DB_File", "fruit", O_RDWR|O_CREAT, 0640, $DB_HASH diff --git a/ext/DB_File/t/db-recno.t b/ext/DB_File/t/db-recno.t index 8f42ce3..a676759 100755 --- a/ext/DB_File/t/db-recno.t +++ b/ext/DB_File/t/db-recno.t @@ -22,7 +22,7 @@ BEGIN { use DB_File; use Fcntl; -use vars qw($dbh $Dfile $bad_ones $FA) ; +our ($dbh, $Dfile, $bad_ones, $FA); # full tied array support started in Perl 5.004_57 # Double check to see if it is available. @@ -131,14 +131,14 @@ my $total_tests = 138 ; $total_tests += $splice_tests if $FA ; print "1..$total_tests\n"; -my $Dfile = "recno.tmp"; +$Dfile = "recno.tmp"; unlink $Dfile ; umask(0); # Check the interface to RECNOINFO -my $dbh = new DB_File::RECNOINFO ; +$dbh = new DB_File::RECNOINFO ; ok(1, ! defined $dbh->{bval}) ; ok(2, ! defined $dbh->{cachesize}) ; ok(3, ! defined $dbh->{psize}) ; @@ -400,7 +400,7 @@ unlink $Dfile; use warnings ; use strict ; - use vars qw( @ISA @EXPORT) ; + our (@ISA, @EXPORT); require Exporter ; use DB_File; @@ -792,7 +792,7 @@ EOM use warnings FATAL => qw(all); use strict ; - use vars qw(@h $H $file $i) ; + our (@h, $H, $file, $i); use DB_File ; use Fcntl ;