[svn:dbi] r15455 - dbi/branches/sqlengine/lib/DBD

Author: REHSACK
Date: Fri Oct 26 08:29:37 2012
New Revision: 15455

Modified:
   dbi/branches/sqlengine/lib/DBD/File.pm

Log:
move flock check to DBD::File::DataSource::Stream and add one liner to query capability from derived classes

Modified: dbi/branches/sqlengine/lib/DBD/File.pm
==============================================================================
--- dbi/branches/sqlengine/lib/DBD/File.pm	(original)
+++ dbi/branches/sqlengine/lib/DBD/File.pm	Fri Oct 26 08:29:37 2012
@@ -401,6 +401,10 @@
 
 @DBD::File::DataSource::Stream::ISA = 'DBI::DBD::SqlEngine::DataSource';
 
+# We may have a working flock () built-in but that doesn't mean that locking
+# will work on NFS (flock () may hang hard)
+my $locking = eval { flock STDOUT, 0; 1 };
+
 use Carp;
 
 sub complete_table_name
@@ -442,7 +446,7 @@
     my ($self, $meta, $attrs, $flags) = @_;
 
     $flags->{dropMode} and croak "Can't drop a table in stream";
-    my $fn = "file handle " . fileno($meta->{fh});
+    my $fn = "file handle " . fileno($meta->{f_file});
 
     if ($flags->{createMode} || $flags->{lockMode}) {
 	$meta->{fh} = IO::Handle->new_from_fd( fileno($meta->{f_file} ), "w+" ) or
@@ -463,8 +467,24 @@
 	    binmode $meta->{fh} or croak "Failed to set binary mode on $fn: $!";
 	    }
 	} # have $meta->{$fh}
+
+    if ($self->can_flock && $meta->{fh}) {
+	my $lm = defined $flags->{f_lock}
+		      && $flags->{f_lock} =~ m/^[012]$/
+		       ? $flags->{f_lock}
+		       : $flags->{lockMode} ? 2 : 1;
+	if ($lm == 2) {
+	    flock $meta->{fh}, 2 or croak "Cannot obtain exclusive lock on $fn: $!";
+	    }
+	elsif ($lm == 1) {
+	    flock $meta->{fh}, 1 or croak "Cannot obtain shared lock on $fn: $!";
+	    }
+	# $lm = 0 is forced no locking at all
+	}
     } # open_data
 
+sub can_flock { $locking }
+
 package DBD::File::DataSource::File;
 
 use strict;
@@ -476,10 +496,6 @@
 
 my $fn_any_ext_regex = qr/\.[^.]*/;
 
-# We may have a working flock () built-in but that doesn't mean that locking
-# will work on NFS (flock () may hang hard)
-my $locking = eval { flock STDOUT, 0; 1 };
-
 sub complete_table_name
 {
     my ($self, $meta, $file, $respect_case, $file_is_table) = @_;
@@ -630,7 +646,7 @@
 	$meta->{lockfh} = $fh;
 	}
 
-    if ($locking && $fh) {
+    if ($self->can_flock && $fh) {
 	my $lm = defined $flags->{f_lock}
 		      && $flags->{f_lock} =~ m/^[012]$/
 		       ? $flags->{f_lock}