X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FSQLite.pm;h=28cadaac3fa9adf83703b5d87b2d969426b4e683;hb=f0c2d11fdca96cbd78a572dba40d33a229ee0b9e;hp=ca21607336392957b48bfa643528de1e00522c33;hpb=08ac7648665ed86e88b2a752b31e8a34a8552dc7;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI/SQLite.pm b/lib/DBIx/Class/Storage/DBI/SQLite.pm index ca21607..28cadaa 100644 --- a/lib/DBIx/Class/Storage/DBI/SQLite.pm +++ b/lib/DBIx/Class/Storage/DBI/SQLite.pm @@ -7,7 +7,7 @@ use base qw/DBIx::Class::Storage::DBI/; use mro 'c3'; use SQL::Abstract 'is_plain_value'; -use DBIx::Class::_Util qw(modver_gt_or_eq sigwarn_silencer); +use DBIx::Class::_Util qw(modver_gt_or_eq sigwarn_silencer dbic_internal_try); use DBIx::Class::Carp; use Try::Tiny; use namespace::clean; @@ -61,14 +61,9 @@ stringifiable object. Even if you upgrade DBIx::Class (which works around the bug starting from version 0.08210) you may still have corrupted/incorrect data in your database. -DBIx::Class will currently detect when this condition (more than one -stringifiable object in one CRUD call) is encountered and will issue a warning -pointing to this section. This warning will be removed 2 years from now, -around April 2015, You can disable it after you've audited your data by -setting the C environment variable. Note - the warning -is emitted only once per callsite per process and only when the condition in -question is encountered. Thus it is very unlikely that your logsystem will be -flooded as a result of this. +DBIx::Class warned about this condition for several years, hoping to give +anyone affected sufficient notice of the potential issues. The warning was +removed in 2015/v0.082820. =back @@ -128,22 +123,17 @@ sub _exec_svp_rollback { my ($self, $name) = @_; $self->_dbh->do("ROLLBACK TO SAVEPOINT $name"); -} - -# older SQLite has issues here too - both of these are in fact -# completely benign warnings (or at least so say the tests) -sub _exec_txn_rollback { - local $SIG{__WARN__} = sigwarn_silencer( qr/rollback ineffective/ ) - unless $DBD::SQLite::__DBIC_TXN_SYNC_SANE__; - - shift->next::method(@_); -} - -sub _exec_txn_commit { - local $SIG{__WARN__} = sigwarn_silencer( qr/commit ineffective/ ) - unless $DBD::SQLite::__DBIC_TXN_SYNC_SANE__; - shift->next::method(@_); + # resync state for older DBD::SQLite (RT#67843) + # https://github.com/DBD-SQLite/DBD-SQLite/commit/9b3cdbf + if ( + ! modver_gt_or_eq('DBD::SQLite', '1.33') + and + $self->_dbh->FETCH('AutoCommit') + ) { + $self->_dbh->STORE('AutoCommit', 0); + $self->_dbh->STORE('BegunWork', 1); + } } sub _ping { @@ -173,26 +163,29 @@ sub _ping { unless ($DBD::SQLite::__DBIC_TXN_SYNC_SANE__) { # 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 $@; + + my $really_not_in_txn; + + # not assigning RV directly to env above, because this causes a bizarre + # leak of the catch{} cref on older perls... wtf + dbic_internal_try { # 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 - ; - }; + # + # will fail instantly if already in a txn + $dbh->do("-- multiline\nBEGIN"); + $dbh->do("-- multiline\nCOMMIT"); + + $really_not_in_txn = 1; + } + catch { + $really_not_in_txn = ( $_[0] =~ qr/transaction within a transaction/ + ? 0 + : undef + ); }; # if we were unable to determine this - we may very well be dead @@ -217,7 +210,7 @@ sub _ping { } # do the actual test and return on no failure - ( $ping_fail ||= ! try { $dbh->do('SELECT * FROM sqlite_master LIMIT 1'); 1 } ) + ( $ping_fail ||= ! dbic_internal_try { $dbh->do('SELECT * FROM sqlite_master LIMIT 1'); 1 } ) or return 1; # the actual RV of _ping() # ping failed (or so it seems) - need to do some cleanup @@ -226,8 +219,7 @@ sub _ping { # 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 clobber the real error as set above - eval { $dbh->disconnect }; # if it fails - it fails + dbic_internal_try { $dbh->disconnect }; # if it fails - it fails undef; # the actual RV of _ping() } @@ -317,14 +309,7 @@ sub _dbi_attrs_for_bind { = modver_gt_or_eq('DBD::SQLite', '1.37') ? 1 : 0; } - # an attempt to detect former effects of RT#79576, bug itself present between - # 0.08191 and 0.08209 inclusive (fixed in 0.08210 and higher) - my $stringifiable = 0; - for my $i (0.. $#$bindattrs) { - - $stringifiable++ if ( length ref $bind->[$i][1] and is_plain_value($bind->[$i][1]) ); - if ( defined $bindattrs->[$i] and @@ -367,14 +352,6 @@ sub _dbi_attrs_for_bind { } } - carp_unique( - 'POSSIBLE *PAST* DATA CORRUPTION detected - see ' - . 'DBIx::Class::Storage::DBI::SQLite/RT79576 or ' - . 'http://v.gd/DBIC_SQLite_RT79576 for further details or set ' - . '$ENV{DBIC_RT79576_NOWARN} to disable this warning. Trigger ' - . 'condition encountered' - ) if (!$ENV{DBIC_RT79576_NOWARN} and $stringifiable > 1); - return $bindattrs; } @@ -403,14 +380,17 @@ sub connect_call_use_foreign_keys { ); } -1; - -=head1 AUTHOR AND CONTRIBUTORS +=head1 FURTHER QUESTIONS? -See L and L in DBIx::Class +Check the list of L. -=head1 LICENSE +=head1 COPYRIGHT AND LICENSE -You may distribute this code under the same terms as Perl itself. +This module is free software L +by the L. You can +redistribute it and/or modify it under the same terms as the +L. =cut + +1;