X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FSQLite.pm;h=846f23aacb81a9af2caf0f692900fec0d701b1c0;hb=2aeb3c7f;hp=309767f01462bcf71d6d45913cf12761f761511b;hpb=2e0924422e40d5a054b74c6db93af0d48da758ec;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/Storage/DBI/SQLite.pm b/lib/DBIx/Class/Storage/DBI/SQLite.pm
index 309767f..846f23a 100644
--- a/lib/DBIx/Class/Storage/DBI/SQLite.pm
+++ b/lib/DBIx/Class/Storage/DBI/SQLite.pm
@@ -94,7 +94,82 @@ sub _exec_svp_rollback {
 
 sub _ping {
   my $self = shift;
-  try { $self->_dbh->do('SELECT * FROM sqlite_master LIMIT 1'); 1 };
+
+  # Be extremely careful what we do here. SQLite is notoriously bad at
+  # synchronizing its internal transaction state with {AutoCommit}
+  # https://metacpan.org/source/ADAMK/DBD-SQLite-1.37/lib/DBD/SQLite.pm#L921
+  # There is a function http://www.sqlite.org/c3ref/get_autocommit.html
+  # but DBD::SQLite does not expose it (nor does it seem to properly use it)
+
+  # Therefore only execute a "ping" when we have no other choice *AND*
+  # scrutinize the thrown exceptions to make sure we are where we think we are
+  my $dbh = $self->_dbh or return undef;
+  return undef unless $dbh->FETCH('Active');
+  return undef unless $dbh->ping;
+
+  # since we do not have access to sqlite3_get_autocommit(), do a trick
+  # to attempt to *safely* determine what state are we *actually* in.
+  # FIXME
+  # also using T::T here leads to bizarre leaks - will figure it out later
+  my $really_not_in_txn = do {
+    local $@;
+
+    # older versions of DBD::SQLite do not properly detect multiline BEGIN/COMMIT
+    # statements to adjust their {AutoCommit} state. Hence use such a statement
+    # pair here as well, in order to escape from poking {AutoCommit} needlessly
+    # https://rt.cpan.org/Public/Bug/Display.html?id=80087
+    eval {
+      # will fail instantly if already in a txn
+      $dbh->do("-- multiline\nBEGIN");
+      $dbh->do("-- multiline\nCOMMIT");
+      1;
+    } or do {
+      ($@ =~ /transaction within a transaction/)
+        ? 0
+        : undef
+      ;
+    };
+  };
+
+  my $ping_fail;
+
+  # if we were unable to determine this - we may very well be dead
+  if (not defined $really_not_in_txn) {
+    $ping_fail = 1;
+  }
+  # check the AC sync-state
+  elsif ($really_not_in_txn xor $dbh->{AutoCommit}) {
+    carp_unique (sprintf
+      'Internal transaction state of handle %s (apparently %s a transaction) does not seem to '
+    . 'match its AutoCommit attribute setting of %s - this is an indication of a '
+    . 'potentially serious bug in your transaction handling logic',
+      $dbh,
+      $really_not_in_txn ? 'NOT in' : 'in',
+      $dbh->{AutoCommit} ? 'TRUE' : 'FALSE',
+    );
+
+    # it is too dangerous to execute anything else in this state
+    # assume everything works (safer - worst case scenario next statement throws)
+    return 1;
+  }
+  else {
+    # do the actual test
+    $ping_fail = ! try { $dbh->do('SELECT * FROM sqlite_master LIMIT 1'); 1 };
+  }
+
+  if ($ping_fail) {
+    # it is possible to have a proper "connection", and have "ping" return
+    # false anyway (e.g. corrupted file). In such cases DBD::SQLite still
+    # keeps the actual file handle open. We don't really want this to happen,
+    # so force-close the handle via DBI itself
+    #
+    local $@; # so that we do not clober the real error as set above
+    eval { $dbh->disconnect }; # if it fails - it fails
+    return undef # the actual RV of _ping()
+  }
+  else {
+    return 1;
+  }
 }
 
 sub deployment_statements {