Implementing file-locking *control* in DBD::File

"H.Merijn Brand" <[email protected]>
Newsgroups gmane.comp.lang.perl.modules.dbi.sybase.devel
Message-ID <[email protected]>
Any objections to me committing below change?
--8<---
--- DBI-svn/lib/DBD/File.pm   2009-12-03 17:47:15.000000000 +0100
+++ DBI-svn/lib/DBD/File.pm   2009-12-03 17:49:20.000000000 +0100
@@ -162,6 +162,7 @@ sub connect ($$;$$$)
            f_ext       => 1, # file extension
            f_schema    => 1, # schema name
            f_tables    => 1, # base directory
+           f_lock      => 1, # Table locking mode
            };
         $this->{sql_valid_attrs} = {
            sql_handler           => 1, # Nano or S:S
@@ -725,12 +726,17 @@ sub open_table ($$$$$)
        }
     $fh and binmode $fh;
     if ($locking and $fh) {
-       if ($lockMode) {
+       my $lm = defined $data->{Database}{f_lock}
+                     && $data->{Database}{f_lock} =~ m/^[012]$/
+                      ? $data->{Database}{f_lock}
+                      : $lockMode ? 2 : 1;
+       if ($lm == 2) {
            flock $fh, 2 or croak "Cannot obtain exclusive lock on $file: $!";
            }
-       else {
+       elsif ($lm == 1) {
            flock $fh, 1 or croak "Cannot obtain shared lock on $file: $!";
            }
+       # $lm = 0 is forced no locking at all
        }
     my $columns = {};
     my $array   = [];
@@ -929,6 +935,29 @@ tables into the same (or no) schema:
 Defining f_schema to the empty string is equal to setting it to C<undef>,
 this to enable the DSN to be C<dbi:CSV:f_schema=;f_dir=.>.

+=item f_lock
+
+With this attribute, you can force locking mode (if locking is supported
+at all) for opening tables. By default, tables are opened with a shared
+lock for reading, and with an exclusive lock for writing. The supported
+modes are:
+
+=over 2
+
+=item 0
+
+Force no locking at all.
+
+=item 1
+
+Only shared locks will be used.
+
+=item 2
+
+Only exclusive locks will be used.
+
+=back
+
 =back

 =head2 Driver private methods
-->8---

-- 
H.Merijn Brand  http://tux.nl      Perl Monger  http://amsterdam.pm.org/
using & porting perl 5.6.2, 5.8.x, 5.10.x, 5.11.x on HP-UX 10.20, 11.00,
11.11, 11.23, and 11.31, OpenSuSE 10.3, 11.0, and 11.1, AIX 5.2 and 5.3.
http://mirrors.develooper.com/hpux/           http://www.test-smoke.org/
http://qa.perl.org      http://www.goldmark.org/jeff/stupid-disclaimers/
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.