[perl #114350] access to sdbm_prep()

This allows the .dir and .pag filenames to be specified explicitly

diff --git a/MANIFEST b/MANIFEST
index 435db6c..08663b3 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3788,6 +3788,7 @@ ext/SDBM_File/sdbm/sdbm.h SDBM kit
 ext/SDBM_File/sdbm/tune.h      SDBM kit
 ext/SDBM_File/sdbm/util.c      SDBM kit
 ext/SDBM_File/t/constants.t    See if SDBM_File constants work
+ext/SDBM_File/t/prep.t         See if SDBM_File with extra argument works
 ext/SDBM_File/t/sdbm.t         See if SDBM_File works
 ext/SDBM_File/typemap          SDBM extension interface types
 ext/Sys-Hostname/Hostname.pm   Sys::Hostname extension Perl module

diff --git a/ext/SDBM_File/SDBM_File.pm b/ext/SDBM_File/SDBM_File.pm
index 5f7bc77..ca181b7 100644 (file)
--- a/ext/SDBM_File/SDBM_File.pm
+++ b/ext/SDBM_File/SDBM_File.pm
@@ -62,7 +62,8 @@ package to perform the functions of the hash.)
 
 =item 3. 
 
-The name of the file you want to tie to the hash.  
+The name of the file you want to tie to the hash.  If the page file
+name is supplied, this becomes the directory file name.
 
 =item 4.
 
@@ -94,8 +95,40 @@ The default permissions to use if a new file is created.  The actual
 permissions will be modified by the user's umask, so you should
 probably use 0666 here. (See L<perlfunc/umask>.)
 
+=item 6.
+
+Optionally, the name of the data page file (normally F<<
+I<filename>.pag >>.  If this is supplied, then the first filename is
+treated as the directory file (normally F<< I<filename>.dir >> based
+on the first filename parameter).
+
+=back
+
+=head1 EXPORTS
+
+SDBM_File optionally exports the following constants:
+
+=over
+
+=item *
+
+C<PAGFEXT> - the extension used for the page file, usually C<.pag>.
+
+=item *
+
+C<DIRFEXT> - the extension used for the directory file, C<.dir>
+everywhere but VMS, where it is C<.sdbm_dir>.
+
+=item *
+
+C<PAIRMAX> - the maximum size of a stored hash entry, including the
+length of both the key and value.
+
 =back
 
+These constants can also be used with fully qualified names,
+eg. C<SDBM_File::PAGFEXT>.
+
 =head1 DIAGNOSTICS
 
 On failure, the C<tie> call returns an undefined value and probably

diff --git a/ext/SDBM_File/SDBM_File.xs b/ext/SDBM_File/SDBM_File.xs
index d47e726..070f074 100644 (file)
--- a/ext/SDBM_File/SDBM_File.xs
+++ b/ext/SDBM_File/SDBM_File.xs
@@ -19,7 +19,6 @@ typedef SDBM_File_type * SDBM_File ;
 typedef datum datum_key ;
 typedef datum datum_value ;
 
-#define sdbm_TIEHASH(dbtype,filename,flags,mode) sdbm_open(filename,flags,mode)
 #define sdbm_FETCH(db,key)                     sdbm_fetch(db->dbp,key)
 #define sdbm_STORE(db,key,value,flags)         sdbm_store(db->dbp,key,value,flags)
 #define sdbm_DELETE(db,key)                    sdbm_delete(db->dbp,key)
@@ -31,17 +30,24 @@ typedef datum datum_value ;
 MODULE = SDBM_File     PACKAGE = SDBM_File     PREFIX = sdbm_
 
 SDBM_File
-sdbm_TIEHASH(dbtype, filename, flags, mode)
+sdbm_TIEHASH(dbtype, filename, flags, mode, pagname=NULL)
        char *          dbtype
        char *          filename
        int             flags
        int             mode
+       char *          pagname
        CODE:
        {
            DBM *       dbp ;
 
            RETVAL = NULL ;
-           if ((dbp = sdbm_open(filename,flags,mode))) {
+           if (pagname == NULL) {
+               dbp = sdbm_open(filename, flags, mode);
+           }
+           else {
+               dbp = sdbm_prep(filename, pagname, flags, mode);
+           }
+           if (dbp) {
                RETVAL = (SDBM_File)safecalloc(1, sizeof(SDBM_File_type));
                RETVAL->dbp = dbp ;
            }

diff --git a/ext/SDBM_File/t/prep.t b/ext/SDBM_File/t/prep.t
new file mode 100644 (file)
index 0000000..a222a64
--- /dev/null
+++ b/ext/SDBM_File/t/prep.t
@@ -0,0 +1,34 @@
+#!./perl
+use strict;
+use Test::More tests => 4;
+
+use SDBM_File;
+use File::Temp 'tempfile';
+use Fcntl;
+
+my ($dirfh, $dirname) = tempfile();
+my ($pagfh, $pagname) = tempfile();
+
+# close so Win32 allows them to be re-opened
+close $dirfh;
+close $pagfh;
+
+{
+    my %h;
+
+    ok(eval { tie %h, "SDBM_File", $dirname, O_CREAT | O_RDWR | O_TRUNC, 0640, $pagname; 1 },
+       "create SDBM with explicit filenames")
+      or diag $@;
+    is(keys %h, 0, "should be empty");
+
+    # basic sanity checks, the real storage checks are done by sdbm.t
+    $h{abc} = 1;
+    $h{def} = 1;
+}
+
+{
+    my %h;
+    ok(eval { tie %h, "SDBM_File", $dirname, O_RDWR, 0640, $pagname; 1 },
+       "open SDBM with explicit filenames");
+    is_deeply([ sort keys  %h] , [ qw(abc def) ], "should have two keys");
+}