diff options
| -rw-r--r-- | Changes | 189 | ||||
| -rw-r--r-- | ext/DB_File/DB_File.xs | 438 |
2 files changed, 527 insertions, 100 deletions
@@ -79,6 +79,195 @@ Version 5.005_62 Development release working toward 5.006 ---------------- ____________________________________________________________________________ +[ 4141] By: jhi on 1999/09/13 16:16:56 + Log: Scan for <pthread.h> always. + Branch: cfgperl + ! Configure config_h.SH perl.h + Branch: metaconfig + ! U/threads/i_pthread.U +____________________________________________________________________________ +[ 4140] By: jhi on 1999/09/13 16:00:08 + Log: Integrate with Sarathy. + Branch: cfgperl + !> (integrate 27 files) +____________________________________________________________________________ +[ 4139] By: jhi on 1999/09/13 15:35:18 + Log: Add -A option to Configure to diddle with variables + after the hints file has been applied. + Branch: cfgperl + ! Configure config_h.SH + Branch: metaconfig + ! U/modified/Oldconfig.U U/modified/Options.U +____________________________________________________________________________ +[ 4138] By: jhi on 1999/09/13 13:42:56 + Log: Change #4136 edited DynaLoader.xs which is kind of fruitless. + Branch: cfgperl + ! ext/DynaLoader/dl_aix.xs ext/DynaLoader/dl_beos.xs + ! ext/DynaLoader/dl_cygwin.xs ext/DynaLoader/dl_dld.xs + ! ext/DynaLoader/dl_hpux.xs ext/DynaLoader/dl_mpeix.xs + ! ext/DynaLoader/dl_next.xs ext/DynaLoader/dl_rhapsody.xs + ! ext/DynaLoader/dl_vmesa.xs ext/DynaLoader/dl_vms.xs +____________________________________________________________________________ +[ 4137] By: jhi on 1999/09/13 13:25:31 + Log: Applying change #4136 manually introduced patch residue. + Branch: cfgperl + ! perl.h +____________________________________________________________________________ +[ 4136] By: jhi on 1999/09/13 13:23:04 + Log: Replace change #4100 with + From: Robin Barker <rmb1@cise.npl.co.uk> + To: gsar@activestate.com + Cc: perl5-porters@perl.org + Subject: Re: [ID 19990907.004] [PATCH perl5.005_61] compiler warnings with -Duse64bits + Date: Mon, 13 Sep 1999 14:15:11 +0100 (BST) + Message-Id: <199909131315.OAA24012@tempest.npl.co.uk> + Branch: cfgperl + ! doio.c dump.c ext/B/B.xs ext/B/typemap + ! ext/ByteLoader/bytecode.h ext/Devel/DProf/DProf.xs + ! ext/DynaLoader/dl_dlopen.xs ext/ODBM_File/ODBM_File.xs + ! ext/POSIX/POSIX.xs lib/ExtUtils/typemap malloc.c perl.h pp.c + ! pp_ctl.c pp_hot.c pp_sys.c sv.c +____________________________________________________________________________ +[ 4135] By: jhi on 1999/09/13 10:22:31 + Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu> + To: perl5-porters@perl.org (Mailing list Perl5) + Subject: [PATCH 5.005_61] MakeMaker supports uninstalled Perls + Date: Sat, 11 Sep 1999 05:31:03 -0400 (EDT) + Message-Id: <199909110931.FAA11036@monk.mps.ohio-state.edu> + + From: andreas.koenig@anima.de (Andreas J. Koenig) + To: Ilya Zakharevich <ilya@math.ohio-state.edu> + Cc: perl5-porters@perl.org (Mailing list Perl5) + Subject: Re: [PATCH 5.005_61] MakeMaker supports uninstalled Perls + Date: 11 Sep 1999 15:36:26 +0200 + Message-ID: <sfc906dr2n9.fsf@hohenstaufen.in-berlin.de> + Branch: cfgperl + ! lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MakeMaker.pm +____________________________________________________________________________ +[ 4134] By: jhi on 1999/09/13 10:20:14 + Log: From: Tom Phoenix <rootbeer@redcat.com> + To: Perl Porters Mailing List <perl5-porters@perl.org> + Subject: [DOCPATCH] Server errors and perldiag + Date: Fri, 10 Sep 1999 16:45:02 -0700 (PDT) + Message-ID: <Pine.GSO.4.10.9909101639490.16999-100000@user2.teleport.com> + Branch: cfgperl + ! pod/perldiag.pod +____________________________________________________________________________ +[ 4133] By: gsar on 1999/09/13 03:25:43 + Log: avoid assertion failure on C<@a'> + Branch: perl + ! toke.c +____________________________________________________________________________ +[ 4132] By: gsar on 1999/09/13 03:03:57 + Log: add -DPERL_Y2KWARN build option that will generate additional + warnings on "19$yy" etc (reworked a patch suggested by + Ulrich Pfeifer <upf@de.uu.net>) + Branch: perl + ! pod/perldelta.pod pod/perldiag.pod pod/perllexwarn.pod + ! pp_hot.c sv.c t/pragma/warn/pp_hot t/pragma/warn/sv +____________________________________________________________________________ +[ 4131] By: gsar on 1999/09/12 22:06:25 + Log: fix DATA leaks; reword documentation about the DATA filehandle + Branch: perl + ! ext/Opcode/Safe.pm lib/Pod/Functions.pm pod/perldata.pod +____________________________________________________________________________ +[ 4130] By: gsar on 1999/09/12 20:08:56 + Log: make sprintf("%g",...) threadsafe; only taint its result iff the + formatted result looks nonstandard + Branch: perl + ! embed.pl embedvar.h intrpvar.h objXSUB.h perl.c perlapi.c + ! pod/perlfunc.pod pod/perlguts.pod proto.h sv.c + ! t/pragma/locale.t thrdvar.h +____________________________________________________________________________ +[ 4129] By: gsar on 1999/09/12 17:04:11 + Log: From: Doug MacEachern <dougm@cp.net> + Date: Sun, 25 Jul 1999 15:49:00 -0700 (PDT) + Message-ID: <Pine.LNX.4.10.9907251538380.373-100000@mojo.eng.cp.net> + Subject: [PATCH 5.005_57] B::clearsym + Branch: perl + ! ext/B/B.pm ext/B/B/Bblock.pm ext/B/B/Debug.pm ext/B/B/Terse.pm +____________________________________________________________________________ +[ 4128] By: gsar on 1999/09/12 16:59:12 + Log: better debugger help output (from Ilya Zakharevich) + Branch: perl + ! lib/perl5db.pl +____________________________________________________________________________ +[ 4127] By: jhi on 1999/09/11 20:50:37 + Log: Integrate with Sarathy. + Branch: cfgperl + +> pod/perlcompile.pod t/lib/gol-basic.t t/lib/gol-compat.t + +> t/lib/gol-linkage.t + !> (integrate 43 files) +____________________________________________________________________________ +[ 4126] By: nick on 1999/09/10 20:44:22 + Log: Get resolve -at mainline + Branch: utfperl + +> (branch 297 files) + - README.cygwin32 XSlock.h bytecode.h byterun.c byterun.h + - cygwin32/cw32imp.h cygwin32/gcc2 cygwin32/ld2 cygwin32/perlgcc + - cygwin32/perlld ext/B/byteperl.c ext/DynaLoader/dl_cygwin32.xs + - hints/cygwin32.sh interp.sym myconfig objpp.h perl_exp.SH + - t/pragma/warn-1global t/pragma/warning.t thread.sym + - win32/GenCAPI.pl win32/TEST win32/autosplit.pl + - win32/bin/network.pl win32/bin/webget.pl win32/bin/www.pl + - win32/genxsdef.pl win32/makedef.pl win32/makemain.pl + - win32/makeperldef.pl win32/perlhost.h + !> (integrate 847 files) +____________________________________________________________________________ +[ 4125] By: gsar on 1999/09/10 19:22:14 + Log: s/dXS_TARGET/dXSTARG/ in change#4044 (to match dARGS vs dXSARGS + etc.) + Branch: perl + ! XSUB.h pp.h +____________________________________________________________________________ +[ 4124] By: gsar on 1999/09/10 19:14:35 + Log: rewrote substantive parts of patch + From: Ilya Zakharevich <ilya@math.ohio-state.edu> + Date: Fri, 27 Aug 1999 19:02:18 -0400 + Message-ID: <19990827190218.A19561@monk.mps.ohio-state.edu> + Subject: [PATCH 5.005_58] REx documentation + Branch: perl + ! pod/perlre.pod +____________________________________________________________________________ +[ 4123] By: gsar on 1999/09/10 18:21:53 + Log: note about AVf_* + Branch: perl + ! av.h +____________________________________________________________________________ +[ 4122] By: gsar on 1999/09/10 17:55:42 + Log: allow 'text' in L<text|A::B/"C"> (from Martin Lichtin + <lichtin@bivio.com>) + Branch: perl + ! lib/Pod/Html.pm +____________________________________________________________________________ +[ 4121] By: gsar on 1999/09/10 17:49:35 + Log: dos-djgpp update (from Laszlo Molnar <laszlo.molnar@eth.ericsson.se>) + Branch: perl + ! AUTHORS Changes README.dos djgpp/config.over + ! djgpp/configure.bat djgpp/djgpp.c djgpp/djgppsed.sh dosish.h + ! lib/ExtUtils/MM_Unix.pm pod/pod2usage.PL pod/podchecker.PL + ! pod/podselect.PL sv.h t/io/openpid.t util.c +____________________________________________________________________________ +[ 4120] By: gsar on 1999/09/10 12:25:01 + Log: add perlcompile.pod (edited content from Nathan Torkington + <gnat@frii.com> and others) + Branch: perl + + pod/perlcompile.pod + ! MANIFEST pod/Makefile pod/buildtoc pod/perl.pod pod/roffitall +____________________________________________________________________________ +[ 4119] By: gsar on 1999/09/10 11:05:13 + Log: avoid leaking static local_patches unless patchlevel.h is + explicitly included + Branch: perl + ! patchlevel.h perl.c +____________________________________________________________________________ +[ 4118] By: gsar on 1999/09/10 10:44:54 + Log: upgrade to Getopt::Long v2.20 (from Johan Vromans + <jvromans@squirrel.nl>) + Branch: perl + + t/lib/gol-basic.t t/lib/gol-compat.t t/lib/gol-linkage.t + ! Changes MANIFEST lib/Getopt/Long.pm +____________________________________________________________________________ [ 4117] By: jhi on 1999/09/09 18:24:30 Log: Remove ill-designed %B introduced by change #4111. Branch: cfgperl diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs index 2ee1e61f0f..ccb9b757fe 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 <Paul.Marquess@btinternet.com> - last modified 4th August 1999 - version 1.70 + last modified 7th September 1999 + version 1.71 All comments/suggestions/problems are welcome @@ -78,6 +78,9 @@ GV_ADD|GV_ADDMULT -- bug spotted by Nick Ing-Simmons. Added a BOOT check to test for equivalent versions of db.h & libdb.a/so. + 1.71 - Support for Berkeley DB version 3. + Support for Berkeley DB 2/3's backward compatability mode. + Rewrote push */ @@ -116,7 +119,12 @@ #ifdef op # undef op #endif -#include <db.h> + +#ifdef COMPAT185 +# include <db_185.h> +#else +# include <db.h> +#endif #ifndef pTHX # define pTHX @@ -134,10 +142,21 @@ /* #define TRACE */ #define DBM_FILTERING +#ifdef TRACE +# define Trace(x) printf x +#else +# define Trace(x) +#endif + +#define DBT_clear(x) Zero(&x, 1, DBT) ; #ifdef DB_VERSION_MAJOR +#if DB_VERSION_MAJOR == 2 +# define BERKELEY_DB_1_OR_2 +#endif + /* map version 2 features & constants onto their version 1 equivalent */ #ifdef DB_Prefix_t @@ -152,7 +171,11 @@ /* DBTYPE stays the same */ /* HASHINFO, RECNOINFO and BTREEINFO map to DB_INFO */ -typedef DB_INFO INFO ; +#if DB_VERSION_MAJOR == 2 + typedef DB_INFO INFO ; +#else /* DB_VERSION_MAJOR > 2 */ +# define DB_FIXEDLEN (0x8000) +#endif /* DB_VERSION_MAJOR == 2 */ /* version 2 has db_recno_t in place of recno_t */ typedef db_recno_t recno_t; @@ -166,15 +189,18 @@ typedef db_recno_t recno_t; #define R_NEXT DB_NEXT #define R_NOOVERWRITE DB_NOOVERWRITE #define R_PREV DB_PREV + #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5 -#define R_SETCURSOR 0x800000 +# define R_SETCURSOR 0x800000 #else -#define R_SETCURSOR (-100) +# define R_SETCURSOR (-100) #endif + #define R_RECNOSYNC 0 #define R_FIXEDLEN DB_FIXEDLEN #define R_DUP DB_DUP + #define db_HA_hash h_hash #define db_HA_ffactor h_ffactor #define db_HA_nelem h_nelem @@ -209,13 +235,15 @@ typedef db_recno_t recno_t; #define DB_flags(x, v) x |= v #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5 -#define flagSet(flags, bitmask) ((flags) & (bitmask)) +# define flagSet(flags, bitmask) ((flags) & (bitmask)) #else -#define flagSet(flags, bitmask) (((flags) & DB_OPFLAGS_MASK) == (bitmask)) +# define flagSet(flags, bitmask) (((flags) & DB_OPFLAGS_MASK) == (bitmask)) #endif #else /* db version 1.x */ +#define BERKELEY_DB_1_OR_2 + typedef union INFO { HASHINFO hash ; RECNOINFO recno ; @@ -224,17 +252,17 @@ typedef union INFO { #ifdef mDB_Prefix_t -#ifdef DB_Prefix_t -#undef DB_Prefix_t -#endif -#define DB_Prefix_t mDB_Prefix_t +# ifdef DB_Prefix_t +# undef DB_Prefix_t +# endif +# define DB_Prefix_t mDB_Prefix_t #endif #ifdef mDB_Hash_t -#ifdef DB_Hash_t -#undef DB_Hash_t -#endif -#define DB_Hash_t mDB_Hash_t +# ifdef DB_Hash_t +# undef DB_Hash_t +# endif +# define DB_Hash_t mDB_Hash_t #endif #define db_HA_hash hash.hash @@ -281,20 +309,20 @@ typedef union INFO { #ifdef DB_VERSION_MAJOR #define db_DESTROY(db) ( db->cursor->c_close(db->cursor),\ - db->dbp->close(db->dbp, 0) ) + (db->dbp->close)(db->dbp, 0) ) #define db_close(db) ((db->dbp)->close)(db->dbp, 0) #define db_del(db, key, flags) (flagSet(flags, R_CURSOR) \ ? ((db->cursor)->c_del)(db->cursor, 0) \ : ((db->dbp)->del)(db->dbp, NULL, &key, flags) ) -#else +#else /* ! DB_VERSION_MAJOR */ #define db_DESTROY(db) ((db->dbp)->close)(db->dbp) #define db_close(db) ((db->dbp)->close)(db->dbp) #define db_del(db, key, flags) ((db->dbp)->del)(db->dbp, &key, flags) #define db_put(db, key, value, flags) ((db->dbp)->put)(db->dbp, &key, &value, flags) -#endif +#endif /* ! DB_VERSION_MAJOR */ #define db_seq(db, key, value, flags) do_SEQ(db, key, value, flags) @@ -306,7 +334,9 @@ typedef struct { SV * prefix ; SV * hash ; int in_memory ; +#ifdef BERKELEY_DB_1_OR_2 INFO info ; +#endif #ifdef DB_VERSION_MAJOR DBC * cursor ; #endif @@ -439,48 +469,6 @@ u_int flags ; #endif /* DB_VERSION_MAJOR */ -static void -GetVersionInfo(pTHX) -{ - SV * version_sv = perl_get_sv("DB_File::db_version", GV_ADD|GV_ADDMULTI) ; - SV * ver_sv = perl_get_sv("DB_File::db_ver", GV_ADD|GV_ADDMULTI) ; -#ifdef DB_VERSION_MAJOR - int Major, Minor, Patch ; - - (void)db_version(&Major, &Minor, &Patch) ; - - /* Check that the versions of db.h and libdb.a are the same */ - if (Major != DB_VERSION_MAJOR || Minor != DB_VERSION_MINOR - || Patch != DB_VERSION_PATCH) - croak("\nDB_File needs compatible versions of libdb & db.h\n\tyou have db.h version %d.%d.%d and libdb version %d.%d.%d\n", - DB_VERSION_MAJOR, DB_VERSION_MINOR, DB_VERSION_PATCH, - Major, Minor, Patch) ; - - /* check that libdb is recent enough -- we need 2.3.4 or greater */ - if (Major == 2 && (Minor < 3 || (Minor == 3 && Patch < 4))) - croak("DB_File needs Berkeley DB 2.3.4 or greater, you have %d.%d.%d\n", - Major, Minor, Patch) ; - -#if PERL_VERSION > 3 - sv_setpvf(version_sv, "%d.%d", Major, Minor) ; - sv_setpvf(ver_sv, "%d.%03d%03d", Major, Minor, Patch) ; -#else - { - char buffer[40] ; - sprintf(buffer, "%d.%d", Major, Minor) ; - sv_setpv(version_sv, buffer) ; - sprintf(buffer, "%d.%03d%03d", Major, Minor, Patch) ; - sv_setpv(ver_sv, buffer) ; - } -#endif - -#else - sv_setiv(version_sv, 1) ; - sv_setiv(ver_sv, 1) ; -#endif - -} - static int #ifdef CAN_PROTOTYPE @@ -641,7 +629,7 @@ size_t size ; } -#ifdef TRACE +#if defined(TRACE) && defined(BERKELEY_DB_1_OR_2) static void #ifdef CAN_PROTOTYPE @@ -724,8 +712,8 @@ DB_File db ; DBT value ; int RETVAL ; - DBT_flags(key) ; - DBT_flags(value) ; + DBT_clear(key) ; + DBT_clear(value) ; RETVAL = do_SEQ(db, key, value, R_LAST) ; if (RETVAL == 0) RETVAL = *(I32 *)key.data ; @@ -760,6 +748,7 @@ I32 value ; return value ; } + static DB_File #ifdef CAN_PROTOTYPE ParseOpenInfo(pTHX_ int isHASH, char *name, int flags, int mode, SV *sv) @@ -772,6 +761,9 @@ int mode ; SV * sv ; #endif { + +#ifdef BERKELEY_DB_1_OR_2 /* Berkeley DB Version 1 or 2 */ + SV ** svp; HV * action ; DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ; @@ -1032,11 +1024,265 @@ SV * sv ; } #else + +#if defined(DB_LIBRARY_COMPATIBILITY_API) && DB_VERSION_MAJOR > 2 + RETVAL->dbp = __db185_open(name, flags, mode, RETVAL->type, openinfo) ; +#else RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ; +#endif /* DB_LIBRARY_COMPATIBILITY_API */ + #endif return (RETVAL) ; -} + +#else /* Berkeley DB Version > 2 */ + + SV ** svp; + HV * action ; + DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ; + DB * dbp ; + STRLEN n_a; + int status ; + +/* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */ + Zero(RETVAL, 1, DB_File_type) ; + + /* Default to HASH */ +#ifdef DBM_FILTERING + RETVAL->filtering = 0 ; + RETVAL->filter_fetch_key = RETVAL->filter_store_key = + RETVAL->filter_fetch_value = RETVAL->filter_store_value = +#endif /* DBM_FILTERING */ + RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ; + RETVAL->type = DB_HASH ; + + /* DGH - Next line added to avoid SEGV on existing hash DB */ + CurrentDB = RETVAL; + + /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */ + RETVAL->in_memory = (name == NULL) ; + + status = db_create(&RETVAL->dbp, NULL,0) ; + /* printf("db_create returned %d %s\n", status, db_strerror(status)) ; */ + if (status) { + RETVAL->dbp = NULL ; + return (RETVAL) ; + } + dbp = RETVAL->dbp ; + + if (sv) + { + if (! SvROK(sv) ) + croak ("type parameter is not a reference") ; + + svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ; + if (svp && SvOK(*svp)) + action = (HV*) SvRV(*svp) ; + else + croak("internal error") ; + + if (sv_isa(sv, "DB_File::HASHINFO")) + { + + if (!isHASH) + croak("DB_File can only tie an associative array to a DB_HASH database") ; + + RETVAL->type = DB_HASH ; + + svp = hv_fetch(action, "hash", 4, FALSE); + + if (svp && SvOK(*svp)) + { + (void)dbp->set_h_hash(dbp, hash_cb) ; + RETVAL->hash = newSVsv(*svp) ; + } + + svp = hv_fetch(action, "ffactor", 7, FALSE); + if (svp) + (void)dbp->set_h_ffactor(dbp, SvIV(*svp)) ; + + svp = hv_fetch(action, "nelem", 5, FALSE); + if (svp) + (void)dbp->set_h_nelem(dbp, SvIV(*svp)) ; + + svp = hv_fetch(action, "bsize", 5, FALSE); + if (svp) + (void)dbp->set_pagesize(dbp, SvIV(*svp)); + + svp = hv_fetch(action, "cachesize", 9, FALSE); + if (svp) + (void)dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ; + + svp = hv_fetch(action, "lorder", 6, FALSE); + if (svp) + (void)dbp->set_lorder(dbp, SvIV(*svp)) ; + + PrintHash(info) ; + } + else if (sv_isa(sv, "DB_File::BTREEINFO")) + { + if (!isHASH) + croak("DB_File can only tie an associative array to a DB_BTREE database"); + + RETVAL->type = DB_BTREE ; + + svp = hv_fetch(action, "compare", 7, FALSE); + if (svp && SvOK(*svp)) + { + (void)dbp->set_bt_compare(dbp, btree_compare) ; + RETVAL->compare = newSVsv(*svp) ; + } + + svp = hv_fetch(action, "prefix", 6, FALSE); + if (svp && SvOK(*svp)) + { + (void)dbp->set_bt_prefix(dbp, btree_prefix) ; + RETVAL->prefix = newSVsv(*svp) ; + } + + svp = hv_fetch(action, "flags", 5, FALSE); + if (svp) + (void)dbp->set_flags(dbp, SvIV(*svp)) ; + + svp = hv_fetch(action, "cachesize", 9, FALSE); + if (svp) + (void)dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ; + + svp = hv_fetch(action, "psize", 5, FALSE); + if (svp) + (void)dbp->set_pagesize(dbp, SvIV(*svp)) ; + + svp = hv_fetch(action, "lorder", 6, FALSE); + if (svp) + (void)dbp->set_lorder(dbp, SvIV(*svp)) ; + + PrintBtree(info) ; + + } + else if (sv_isa(sv, "DB_File::RECNOINFO")) + { + int fixed = FALSE ; + + if (isHASH) + croak("DB_File can only tie an array to a DB_RECNO database"); + + RETVAL->type = DB_RECNO ; + + svp = hv_fetch(action, "flags", 5, FALSE); + if (svp) { + int flags = SvIV(*svp) ; + /* remove FIXDLEN, if present */ + if (flags & DB_FIXEDLEN) { + fixed = TRUE ; + flags &= ~DB_FIXEDLEN ; + } + } + + svp = hv_fetch(action, "cachesize", 9, FALSE); + if (svp) { + status = dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ; + } + + svp = hv_fetch(action, "psize", 5, FALSE); + if (svp) { + status = dbp->set_pagesize(dbp, SvIV(*svp)) ; + } + + svp = hv_fetch(action, "lorder", 6, FALSE); + if (svp) { + status = dbp->set_lorder(dbp, SvIV(*svp)) ; + } + + svp = hv_fetch(action, "bval", 4, FALSE); + if (svp && SvOK(*svp)) + { + int value ; + if (SvPOK(*svp)) + value = (int)*SvPV(*svp, n_a) ; + else + value = SvIV(*svp) ; + + if (fixed) { + status = dbp->set_re_pad(dbp, value) ; + } + else { + status = dbp->set_re_delim(dbp, value) ; + } + + } + + if (fixed) { + svp = hv_fetch(action, "reclen", 6, FALSE); + if (svp) { + u_int32_t len = (u_int32_t)SvIV(*svp) ; + status = dbp->set_re_len(dbp, len) ; + } + } + + if (name != NULL) { + status = dbp->set_re_source(dbp, name) ; + name = NULL ; + } + + svp = hv_fetch(action, "bfname", 6, FALSE); + if (svp && SvOK(*svp)) { + char * ptr = SvPV(*svp,n_a) ; + name = (char*) n_a ? ptr : NULL ; + } + else + name = NULL ; + + + status = dbp->set_flags(dbp, DB_RENUMBER) ; + + if (flags){ + (void)dbp->set_flags(dbp, flags) ; + } + PrintRecno(info) ; + } + else + croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO"); + } + + { + int Flags = 0 ; + int status ; + + /* Map 1.x flags to 3.x flags */ + if ((flags & O_CREAT) == O_CREAT) + Flags |= DB_CREATE ; + +#if O_RDONLY == 0 + if (flags == O_RDONLY) +#else + if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR) +#endif + Flags |= DB_RDONLY ; + +#ifdef O_TRUNC + if ((flags & O_TRUNC) == O_TRUNC) + Flags |= DB_TRUNCATE ; +#endif + + status = RETVAL->dbp->open(RETVAL->dbp, name, NULL, RETVAL->type, + Flags, mode) ; + /* printf("open returned %d %s\n", status, db_strerror(status)) ; */ + + if (status == 0) + status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor, + 0) ; + /* printf("cursor returned %d %s\n", status, db_strerror(status)) ; */ + + if (status) + RETVAL->dbp = NULL ; + + } + + return (RETVAL) ; + +#endif /* Berkeley DB Version > 2 */ + +} /* ParseOpenInfo */ static double @@ -1279,11 +1525,11 @@ MODULE = DB_File PACKAGE = DB_File PREFIX = db_ BOOT: { - GetVersionInfo(aTHX) ; + __getBerkeleyDBInfo() ; + DBT_clear(empty) ; empty.data = &zero ; empty.size = sizeof(recno_t) ; - DBT_flags(empty) ; } double @@ -1363,7 +1609,7 @@ db_EXISTS(db, key) { DBT value ; - DBT_flags(value) ; + DBT_clear(value) ; CurrentDB = db ; RETVAL = (((db->dbp)->get)(db->dbp, TXN &key, &value, 0) == 0) ; } @@ -1379,7 +1625,7 @@ db_FETCH(db, key, flags=0) { DBT value ; - DBT_flags(value) ; + DBT_clear(value) ; CurrentDB = db ; /* RETVAL = ((db->dbp)->get)(db->dbp, TXN &key, &value, flags) ; */ RETVAL = db_get(db, key, value, flags) ; @@ -1405,8 +1651,8 @@ db_FIRSTKEY(db) DBTKEY key ; DBT value ; - DBT_flags(key) ; - DBT_flags(value) ; + DBT_clear(key) ; + DBT_clear(value) ; CurrentDB = db ; RETVAL = do_SEQ(db, key, value, R_FIRST) ; ST(0) = sv_newmortal(); @@ -1421,7 +1667,7 @@ db_NEXTKEY(db, key) { DBT value ; - DBT_flags(value) ; + DBT_clear(value) ; CurrentDB = db ; RETVAL = do_SEQ(db, key, value, R_NEXT) ; ST(0) = sv_newmortal(); @@ -1445,8 +1691,8 @@ unshift(db, ...) DB * Db = db->dbp ; STRLEN n_a; - DBT_flags(key) ; - DBT_flags(value) ; + DBT_clear(key) ; + DBT_clear(value) ; CurrentDB = db ; #ifdef DB_VERSION_MAJOR /* get the first value */ @@ -1483,8 +1729,8 @@ pop(db) DBTKEY key ; DBT value ; - DBT_flags(key) ; - DBT_flags(value) ; + DBT_clear(key) ; + DBT_clear(value) ; CurrentDB = db ; /* First get the final value */ @@ -1510,8 +1756,8 @@ shift(db) DBT value ; DBTKEY key ; - DBT_flags(key) ; - DBT_flags(value) ; + DBT_clear(key) ; + DBT_clear(value) ; CurrentDB = db ; /* get the first value */ RETVAL = do_SEQ(db, key, value, R_FIRST) ; @@ -1539,45 +1785,37 @@ push(db, ...) DB * Db = db->dbp ; int i ; STRLEN n_a; + int keyval ; DBT_flags(key) ; DBT_flags(value) ; CurrentDB = db ; -#ifdef DB_VERSION_MAJOR - RETVAL = do_SEQ(db, key, value, DB_LAST) ; - RETVAL = 0 ; - key = empty ; - for (i = 1 ; i < items ; ++i) - { - value.data = SvPV(ST(i), n_a) ; - value.size = n_a ; - RETVAL = (Db->put)(Db, NULL, &key, &value, DB_APPEND) ; - if (RETVAL != 0) - break; - } -#else - /* Set the Cursor to the Last element */ RETVAL = do_SEQ(db, key, value, R_LAST) ; +#ifndef DB_VERSION_MAJOR if (RETVAL >= 0) +#endif { - if (RETVAL == 1) - key = empty ; - for (i = items - 1 ; i > 0 ; --i) + if (RETVAL == 0) + keyval = *(int*)key.data ; + else + keyval = 0 ; + for (i = 1 ; i < items ; ++i) { value.data = SvPV(ST(i), n_a) ; value.size = n_a ; - RETVAL = (Db->put)(Db, &key, &value, R_IAFTER) ; + ++ keyval ; + key.data = &keyval ; + key.size = sizeof(int) ; + RETVAL = (Db->put)(Db, TXN &key, &value, 0) ; if (RETVAL != 0) break; } } -#endif } OUTPUT: RETVAL - I32 length(db) DB_File db @@ -1619,7 +1857,7 @@ db_get(db, key, value, flags=0) u_int flags CODE: CurrentDB = db ; - DBT_flags(value) ; + DBT_clear(value) ; RETVAL = db_get(db, key, value, flags) ; #ifdef DB_VERSION_MAJOR if (RETVAL > 0) @@ -1694,7 +1932,7 @@ db_seq(db, key, value, flags) u_int flags CODE: CurrentDB = db ; - DBT_flags(value) ; + DBT_clear(value) ; RETVAL = db_seq(db, key, value, flags); #ifdef DB_VERSION_MAJOR if (RETVAL > 0) |