From: Paul Marquess Date: Tue, 10 Feb 1998 11:23:22 +0000 (+0000) Subject: DB_File 1.58 patch X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=045291aaa73517617f476ce545bda17b5597801e;p=p5sagit%2Fp5-mst-13.2.git DB_File 1.58 patch p4raw-id: //depot/perl@506 --- diff --git a/MANIFEST b/MANIFEST index 68708c1..88c6092 100644 --- a/MANIFEST +++ b/MANIFEST @@ -120,6 +120,7 @@ emacs/ptags Creates smart TAGS file embed.h Maps symbols to safer names embed.pl Produces embed.h embedvar.h C namespace management +ext/DB_File/Changes Berkeley DB extension change log ext/DB_File/DB_File.pm Berkeley DB extension Perl module ext/DB_File/DB_File.xs Berkeley DB extension external subroutines ext/DB_File/DB_File_BS Berkeley DB extension mkbootstrap fodder diff --git a/ext/DB_File/Changes b/ext/DB_File/Changes new file mode 100644 index 0000000..a86ea4a --- /dev/null +++ b/ext/DB_File/Changes @@ -0,0 +1,194 @@ + +0.1 + + First Release. + +0.2 + + When DB_File is opening a database file it no longer terminates the + process if dbopen returned an error. This allows file protection + errors to be caught at run time. Thanks to Judith Grass + for spotting the bug. + +0.3 + + Added prototype support for multiple btree compare callbacks. + +1.0 + + DB_File has been in use for over a year. To reflect that, the + version number has been incremented to 1.0. + + Added complete support for multiple concurrent callbacks. + + Using the push method on an empty list didn't work properly. This + has been fixed. + +1.01 + + Fixed a core dump problem with SunOS. + + The return value from TIEHASH wasn't set to NULL when dbopen + returned an error. + +1.02 + + Merged OS/2 specific code into DB_File.xs + + Removed some redundant code in DB_File.xs. + + Documentation update. + + Allow negative subscripts with RECNO interface. + + Changed the default flags from O_RDWR to O_CREAT|O_RDWR. + + The example code which showed how to lock a database needed a call + to sync added. Without it the resultant database file was empty. + + Added get_dup method. + +1.03 + + Documentation update. + + DB_File now imports the constants (O_RDWR, O_CREAT etc.) from Fcntl + automatically. + + The standard hash function exists is now supported. + + Modified the behavior of get_dup. When it returns an associative + array, the value is the count of the number of matching BTREE + values. + +1.04 + + Minor documentation changes. + + Fixed a bug in hash_cb. Patches supplied by Dave Hammen, + . + + Fixed a bug with the constructors for DB_File::HASHINFO, + DB_File::BTREEINFO and DB_File::RECNOINFO. Also tidied up the + constructors to make them -w clean. + + Reworked part of the test harness to be more locale friendly. + +1.05 + + Made all scripts in the documentation strict and -w clean. + + Added logic to DB_File.xs to allow the module to be built after + Perl is installed. + +1.06 + + Minor namespace cleanup: Localized PrintBtree. + +1.07 + + Fixed bug with RECNO, where bval wasn't defaulting to "\n". + +1.08 + + Documented operation of bval. + +1.09 + + Minor bug fix in DB_File::HASHINFO, DB_File::RECNOINFO and + DB_File::BTREEINFO. + + Changed default mode to 0666. + +1.10 + + Fixed fd method so that it still returns -1 for in-memory files + when db 1.86 is used. + +1.11 + + Documented the untie gotcha. + +1.12 + + Documented the incompatibility with version 2 of Berkeley DB. + +1.13 + + Minor changes to DB_FIle.xs and DB_File.pm + +1.14 + + Made it illegal to tie an associative array to a RECNO database and + an ordinary array to a HASH or BTREE database. + +1.15 + + Patch from Gisle Aas to suppress "use of undefined + value" warning with db_get and db_seq. + + Patch from Gisle Aas to make DB_File export only the + O_* constants from Fcntl. + + Removed the DESTROY method from the DB_File::HASHINFO module. + + Previously DB_File hard-wired the class name of any object that it + created to "DB_File". This makes sub-classing difficult. Now + DB_File creats objects in the namespace of the package it has been + inherited into. + + +1.16 + + A harmless looking tab was causing Makefile.PL to fail on AIX 3.2.5 + + Small fix for the AIX strict C compiler XLC which doesn't like + __attribute__ being defined via proto.h and redefined via db.h. Fix + courtesy of Jarkko Hietaniemi. + +1.50 + + DB_File can now build with either DB 1.x or 2.x, but not both at + the same time. + +1.51 + + Fixed the test harness so that it doesn't expect DB_File to have + been installed by the main Perl build. + + + Fixed a bug in mapping 1.x O_RDONLY flag to 2.x DB_RDONLY equivalent + +1.52 + + Patch from Nick Ing-Simmons now allows DB_File to build on NT. + Merged 1.15 patch. + +1.53 + + Added DB_RENUMBER to flags for recno. + +1.54 + + Fixed a small bug in the test harness when run under win32 + The emulation of fd when useing DB 2.x was busted. + +1.55 + Merged 1.16 changes. + +1.56 + Documented the Solaris 2.5 mutex bug + +1.57 + If Perl has been compiled with Threads support,the symbol op will be + defined. This clashes with a field name in db.h, so it needs to be + #undef'ed before db.h is included. + +1.58 + Tied Array support was enhanced in Perl 5.004_57. DB_File now + supports PUSH,POP,SHIFT,UNSHIFT & STORESIZE. + + Fixed a problem with the use of sv_setpvn. When the size is + specified as 0, it does a strlen on the data. This was ok for DB + 1.x, but isn't for DB 2.x. + diff --git a/ext/DB_File/DB_File.pm b/ext/DB_File/DB_File.pm index 8124643..95e0a55 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 (pmarquess@bfsec.bt.co.uk) -# last modified 20th Nov 1997 -# version 1.56 +# last modified 20th Dec 1997 +# version 1.57 # # Copyright (c) 1995, 1996, 1997 Paul Marquess. All rights reserved. # This program is free software; you can redistribute it and/or @@ -106,7 +106,7 @@ package DB_File::RECNOINFO ; use strict ; -@DB_File::RECNOINFO::ISA = qw(DB_File::HASHINFO) ; +@DB_File::RECNOINFO::ISA = qw(DB_File::HASHINFO) ; sub TIEHASH { @@ -145,7 +145,7 @@ use vars qw($VERSION @ISA @EXPORT $AUTOLOAD $DB_BTREE $DB_HASH $DB_RECNO $db_ver use Carp; -$VERSION = "1.56" ; +$VERSION = "1.58" ; #typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE; $DB_BTREE = new DB_File::BTREEINFO ; @@ -189,9 +189,7 @@ require DynaLoader; R_SNAPSHOT __R_UNUSED -); - -*FETCHSIZE = \&length; +); sub AUTOLOAD { my($constname); @@ -267,7 +265,8 @@ sub TIEARRAY tie_hash_or_array(@_) ; } -sub CLEAR { +sub CLEAR +{ my $self = shift; my $key = "" ; my $value = "" ; @@ -283,6 +282,23 @@ sub CLEAR { } } +sub EXTEND { } + +sub STORESIZE +{ + my $self = shift; + my $length = shift ; + my $current_length = $self->length() ; + + if ($length < $current_length) { + my $key ; + for ($key = $current_length - 1 ; $key >= $length ; -- $key) + { $self->del($key) } + } + elsif ($length > $current_length) + { $self->put($length-1, "") } +} + sub get_dup { croak "Usage: \$db->get_dup(key [,flag])\n" @@ -1022,11 +1038,15 @@ Here is the output from the script: =head2 Extra Methods -As you can see from the example above, the tied array interface is -quite limited. To make the interface more useful, a number of methods -are supplied with B to simulate the standard array operations -that are not currently implemented in Perl's tied array interface. All -these methods are accessed via the object returned from the tie call. +If you are using a version of Perl earlier than 5.004_57, the tied +array interface is quite limited. The example script above will work, +but you won't be able to use C, C, C, C +etc. with the tied array. + +To make the interface more useful for older versions of Perl, a number +of methods are supplied with B to simulate the missing array +operations. All these methods are accessed via the object returned from +the tie call. Here are the methods: diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs index 8f2eda1..91b4dc2 100644 --- a/ext/DB_File/DB_File.xs +++ b/ext/DB_File/DB_File.xs @@ -3,12 +3,12 @@ DB_File.xs -- Perl 5 interface to Berkeley DB written by Paul Marquess (pmarquess@bfsec.bt.co.uk) - last modified 20th Nov 1997 - version 1.56 + last modified 2nd Feb 1998 + version 1.58 All comments/suggestions/problems are welcome - Copyright (c) 1995, 1996, 1997 Paul Marquess. All rights reserved. + Copyright (c) 1995, 1996, 1997, 1998 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. @@ -50,6 +50,10 @@ 1.54 - Fixed bug in the fd method 1.55 - Fix for AIX from Jarkko Hietaniemi 1.56 - No change to DB_File.xs + 1.57 - added the #undef op to allow building with Threads support. + 1.58 - Fixed a problem with the use of sv_setpvn. When the + size is specified as 0, it does a strlen on the data. + This was ok for DB 1.x, but isn't for DB 2.x. @@ -65,6 +69,12 @@ #undef __attribute__ +/* 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 #include #include @@ -238,10 +248,11 @@ typedef struct { typedef DB_File_type * DB_File ; typedef DBT DBTKEY ; +#define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (void*)""), s) #define OutputValue(arg, name) \ { if (RETVAL == 0) { \ - sv_setpvn(arg, name.data, name.size) ; \ + my_sv_setpvn(arg, name.data, name.size) ; \ } \ } @@ -249,13 +260,14 @@ typedef DBT DBTKEY ; { if (RETVAL == 0) \ { \ if (db->type != DB_RECNO) { \ - sv_setpvn(arg, name.data, name.size); \ + my_sv_setpvn(arg, name.data, name.size); \ } \ else \ sv_setiv(arg, (I32)*(I32*)name.data - 1); \ } \ } + /* Internal Global Data */ static recno_t Value ; static recno_t zero = 0 ; @@ -560,13 +572,12 @@ SV * sv ; { SV ** svp; HV * action ; - DB_File RETVAL; + DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ; void * openinfo = NULL ; - INFO * info; + INFO * info = &RETVAL->info ; /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */ - Newz(777, RETVAL, 1, DB_File_type) ; - info = &RETVAL->info ; + Zero(RETVAL, 1, DB_File_type) ; /* Default to HASH */ RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ; @@ -1159,7 +1170,7 @@ db_FETCH(db, key, flags=0) RETVAL = db_get(db, key, value, flags) ; ST(0) = sv_newmortal(); if (RETVAL == 0) - sv_setpvn(ST(0), value.data, value.size); + my_sv_setpvn(ST(0), value.data, value.size); } int @@ -1189,7 +1200,7 @@ db_FIRSTKEY(db) if (RETVAL == 0) { if (db->type != DB_RECNO) - sv_setpvn(ST(0), key.data, key.size); + my_sv_setpvn(ST(0), key.data, key.size); else sv_setiv(ST(0), (I32)*(I32*)key.data - 1); } @@ -1211,7 +1222,7 @@ db_NEXTKEY(db, key) if (RETVAL == 0) { if (db->type != DB_RECNO) - sv_setpvn(ST(0), key.data, key.size); + my_sv_setpvn(ST(0), key.data, key.size); else sv_setiv(ST(0), (I32)*(I32*)key.data - 1); } @@ -1224,6 +1235,7 @@ db_NEXTKEY(db, key) int unshift(db, ...) DB_File db + ALIAS: UNSHIFT = 1 CODE: { DBTKEY key ; @@ -1264,6 +1276,7 @@ unshift(db, ...) I32 pop(db) DB_File db + ALIAS: POP = 1 CODE: { DBTKEY key ; @@ -1281,7 +1294,7 @@ pop(db) if (RETVAL == 0) { /* the call to del will trash value, so take a copy now */ - sv_setpvn(ST(0), value.data, value.size); + my_sv_setpvn(ST(0), value.data, value.size); RETVAL = db_del(db, key, R_CURSOR) ; if (RETVAL != 0) sv_setsv(ST(0), &sv_undef); @@ -1291,6 +1304,7 @@ pop(db) I32 shift(db) DB_File db + ALIAS: SHIFT = 1 CODE: { DBT value ; @@ -1307,7 +1321,7 @@ shift(db) if (RETVAL == 0) { /* the call to del will trash value, so take a copy now */ - sv_setpvn(ST(0), value.data, value.size); + my_sv_setpvn(ST(0), value.data, value.size); RETVAL = db_del(db, key, R_CURSOR) ; if (RETVAL != 0) sv_setsv (ST(0), &sv_undef) ; @@ -1318,6 +1332,7 @@ shift(db) I32 push(db, ...) DB_File db + ALIAS: PUSH = 1 CODE: { DBTKEY key ; @@ -1365,6 +1380,7 @@ push(db, ...) I32 length(db) DB_File db + ALIAS: FETCHSIZE = 1 CODE: CurrentDB = db ; RETVAL = GetArrayLength(db) ; diff --git a/t/lib/db-recno.t b/t/lib/db-recno.t index b332c5e..c2161b2 100755 --- a/t/lib/db-recno.t +++ b/t/lib/db-recno.t @@ -12,7 +12,10 @@ BEGIN { use DB_File; use Fcntl; use strict ; -use vars qw($dbh $Dfile $bad_ones) ; +use vars qw($dbh $Dfile $bad_ones $FA) ; + +# full tied array support started in Perl 5.004_57 +$FA = ($] >= 5.004_57) ; sub ok { @@ -41,7 +44,7 @@ sub bad_one EOM } -print "1..66\n"; +print "1..78\n"; my $Dfile = "recno.tmp"; unlink $Dfile ; @@ -98,7 +101,7 @@ ok(18, ((stat($Dfile))[2] & 0777) == (($^O eq 'os2' || $^O eq 'MSWin32') ? 0666 #my $l = @h ; my $l = $X->length ; -ok(19, !$l ); +ok(19, ($FA ? @h == 0 : !$l) ); my @data = qw( a b c d ever f g h i j k longername m n o p) ; @@ -113,7 +116,7 @@ unshift (@data, 'a') ; ok(21, defined $h[1] ); ok(22, ! defined $h[16] ); -ok(23, $X->length == @data ); +ok(23, $FA ? @h == @data : $X->length == @data ); # Overwrite an entry & check fetch it @@ -123,8 +126,7 @@ ok(24, $h[3] eq 'replaced' ); #PUSH my @push_data = qw(added to the end) ; -#my push (@h, @push_data) ; -$X->push(@push_data) ; +($FA ? push(@h, @push_data) : $X->push(@push_data)) ; push (@data, @push_data) ; ok(25, $h[++$i] eq 'added' ); ok(26, $h[++$i] eq 'to' ); @@ -133,27 +135,24 @@ ok(28, $h[++$i] eq 'end' ); # POP my $popped = pop (@data) ; -#my $value = pop(@h) ; -my $value = $X->pop ; +my $value = ($FA ? pop @h : $X->pop) ; ok(29, $value eq $popped) ; # SHIFT -#$value = shift @h -$value = $X->shift ; +$value = ($FA ? shift @h : $X->shift) ; my $shifted = shift @data ; ok(30, $value eq $shifted ); # UNSHIFT # empty list -$X->unshift ; -ok(31, $X->length == @data ); +($FA ? unshift @h : $X->unshift) ; +ok(31, ($FA ? @h == @data : $X->length == @data )); my @new_data = qw(add this to the start of the array) ; -#unshift @h, @new_data ; -$X->unshift (@new_data) ; +$FA ? unshift (@h, @new_data) : $X->unshift (@new_data) ; unshift (@data, @new_data) ; -ok(32, $X->length == @data ); +ok(32, $FA ? @h == @data : $X->length == @data ); ok(33, $h[0] eq "add") ; ok(34, $h[1] eq "this") ; ok(35, $h[2] eq "to") ; @@ -180,15 +179,15 @@ ok(42, $ok ); # get the last element of the array ok(43, $h[-1] eq $data[-1] ); -ok(44, $h[-1] eq $h[$X->length -1] ); +ok(44, $h[-1] eq $h[ ($FA ? @h : $X->length) -1] ); # get the first element using a negative subscript -eval '$h[ - ( $X->length)] = "abcd"' ; +eval '$h[ - ( $FA ? @h : $X->length)] = "abcd"' ; ok(45, $@ eq "" ); ok(46, $h[0] eq "abcd" ); # now try to read before the start of the array -eval '$h[ - (1 + $X->length)] = 1234' ; +eval '$h[ - (1 + ($FA ? @h : $X->length))] = 1234' ; ok(47, $@ =~ '^Modification of non-creatable array value attempted' ); # IMPORTANT - $X must be undefined before the untie otherwise the @@ -350,7 +349,7 @@ EOM close FILE ; - BEGIN { push @INC, '.'; } + BEGIN { push @INC, '.'; } eval 'use SubDB ; '; main::ok(57, $@ eq "") ; my @h ; @@ -384,4 +383,61 @@ EOM } +{ + + # test $# + my $self ; + unlink $Dfile; + ok(67, $self = tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_RECNO ) ; + $h[0] = "abc" ; + $h[1] = "def" ; + $h[2] = "ghi" ; + $h[3] = "jkl" ; + ok(68, $FA ? $#h == 3 : $self->length() == 4) ; + undef $self ; + untie @h ; + my $x = docat($Dfile) ; + ok(69, $x eq "abc\ndef\nghi\njkl\n") ; + + # $# sets array to same length + ok(70, $self = tie @h, 'DB_File', $Dfile, O_RDWR, 0640, $DB_RECNO ) ; + if ($FA) + { $#h = 3 } + else + { $self->STORESIZE(4) } + ok(71, $FA ? $#h == 3 : $self->length() == 4) ; + undef $self ; + untie @h ; + $x = docat($Dfile) ; + ok(72, $x eq "abc\ndef\nghi\njkl\n") ; + + # $# sets array to bigger + ok(73, $self = tie @h, 'DB_File', $Dfile, O_RDWR, 0640, $DB_RECNO ) ; + if ($FA) + { $#h = 6 } + else + { $self->STORESIZE(7) } + ok(74, $FA ? $#h == 6 : $self->length() == 7) ; + undef $self ; + untie @h ; + $x = docat($Dfile) ; + ok(75, $x eq "abc\ndef\nghi\njkl\n\n\n\n") ; + + # $# sets array smaller + ok(76, $self = tie @h, 'DB_File', $Dfile, O_RDWR, 0640, $DB_RECNO ) ; + if ($FA) + { $#h = 2 } + else + { $self->STORESIZE(3) } + ok(77, $FA ? $#h == 2 : $self->length() == 3) ; + undef $self ; + untie @h ; + $x = docat($Dfile) ; + ok(78, $x eq "abc\ndef\nghi\n") ; + + unlink $Dfile; + + +} + exit ;