From: Paul Marquess Date: Tue, 8 Jun 1999 22:37:58 +0000 (+0100) Subject: DB_File 1.67 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c8e4dba7656178973f835a94d2b9819f36c2fef8;p=p5sagit%2Fp5-mst-13.2.git DB_File 1.67 Message-ID: <5104D4DBC598D211B5FE0000F8FE7EB29C6C3C@mbtlipnt02.btlabs.bt.co.uk> p4raw-id: //depot/perl@3604 --- diff --git a/ext/DB_File/Changes b/ext/DB_File/Changes index 82d9af5..236af0f 100644 --- a/ext/DB_File/Changes +++ b/ext/DB_File/Changes @@ -237,3 +237,12 @@ 1.66 15th March 1999 * Added DBM Filter code + +1.67 6th June 1999 + + * Added DBM Filter documentation to DB_File.pm + + * Fixed DBM Filter code to work with 5.004 + + * A few instances of newSVpvn were used in 1.66. This isn't available in + Perl 5.004_04 or earlier. Replaced with newSVpv. diff --git a/ext/DB_File/DB_File.pm b/ext/DB_File/DB_File.pm index 7e6c907..7dd1d26 100644 --- a/ext/DB_File/DB_File.pm +++ b/ext/DB_File/DB_File.pm @@ -1,10 +1,10 @@ # DB_File.pm -- Perl 5 interface to Berkeley DB # # written by Paul Marquess (Paul.Marquess@btinternet.com) -# last modified 6th March 1999 -# version 1.66 +# last modified 6th June 1999 +# version 1.67 # -# Copyright (c) 1995-9 Paul Marquess. All rights reserved. +# Copyright (c) 1995-1999 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. @@ -145,7 +145,7 @@ use vars qw($VERSION @ISA @EXPORT $AUTOLOAD $DB_BTREE $DB_HASH $DB_RECNO $db_ver use Carp; -$VERSION = "1.66" ; +$VERSION = "1.67" ; #typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE; $DB_BTREE = new DB_File::BTREEINFO ; @@ -408,6 +408,12 @@ DB_File - Perl5 access to Berkeley DB version 1.x $a = $X->shift; $X->unshift(list); + # DBM Filters + $old_filter = $db->filter_store_key ( sub { ... } ) ; + $old_filter = $db->filter_store_value( sub { ... } ) ; + $old_filter = $db->filter_fetch_key ( sub { ... } ) ; + $old_filter = $db->filter_fetch_value( sub { ... } ) ; + untie %hash ; untie @array ; @@ -1488,6 +1494,141 @@ R_RECNOSYNC is the only valid flag at present. =back +=head1 DBM FILTERS + +A DBM Filter is a piece of code that is be used when you I +want to make the same transformation to all keys and/or values in a +DBM database. + +There are four methods associated with DBM Filters. All work identically, +and each is used to install (or uninstall) a single DBM Filter. Each +expects a single parameter, namely a reference to a sub. The only +difference between them is the place that the filter is installed. + +To summarise: + +=over 5 + +=item B + +If a filter has been installed with this method, it will be invoked +every time you write a key to a DBM database. + +=item B + +If a filter has been installed with this method, it will be invoked +every time you write a value to a DBM database. + + +=item B + +If a filter has been installed with this method, it will be invoked +every time you read a key from a DBM database. + +=item B + +If a filter has been installed with this method, it will be invoked +every time you read a value from a DBM database. + +=back + +You can use any combination of the methods, from none, to all four. + +All filter methods return the existing filter, if present, or C +in not. + +To delete a filter pass C to it. + +=head2 The Filter + +When each filter is called by Perl, a local copy of C<$_> will contain +the key or value to be filtered. Filtering is achieved by modifying +the contents of C<$_>. The return code from the filter is ignored. + +=head2 An Example -- the NULL termination problem. + +Consider the following scenario. You have a DBM database +that you need to share with a third-party C application. The C application +assumes that I keys and values are NULL terminated. Unfortunately +when Perl writes to DBM databases it doesn't use NULL termination, so +your Perl application will have to manage NULL termination itself. When +you write to the database you will have to use something like this: + + $hash{"$key\0"} = "$value\0" ; + +Similarly the NULL needs to be taken into account when you are considering +the length of existing keys/values. + +It would be much better if you could ignore the NULL terminations issue +in the main application code and have a mechanism that automatically +added the terminating NULL to all keys and values whenever you write to +the database and have them removed when you read from the database. As I'm +sure you have already guessed, this is a problem that DBM Filters can +fix very easily. + + use strict ; + use DB_File ; + + my %hash ; + my $filename = "/tmp/filt" ; + unlink $filename ; + + my $db = tie %hash, 'DB_File', $filename, O_CREAT|O_RDWR, 0666, $DB_HASH + or die "Cannot open $filename: $!\n" ; + + # Install DBM Filters + $db->filter_fetch_key ( sub { s/\0$// } ) ; + $db->filter_store_key ( sub { $_ .= "\0" } ) ; + $db->filter_fetch_value( sub { s/\0$// } ) ; + $db->filter_store_value( sub { $_ .= "\0" } ) ; + + $hash{"abc"} = "def" ; + my $a = $hash{"ABC"} ; + # ... + undef $db ; + untie %hash ; + +Hopefully the contents of each of the filters should be +self-explanatory. Both "fetch" filters remove the terminating NULL, +and both "store" filters add a terminating NULL. + + +=head2 Another Example -- Key is a C int. + +Here is another real-life example. By default, whenever Perl writes to +a DBM database it always writes the key and value as strings. So when +you use this: + + $hash{12345} = "soemthing" ; + +the key 12345 will get stored in the DBM database as the 5 byte string +"12345". If you actually want the key to be stored in the DBM database +as a C int, you will have to use C when writing, and C +when reading. + +Here is a DBM Filter that does it: + + use strict ; + use DB_File ; + my %hash ; + my $filename = "/tmp/filt" ; + unlink $filename ; + + + my $db = tie %hash, 'DB_File', $filename, O_CREAT|O_RDWR, 0666, $DB_HASH + or die "Cannot open $filename: $!\n" ; + + $db->filter_fetch_key ( sub { $_ = unpack("i", $_) } ) ; + $db->filter_store_key ( sub { $_ = pack ("i", $_) } ) ; + $hash{123} = "def" ; + # ... + undef $db ; + untie %hash ; + +This time only two filters have been used -- we only need to manipulate +the contents of the key, so it wasn't necessary to install any value +filters. + =head1 HINTS AND TIPS @@ -1557,7 +1698,7 @@ shared by both a Perl and a C application. The vast majority of problems that are reported in this area boil down to the fact that C strings are NULL terminated, whilst Perl strings are -not. +not. See L for a generic way to work around this problem. Here is a real example. Netscape 2.0 keeps a record of the locations you visit along with the time you last visited them in a DB_HASH database. @@ -1746,6 +1887,19 @@ double quotes, like this: Although it might seem like a real pain, it is really worth the effort of having a C in all your scripts. +=head1 REFERENCES + +Articles that are either about B or make use of it. + +=over 5 + +=item 1. + +I, Tim Kientzle (tkientzle@ddj.com), +Dr. Dobb's Journal, Issue 295, January 1999, pp 34-41 + +=back + =head1 HISTORY Moved to the Changes file. @@ -1771,10 +1925,8 @@ F. This version of B will work with either version 1.x or 2.x of Berkeley DB, but is limited to the functionality provided by version 1. -The official web site for Berkeley DB is -F. The ftp equivalent is -F. Both versions 1 and 2 of Berkeley DB are -available there. +The official web site for Berkeley DB is F. +Both versions 1 and 2 of Berkeley DB are available there. Alternatively, Berkeley DB version 1 is available at your nearest CPAN archive in F. @@ -1785,7 +1937,7 @@ compile properly on IRIX 5.3. =head1 COPYRIGHT -Copyright (c) 1995-9 Paul Marquess. All rights reserved. This program +Copyright (c) 1995-1999 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. diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs index be584a2..ed3a7fa 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 6th March 1999 - version 1.66 + last modified 6th June 1999 + version 1.67 All comments/suggestions/problems are welcome @@ -66,6 +66,9 @@ 1.65 - Fixed a bug in the PUSH logic. Added BOOT check that using 2.3.4 or greater 1.66 - Added DBM filter code + 1.67 - Backed off the use of newSVpvn. + Fixed DBM Filter code for Perl 5.004. + Fixed a small memory leak in the filter code. @@ -89,6 +92,11 @@ #endif +/* DEFSV appears first in 5.004_56 */ +#ifndef DEFSV +#define DEFSV GvSV(defgv) +#endif + /* Being the Berkeley DB we prefer the (which will be * shortly #included by the ) __attribute__ to the possibly * already defined __attribute__, for example by GNUC or by Perl. */ @@ -301,16 +309,13 @@ typedef DBT DBTKEY ; if (db->filtering) \ croak("recursion detected in %s", name) ; \ db->filtering = TRUE ; \ - /* SAVE_DEFSV ;*/ /* save $_ */ \ save_defsv = newSVsv(DEFSV) ; \ sv_setsv(DEFSV, arg) ; \ PUSHMARK(sp) ; \ (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS); \ - /* SPAGAIN ; */ \ sv_setsv(arg, DEFSV) ; \ - sv_setsv(DEFSV, save_defsv) ; \ + sv_setsv(DEFSV, save_defsv) ; \ SvREFCNT_dec(save_defsv) ; \ - /* PUTBACK ; */ \ db->filtering = FALSE ; \ /*printf("end of filtering %s\n", name) ;*/ \ } @@ -417,7 +422,7 @@ btree_compare(const DBT *key1, const DBT *key2) data1 = key1->data ; data2 = key2->data ; -#if 0 + /* As newSVpv will assume that the data pointer is a null terminated C string if the size parameter is 0, make sure that data points to an empty string if the length is 0 @@ -426,14 +431,14 @@ btree_compare(const DBT *key1, const DBT *key2) data1 = "" ; if (key2->size == 0) data2 = "" ; -#endif + ENTER ; SAVETMPS; PUSHMARK(SP) ; EXTEND(SP,2) ; - PUSHs(sv_2mortal(newSVpvn(data1,key1->size))); - PUSHs(sv_2mortal(newSVpvn(data2,key2->size))); + PUSHs(sv_2mortal(newSVpv(data1,key1->size))); + PUSHs(sv_2mortal(newSVpv(data2,key2->size))); PUTBACK ; count = perl_call_sv(CurrentDB->compare, G_SCALAR); @@ -463,7 +468,7 @@ btree_prefix(const DBT *key1, const DBT *key2) data1 = key1->data ; data2 = key2->data ; -#if 0 + /* As newSVpv will assume that the data pointer is a null terminated C string if the size parameter is 0, make sure that data points to an empty string if the length is 0 @@ -472,14 +477,14 @@ btree_prefix(const DBT *key1, const DBT *key2) data1 = "" ; if (key2->size == 0) data2 = "" ; -#endif + ENTER ; SAVETMPS; PUSHMARK(SP) ; EXTEND(SP,2) ; - PUSHs(sv_2mortal(newSVpvn(data1,key1->size))); - PUSHs(sv_2mortal(newSVpvn(data2,key2->size))); + PUSHs(sv_2mortal(newSVpv(data1,key1->size))); + PUSHs(sv_2mortal(newSVpv(data2,key2->size))); PUTBACK ; count = perl_call_sv(CurrentDB->prefix, G_SCALAR); @@ -505,17 +510,17 @@ hash_cb(const void *data, size_t size) dSP ; int retval ; int count ; -#if 0 + if (size == 0) data = "" ; -#endif + /* DGH - Next two lines added to fix corrupted stack problem */ ENTER ; SAVETMPS; PUSHMARK(SP) ; - XPUSHs(sv_2mortal(newSVpvn((char*)data,size))); + XPUSHs(sv_2mortal(newSVpv((char*)data,size))); PUTBACK ; count = perl_call_sv(CurrentDB->hash, G_SCALAR); @@ -1564,7 +1569,8 @@ db_seq(db, key, value, flags) #define setFilter(type) \ { \ if (db->type) \ - RETVAL = newSVsv(db->type) ; \ + RETVAL = sv_mortalcopy(db->type) ; \ + ST(0) = RETVAL ; \ if (db->type && (code == &PL_sv_undef)) { \ SvREFCNT_dec(db->type) ; \ db->type = NULL ; \ @@ -1585,8 +1591,6 @@ filter_fetch_key(db, code) SV * RETVAL = &PL_sv_undef ; CODE: setFilter(filter_fetch_key) ; - OUTPUT: - RETVAL SV * filter_store_key(db, code) @@ -1595,8 +1599,6 @@ filter_store_key(db, code) SV * RETVAL = &PL_sv_undef ; CODE: setFilter(filter_store_key) ; - OUTPUT: - RETVAL SV * filter_fetch_value(db, code) @@ -1605,8 +1607,6 @@ filter_fetch_value(db, code) SV * RETVAL = &PL_sv_undef ; CODE: setFilter(filter_fetch_value) ; - OUTPUT: - RETVAL SV * filter_store_value(db, code) @@ -1615,7 +1615,5 @@ filter_store_value(db, code) SV * RETVAL = &PL_sv_undef ; CODE: setFilter(filter_store_value) ; - OUTPUT: - RETVAL #endif /* DBM_FILTERING */ diff --git a/ext/DB_File/typemap b/ext/DB_File/typemap index 8e4dacb..a614cc4 100644 --- a/ext/DB_File/typemap +++ b/ext/DB_File/typemap @@ -1,8 +1,8 @@ # typemap for Perl 5 interface to Berkeley # # written by Paul Marquess -# last modified 20th March 1999 -# version 1.66 +# last modified 6th June 1999 +# version 1.67 # #################################### DB SECTION # @@ -33,6 +33,7 @@ T_dbtdatum $var.size = (int)PL_na; DBT_flags($var); + OUTPUT T_dbtkeydatum