r25432 - in /branches/upstream/libdb-file-lock-perl: ./ current/ current/Changes current/Lock.pm current/MANIFEST current/Makefile.PL current/README current/db/ current/db/README current/test.pl
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Fri Sep 19 20:59:14 UTC 2008
Author: gregoa
Date: Fri Sep 19 20:59:11 2008
New Revision: 25432
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=25432
Log:
[svn-inject] Installing original source of libdb-file-lock-perl
Added:
branches/upstream/libdb-file-lock-perl/
branches/upstream/libdb-file-lock-perl/current/
branches/upstream/libdb-file-lock-perl/current/Changes
branches/upstream/libdb-file-lock-perl/current/Lock.pm
branches/upstream/libdb-file-lock-perl/current/MANIFEST
branches/upstream/libdb-file-lock-perl/current/Makefile.PL
branches/upstream/libdb-file-lock-perl/current/README
branches/upstream/libdb-file-lock-perl/current/db/
branches/upstream/libdb-file-lock-perl/current/db/README
branches/upstream/libdb-file-lock-perl/current/test.pl
Added: branches/upstream/libdb-file-lock-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdb-file-lock-perl/current/Changes?rev=25432&op=file
==============================================================================
--- branches/upstream/libdb-file-lock-perl/current/Changes (added)
+++ branches/upstream/libdb-file-lock-perl/current/Changes Fri Sep 19 20:59:11 2008
@@ -1,0 +1,45 @@
+Revision history for Perl extension DB_File::Lock.
+
+0.05 Tue Apr 9 15:14:43 EDT 2002
+ - removed use Carp qw(verbose) which was effecting other modules
+ - documentation improvements recommended by Stas Bekman <stas at stason.org>
+ - the documentation said we supported RECONO (tie for arrays) but
+ Shlomo Yona <Shlomo.Yona at Siftology.com> pointed out the implementation
+ did not support that. Added support for RECNO.
+ - added a warning when opening a database with write access and only
+ locking it for reading. This warning disabled for RECNO because RECNO
+ seems to require O_RDWR even when opening only for reading.
+ - added test of database creation failure
+ - added test of database access through object interface
+ - added test of RECNO database creation and usage
+
+0.04 Fri Aug 11 09:08:48 EDT 2000
+ - Three good fixes from Robert Mathews <rmathews at excitecorp.com>.
+ (Thanks to him for submitting a patch!) In his own words:
+ (1) The first one is nothing big: test 16 fails with BerkeleyDB
+ v1.85 on solaris 5.6. This seems to be due to the fact that
+ we're creating a database (and therefore writing to it),
+ but it's only read-locked.
+ (2) The second is that TIEHASH assumes that SUPER::TIEHASH
+ will succeed. If it doesn't, the lockfile gets left open,
+ and DESTROY is never called to close it.
+ (3) I ran into one other issue: umask isn't restored if sysopen
+ on the lockfile fails. Fixed that too.
+
+0.03 Wed Feb 2 11:06:08 EST 2000
+ - stupid me! version 0.02 didn't ship with a Makefile.PL, only a Makefile.old.
+ seems that I deleted the wrong file before taring up the archive after testing.
+ - Lock.pm didn't have $VERSION set correctly.
+
+0.02 Thu Jan 13 20:19:44 EST 2000
+ - much improved documentation
+ - much improved README
+ - added notes to other DB_File wrapper locking functions in POD and README
+ - fixed some incorrect assumptions about flock(2) in test.pl that ended
+ up being wrong on both Solaris and HP-UX and caused two tests to fail.
+
+0.01 Sat Jan 1 23:39:30 EST 2000
+ - original version; created by h2xs 1.19
+ - based on origional DB_Lock from http://www.davideous.com/misc/DB_Wrap.pm
+ and some helpful insight from Stas Bekman <stas at stason.org>.
+
Added: branches/upstream/libdb-file-lock-perl/current/Lock.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdb-file-lock-perl/current/Lock.pm?rev=25432&op=file
==============================================================================
--- branches/upstream/libdb-file-lock-perl/current/Lock.pm (added)
+++ branches/upstream/libdb-file-lock-perl/current/Lock.pm Fri Sep 19 20:59:11 2008
@@ -1,0 +1,364 @@
+#
+# DB_File::Lock
+#
+# by David Harris <dharris at drh.net>
+#
+# Copyright (c) 1999-2000 David R. Harris. All rights reserved.
+# This program is free software; you can redistribute it and/or modify it
+# under the same terms as Perl itself.
+#
+
+package DB_File::Lock;
+
+require 5.004;
+
+use strict;
+use vars qw($VERSION @ISA $locks);
+
+ at ISA = qw(DB_File);
+$VERSION = '0.05';
+
+use DB_File ();
+use Fcntl qw(:flock O_RDWR O_RDONLY O_WRONLY O_CREAT);
+use Carp qw(croak carp);
+use Symbol ();
+
+# import function can't be inherited, so this magic required
+sub import
+{
+ my $ourname = shift;
+ my @imports = @_; # dynamic scoped var, still in scope after package call in eval
+ my $module = caller;
+ my $calling = $ISA[0];
+ eval " package $module; import $calling, \@imports; ";
+}
+
+sub _lock_and_tie
+{
+ my $package = shift;
+
+ ## Grab the type of tie
+
+ my $tie_type = pop @_;
+
+ ## There are two ways of passing data defined by DB_File
+
+ my $lock_data;
+ my @dbfile_data;
+
+ if ( @_ == 5 ) {
+ $lock_data = pop @_;
+ @dbfile_data = @_;
+ } elsif ( @_ == 2 ) {
+ $lock_data = pop @_;
+ @dbfile_data = @{$_[0]};
+ } else {
+ croak "invalid number of arguments";
+ }
+
+ ## Decipher the lock_data
+
+ my $mode;
+ my $nonblocking = 0;
+ my $lockfile_name = $dbfile_data[0] . ".lock";
+ my $lockfile_mode;
+
+ if ( lc($lock_data) eq "read" ) {
+ $mode = "read";
+ } elsif ( lc($lock_data) eq "write" ) {
+ $mode = "write";
+ } elsif ( ref($lock_data) eq "HASH" ) {
+ $mode = lc $lock_data->{mode};
+ croak "invalid mode ($mode)" if ( $mode ne "read" and $mode ne "write" );
+ $nonblocking = $lock_data->{nonblocking};
+ $lockfile_name = $lock_data->{lockfile_name} if ( defined $lock_data->{lockfile_name} );
+ $lockfile_mode = $lock_data->{lockfile_mode};
+ } else {
+ croak "invalid lock_data ($lock_data)";
+ }
+
+ ## Warn about opening a lockfile for writing when only locking for reading
+
+ # NOTE: This warning disabled for RECNO because RECNO seems to require O_RDWR
+ # even when opening only for reading.
+
+ carp "opening with write access when locking only for reading (use O_RDONLY to fix)"
+ if (
+ ( $dbfile_data[1] && O_RDWR or $dbfile_data[1] && O_WRONLY ) # any kind of write access
+ and $mode eq "read" # and opening for reading
+ and $tie_type ne "TIEARRAY" # and not RECNO
+ );
+
+ ## Determine the mode of the lockfile, if not given
+
+ # THEORY: if someone can read or write the database file, we must allow
+ # them to read and write the lockfile.
+
+ if ( not defined $lockfile_mode ) {
+ $lockfile_mode = 0600; # we must be allowed to read/write lockfile
+ $lockfile_mode |= 0060 if ( $dbfile_data[2] & 0060 );
+ $lockfile_mode |= 0006 if ( $dbfile_data[2] & 0006 );
+ }
+
+ ## Open the lockfile, lock it, and open the database
+
+ my $lockfile_fh = Symbol::gensym();
+ my $saved_umask = umask(0000) if ( umask() & $lockfile_mode );
+ my $open_ok = sysopen($lockfile_fh, $lockfile_name, O_RDWR|O_CREAT,
+ $lockfile_mode);
+ umask($saved_umask) if ( defined $saved_umask );
+ $open_ok or croak "could not open lockfile ($lockfile_name)";
+
+ my $flock_flags = ($mode eq "write" ? LOCK_EX : LOCK_SH) | ($nonblocking ? LOCK_NB : 0);
+ if ( not flock $lockfile_fh, $flock_flags ) {
+ close $lockfile_fh;
+ return undef if ( $nonblocking );
+ croak "could not flock lockfile";
+ }
+
+ my $self = $tie_type eq "TIEHASH"
+ ? $package->SUPER::TIEHASH(@_)
+ : $package->SUPER::TIEARRAY(@_);
+ if ( not $self ) {
+ close $lockfile_fh;
+ return $self;
+ }
+
+ ## Store the info for the DESTROY function
+
+ my $id = "" . $self;
+ $id =~ s/^[^=]+=//; # remove the package name in case re-blessing occurs
+ $locks->{$id} = $lockfile_fh;
+
+ ## Return the object
+
+ return $self;
+}
+
+sub TIEHASH
+{
+ return _lock_and_tie(@_, 'TIEHASH');
+}
+
+sub TIEARRAY
+{
+ return _lock_and_tie(@_, 'TIEARRAY');
+}
+
+sub DESTROY
+{
+ my $self = shift;
+
+ my $id = "" . $self;
+ $id =~ s/^[^=]+=//;
+ my $lockfile_fh = $locks->{$id};
+ delete $locks->{$id};
+
+ $self->SUPER::DESTROY(@_);
+
+ # un-flock not needed, as we close here
+ close $lockfile_fh;
+}
+
+
+
+
+
+1;
+__END__
+
+=head1 NAME
+
+DB_File::Lock - Locking with flock wrapper for DB_File
+
+=head1 SYNOPSIS
+
+ use DB_File::Lock;
+ use Fcntl qw(:flock O_RDWR O_CREAT);
+
+ $locking = "read";
+ $locking = "write";
+ $locking = {
+ mode => "read",
+ nonblocking => 0,
+ lockfile_name => "/path/to/shared.lock",
+ lockfile_mode => 0600,
+ };
+
+ [$X =] tie %hash, 'DB_File::Lock', $filename, $flags, $mode, $DB_HASH, $locking;
+ [$X =] tie %hash, 'DB_File::Lock', $filename, $flags, $mode, $DB_BTREE, $locking;
+ [$X =] tie @array, 'DB_File::Lock', $filename, $flags, $mode, $DB_RECNO, $locking;
+
+ # or place the DB_File arguments inside a list reference:
+ [$X =] tie %hash, 'DB_File::Lock', [$filename, $flags, $mode, $DB_HASH], $locking;
+
+ ...use the same way as DB_File for the rest of the interface...
+
+=head1 DESCRIPTION
+
+This module provides a wrapper for the DB_File module, adding locking.
+
+When you need locking, simply use this module in place of DB_File and
+add an extra argument onto the tie command specifying if the file should
+be locked for reading or writing.
+
+The alternative is to write code like:
+
+ open(LOCK, "<$db_filename.lock") or die;
+ flock(LOCK, LOCK_SH) or die;
+ tie(%db_hash, 'DB_File', $db_filename, O_RDONLY, 0600, $DB_HASH) or die;
+ ... then read the database ...
+ untie(%db_hash);
+ close(LOCK);
+
+This module lets you write
+
+ tie(%db_hash, 'DB_File::Lock', $db_filename, O_RDONLY, 0600, $DB_HASH, 'read') or die;
+ ... then read the database ...
+ untie(%db_hash);
+
+This is better for two reasons:
+
+(1) Less cumbersome to write.
+
+(2) A fatal exception in the code working on the database which does
+not lead to process termination will probably not close the lockfile
+and therefore cause a dropped lock.
+
+=head1 USAGE DETAILS
+
+Tie to the database file by adding an additional locking argument
+to the list of arguments to be passed through to DB_File, such as:
+
+ tie(%db_hash, 'DB_File::Lock', $db_filename, O_RDONLY, 0600, $DB_HASH, 'read');
+
+or enclose the arguments for DB_File in a list reference:
+
+ tie(%db_hash, 'DB_File::Lock', [$db_filename, O_RDONLY, 0600, $DB_HASH], 'read');
+
+The filename used for the lockfile defaults to "$filename.lock"
+(the filename of the DB_File with ".lock" appended). Using a lockfile
+separate from the database file is recommended because it prevents weird
+interactions with the underlying database file library
+
+The additional locking argument added to the tie call can be:
+
+(1) "read" -- acquires a shared lock for reading
+
+(2) "write" -- acquires an exclusive lock for writing
+
+(3) A hash with the following keys (all optional except for the "mode"):
+
+=over 4
+
+=item mode
+
+the locking mode, "read" or "write".
+
+=item lockfile_name
+
+specifies the name of the lockfile to use. Default
+is "$filename.lock". This is useful for locking multiple resources with
+the same lockfiles.
+
+=item nonblocking
+
+determines if the flock call on the lockfile should
+block waiting for a lock, or if it should return failure if a lock can
+not be immediately attained. If "nonblocking" is set and a lock can not
+be attained, the tie command will fail. Currently, I'm not sure how to
+differentiate this between a failure form the DB_File layer.
+
+=item lockfile_mode
+
+determines the mode for the sysopen call in opening
+the lockfile. The default mode will be formulated to allow anyone that
+can read or write the DB_File permission to read and write the lockfile.
+(This is because some systems may require that one have write access to
+a file to lock it for reading, I understand.) The umask will be prevented
+from applying to this mode.
+
+=back
+
+Note: One may import the same values from DB_File::Lock as one may import
+from DB_File.
+
+=head1 GOOD LOCKING ETIQUETTE
+
+To avoid locking problems, realize that it is B<critical> that you release
+the lock as soon as possible. See the lock as a "hot potato", something
+that you must work with and get rid of as quickly as possible. See the
+sections of code where you have a lock as "critical" sections. Make sure
+that you call "untie" as soon as possible.
+
+It is often better to write:
+
+ # open database file with lock
+ # work with database
+ # lots of processing not related to database
+ # work with database
+ # close database and release lock
+
+as:
+
+ # open database file with lock
+ # work with database
+ # close database and release lock
+
+ # lots of processing not related to database
+
+ # open database file with lock
+ # work with database
+ # close database and release lock
+
+Also realize that when acquiring two locks at the same time, a deadlock
+situation can be caused.
+
+You can enter a deadlock situation if two processes simultaneously try to
+acquire locks on two separate databases. Each has locked only one of
+the databases, and cannot continue without locking the second. Yet this
+will never be freed because it is locked by the other process. If your
+processes all ask for their DB files in the same order, this situation
+cannot occur.
+
+=head1 OTHER LOCKING MODULES
+
+There are three locking wrappers for DB_File in CPAN right now. Each one
+implements locking differently and has different goals in mind. It is
+therefore worth knowing the difference, so that you can pick the right
+one for your application.
+
+Here are the three locking wrappers:
+
+Tie::DB_Lock -- DB_File wrapper which creates copies of the database file
+for read access, so that you have kind of a multiversioning concurrent
+read system. However, updates are still serial. Use for databases where
+reads may be lengthy and consistency problems may occur.
+
+Tie::DB_LockFile -- DB_File wrapper that has the ability to lock and
+unlock the database while it is being used. Avoids the tie-before-flock
+problem by simply re-tie-ing the database when you get or drop a
+lock. Because of the flexibility in dropping and re-acquiring the lock
+in the middle of a session, this can be massaged into a system that will
+work with long updates and/or reads if the application follows the hints
+in the POD documentation.
+
+DB_File::Lock (this module) -- extremely lightweight DB_File wrapper
+that simply flocks a lockfile before tie-ing the database and drops the
+lock after the untie. Allows one to use the same lockfile for multiple
+databases to avoid deadlock problems, if desired. Use for databases where
+updates are reads are quick and simple flock locking semantics are enough.
+
+(This text duplicated in the POD documentation, by the way.)
+
+=head1 AUTHOR
+
+David Harris <dharris at drh.net>
+
+Helpful insight from Stas Bekman <stas at stason.org>
+
+=head1 SEE ALSO
+
+DB_File(3).
+
+=cut
Added: branches/upstream/libdb-file-lock-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdb-file-lock-perl/current/MANIFEST?rev=25432&op=file
==============================================================================
--- branches/upstream/libdb-file-lock-perl/current/MANIFEST (added)
+++ branches/upstream/libdb-file-lock-perl/current/MANIFEST Fri Sep 19 20:59:11 2008
@@ -1,0 +1,7 @@
+Changes
+Lock.pm
+MANIFEST
+Makefile.PL
+README
+db/README
+test.pl
Added: branches/upstream/libdb-file-lock-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdb-file-lock-perl/current/Makefile.PL?rev=25432&op=file
==============================================================================
--- branches/upstream/libdb-file-lock-perl/current/Makefile.PL (added)
+++ branches/upstream/libdb-file-lock-perl/current/Makefile.PL Fri Sep 19 20:59:11 2008
@@ -1,0 +1,7 @@
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ 'NAME' => 'DB_File::Lock',
+ 'VERSION_FROM' => 'Lock.pm', # finds $VERSION
+);
Added: branches/upstream/libdb-file-lock-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdb-file-lock-perl/current/README?rev=25432&op=file
==============================================================================
--- branches/upstream/libdb-file-lock-perl/current/README (added)
+++ branches/upstream/libdb-file-lock-perl/current/README Fri Sep 19 20:59:11 2008
@@ -1,0 +1,122 @@
+
+README
+
+DB_File::Lock version 0.05
+by David Harris <dharris at drh.net>
+
+
+ -- WHAT DOES THIS MODULE DO?
+
+This module provides a wrapper for the DB_File module, adding locking.
+
+When you need locking, simply use this module in place of DB_File and
+add an extra argument onto the tie command specifying if the file should
+be locked for reading or writing.
+
+The alternative is to write code like:
+
+ open(LOCK, "<$db_filename.lock") or die;
+ flock(LOCK, LOCK_SH) or die;
+ tie(%db_hash, 'DB_File', $db_filename, O_RDONLY, 0600, $DB_HASH) or die;
+ ... then read the database ...
+ untie(%db_hash);
+ close(LOCK);
+
+This module lets you write
+
+ tie(%db_hash, 'DB_File', $db_filename, O_RDONLY, 0600, $DB_HASH, 'read') or die;
+ ... then read the database ...
+ untie(%db_hash);
+
+This is better for two reasons:
+
+(1) Less cumbersome to write.
+
+(2) A fatal exception in the code working on the database which does
+not lead to process termination will probably not close the lockfile
+and therefore cause a dropped lock.
+
+
+ -- WHY MIGHT ONE NEED A LOCKING WRAPPER MODULE?
+
+There can be many reasons:
+
+(1) You have an application which is going to modify a DB_File database
+and it's possible that multiple instances of the application will be run
+at the same time. If you don't do locking then you can easily corrupt
+the database file.
+
+ (a) You get tired of writing your locking code manually and want it
+ handled for you by a nice module. You know, it's kind of cumbersome
+ writing all that stuff out. :-)
+
+ (b) You are running in an environment (such as mod_perl or code which
+ may be inside an eval { .. } error trapper) where your code may be
+ interrupted by a fatal error and not immediately lead to process
+ termination. This can cause dropped locks.
+
+ (c) You are using $db->fd to lock the database _AFTER_ you have
+ tied the database. This fatally flawed and does lead to database
+ corruption. (This method was promoted in the old DB_File docs and in the
+ Camel book.) See the ``Why you shouldn't use "fd" to lock a database''
+ section in the new DB_File docs.
+
+ (d) You have thought of some reason I have not. :-)
+
+(2) You are using mod_perl. This ends the discussion right there --
+it is _imperative_ to use a DB_File locking wrapper with mod_perl. See
+http://perl.apache.org/guide/dbm.html#mod_perl_and_dbm for more info.
+
+
+ -- IS THIS THE CORRECT LOCKING WRAPPER FOR MY APPLICATION?
+
+There are three locking wrappers for DB_File in CPAN right now. Each one
+implements locking differently and has different goals in mind. It is
+therefore worth knowing the difference, so that you can pick the right
+one for your application.
+
+Here are the three locking wrappers:
+
+Tie::DB_Lock -- DB_File wrapper which creates copies of the database file
+for read access, so that you have kind of a multiversioning concurrent
+read system. However, updates are still serial. Use for databases where
+reads may be lengthy and consistency problems may occur.
+
+Tie::DB_LockFile -- DB_File wrapper that has the ability to lock and
+unlock the database while it is being used. Avoids the tie-before-flock
+problem by simply re-tie-ing the database when you get or drop a
+lock. Because of the flexibility in dropping and re-acquiring the lock
+in the middle of a session, this can be massaged into a system that will
+work with long updates and/or reads if the application follows the hints
+in the POD documentation.
+
+DB_File::Lock (this module) -- extremely lightweight DB_File wrapper
+that simply flocks a lockfile before tie-ing the database and drops the
+lock after the untie. Allows one to use the same lockfile for multiple
+databases to avoid deadlock problems, if desired. Use for databases where
+updates are reads are quick and simple flock locking semantics are enough.
+
+(This text duplicated in the POD documentation, by the way.)
+
+
+ -- INSTALL
+
+To install the module, do the usual:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+
+The test files in this module require a valid fork command. If your
+platform does not have fork(2), then please accept failures on the
+test phase of this module.
+
+
+___________________
+
+Copyright (c) 1999-2000 David R. Harris. All rights reserved.
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
Added: branches/upstream/libdb-file-lock-perl/current/db/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdb-file-lock-perl/current/db/README?rev=25432&op=file
==============================================================================
--- branches/upstream/libdb-file-lock-perl/current/db/README (added)
+++ branches/upstream/libdb-file-lock-perl/current/db/README Fri Sep 19 20:59:11 2008
@@ -1,0 +1,2 @@
+This directory is for the temporary database
+files created by test.pl
Added: branches/upstream/libdb-file-lock-perl/current/test.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdb-file-lock-perl/current/test.pl?rev=25432&op=file
==============================================================================
--- branches/upstream/libdb-file-lock-perl/current/test.pl (added)
+++ branches/upstream/libdb-file-lock-perl/current/test.pl Fri Sep 19 20:59:11 2008
@@ -1,0 +1,120 @@
+#!/usr/bin/perl -w
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+
+BEGIN { $| = 1; print "1..40\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use DB_File::Lock qw( $DB_HASH $DB_RECNO );
+use Fcntl qw ( O_CREAT O_RDONLY O_RDWR );
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# Insert your test code below (better if it prints "ok 13"
+# (correspondingly "not ok 13") depending on the success of chunk 13
+# of the test code):
+
+my $TEST_NUM = 2;
+
+sub report_result {
+ print ( $_[0] ? "ok $TEST_NUM\n" : "not ok $TEST_NUM\n" );
+ if ($ENV{TEST_VERBOSE} and not $_[0]) { print "Error is '$!'\n" }
+ $TEST_NUM++;
+}
+
+sub permissions_of_file { return (stat(shift))[2] & 0777 }
+
+my $file1 = 'db/db1';
+my $file2 = 'db/db2';
+my $file1_lock = $file1 . ".lock";
+my $file2_lock = $file2 . ".lock";
+unlink $file1;
+unlink $file2;
+unlink $file1_lock;
+unlink $file2_lock;
+
+## 2: Check if the export worked
+report_result( O_CREAT != 0 );
+
+## 3-6: Create a simple database and test permissions
+report_result( tie %hash1, 'DB_File::Lock', $file1, O_CREAT|O_RDWR, 0600, $DB_HASH, "write" );
+report_result( permissions_of_file($file1_lock) == 0600 );
+report_result( untie %hash1 );
+report_result( unlink($file1) and unlink($file1_lock) );
+
+## 7-10: Create a simple database and test permissions again
+report_result( tie %hash1, 'DB_File::Lock', $file1, O_CREAT|O_RDWR, 0664, $DB_HASH, "write" );
+report_result( permissions_of_file($file1_lock) == 0666 );
+report_result( untie %hash1 );
+report_result( unlink($file1) and unlink($file1_lock) );
+
+## 11-14: Test the lockfile_name and lockfile_mode options
+report_result( tie %hash1, 'DB_File::Lock', $file1, O_CREAT|O_RDWR, 0664, $DB_HASH,
+ { mode => "write", lockfile_name => $file2_lock, lockfile_mode => 0623 } );
+report_result( permissions_of_file($file2_lock) == 0623 );
+report_result( untie %hash1 );
+report_result( unlink($file1) and unlink($file2_lock) );
+
+## 15-22: See that flock is really getting called
+my $nonblock_write = { mode => "write", nonblocking => 1 };
+my $nonblock_read = { mode => "read", nonblocking => 1 };
+tie %hash1, 'DB_File::Lock', $file1, O_CREAT|O_RDWR, 0600, $DB_HASH, $nonblock_write; # create the DB file
+untie %hash1;
+my $pid = fork();
+if ( not defined $pid ) {
+ print STDERR "fork failed: skipping tests 15-22\n";
+ $TEST_NUM += 9;
+} elsif ( not $pid ) { # child
+ report_result( tie %hash1, 'DB_File::Lock', $file1, O_RDONLY, 0600, $DB_HASH, $nonblock_read );
+ report_result( tie %hash2, 'DB_File::Lock', $file1, O_RDONLY, 0600, $DB_HASH, $nonblock_read );
+ sleep(3);
+ $TEST_NUM += 2;
+ report_result( untie %hash1 and untie %hash2 );
+ exit(0);
+} else { # parent
+ sleep(1);
+ $TEST_NUM += 2;
+ report_result( not tie %hash3, 'DB_File::Lock', $file1, O_RDWR, 0600, $DB_HASH, $nonblock_write );
+ report_result( not defined %hash3 ); # double check and satisfy -w about %hash3
+ $TEST_NUM += 1;
+ report_result( wait() == $pid );
+ report_result( tie %hash3, 'DB_File::Lock', $file1, O_RDWR, 0600, $DB_HASH, $nonblock_write );
+ report_result( untie %hash3 );
+ report_result( unlink($file1) and unlink($file1_lock) );
+}
+
+## 24-30: See that data can really be written
+report_result( $X = tie %hash1, 'DB_File::Lock', $file1, O_CREAT|O_RDWR, 0600, $DB_HASH, $nonblock_write );
+$hash1{a} = 1;
+$X->put("b", 2);
+undef $X;
+report_result( $hash1{a} == 1 and $hash1{b} == 2 );
+report_result( untie %hash1 );
+report_result( tie %hash2, 'DB_File::Lock', $file1, O_RDONLY, 0600, $DB_HASH, $nonblock_read );
+report_result( $hash2{a} == 1 and $hash2{b} == 2 );
+report_result( untie %hash2 );
+report_result( unlink($file1) and unlink($file1_lock) );
+
+## 31-37: Check to see that RECNO support works
+report_result( tie @array1, 'DB_File::Lock', $file1, O_CREAT|O_RDWR, 0600, $DB_RECNO, $nonblock_write );
+ at array1 = (1, 2, 3, 4, 5);
+push(@array1, 6, 7, 8);
+report_result( join(":", at array1) eq "1:2:3:4:5:6:7:8" );
+report_result( untie @array1 );
+report_result( tie @array2, 'DB_File::Lock', $file1, O_RDWR, 0600, $DB_RECNO, $nonblock_read );
+report_result( join(":", at array2) eq "1:2:3:4:5:6:7:8" );
+report_result( untie @array2 );
+report_result( unlink($file1) and unlink($file1_lock) );
+
+## 38-40: Check to see that open failures are reported correctly
+report_result( not tie %hash1, 'DB_File::Lock', $file1, O_RDWR, 0600, $DB_HASH, $nonblock_write );
+report_result( untie %hash1 );
+report_result( ! unlink($file1) and unlink($file1_lock) );
+
+
More information about the Pkg-perl-cvs-commits
mailing list