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/

Reply via email to