diff --git a/Changes b/Changes index c79f34de9..736ea410c 100644 --- a/Changes +++ b/Changes @@ -3,6 +3,12 @@ Revision history for DBIx::Class * Fixes - Make sure Oracle identifier shortener applies to auto-generated column names, so we stay within the 30-char limit + - Fix a Storage/$dbh leak introduced by th migration to + Try::Tiny (this is *not* a Try::Tiny bug) + + * Misc + - Test suite default on-disk database now checks for Win32 + fail-conditions even when running on other OSes 0.08122 2010-05-03 17:41 (UTC) * New Features diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index fb2a7a27e..5156731a0 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -1166,7 +1166,9 @@ sub _connect { $DBI::connect_via = 'connect'; } - try { + # FIXME - this should have been Try::Tiny, but triggers a leak-bug in perl(!) + # related to coderef refcounting. A failing test has been submitted to T::T + my $connect_ok = eval { if(ref $info[0] eq 'CODE') { $dbh = $info[0]->(); } @@ -1195,14 +1197,17 @@ sub _connect { $dbh->{RaiseError} = 1; $dbh->{PrintError} = 0; } - } - catch { - $self->throw_exception("DBI Connection failed: $_") - } - finally { - $DBI::connect_via = $old_connect_via if $old_connect_via; + + 1; }; + my $possible_err = $@; + $DBI::connect_via = $old_connect_via if $old_connect_via; + + unless ($connect_ok) { + $self->throw_exception("DBI Connection failed: $possible_err") + } + $self->_dbh_autocommit($dbh->{AutoCommit}); $dbh; } diff --git a/t/52cycle.t b/t/52cycle.t index ba7fdd88a..b64be5c71 100644 --- a/t/52cycle.t +++ b/t/52cycle.t @@ -21,8 +21,18 @@ my $weak; { my $s = $weak->{schema} = DBICTest->init_schema; + ok ($s->storage->connected, 'we are connected'); memory_cycle_ok($s, 'No cycles in schema'); + my $storage = $weak->{storage} = $s->storage; + memory_cycle_ok($storage, 'No cycles in storage'); + + my $dbh = $weak->{dbh} = $s->storage->_get_dbh; + memory_cycle_ok($dbh, 'No cycles in DBI handle'); + + my $sqla = $weak->{sqla} = $s->storage->sql_maker; + memory_cycle_ok($sqla, 'No cycles in SQL maker'); + my $rs = $weak->{resultset} = $s->resultset ('Artist'); memory_cycle_ok($rs, 'No cycles in resultset'); diff --git a/t/lib/DBICTest.pm b/t/lib/DBICTest.pm index 80069617d..50bd6635a 100644 --- a/t/lib/DBICTest.pm +++ b/t/lib/DBICTest.pm @@ -5,6 +5,7 @@ use strict; use warnings; use DBICTest::AuthorCheck; use DBICTest::Schema; +use Carp; =head1 NAME @@ -65,19 +66,96 @@ sub _sqlite_dbname { sub _database { my $self = shift; my %args = @_; - my $db_file = $self->_sqlite_dbname(%args); - unlink($db_file) if -e $db_file; - unlink($db_file . "-journal") if -e $db_file . "-journal"; - mkdir("t/var") unless -d "t/var"; + if ($ENV{DBICTEST_DSN}) { + return ( + (map { $ENV{"DBICTEST_${_}"} || '' } qw/DSN DBUSER DBPASS/), + { AutoCommit => 1, %args }, + ); + } + my $db_file = $self->_sqlite_dbname(%args); - my $dsn = $ENV{"DBICTEST_DSN"} || "dbi:SQLite:${db_file}"; - my $dbuser = $ENV{"DBICTEST_DBUSER"} || ''; - my $dbpass = $ENV{"DBICTEST_DBPASS"} || ''; + for ($db_file, "${db_file}-journal") { + next unless -e $_; + unlink ($_) or carp ( + "Unable to unlink existing test database file $_ ($!), creation of fresh database / further tests may fail!\n" + ); + } - my @connect_info = ($dsn, $dbuser, $dbpass, { AutoCommit => 1, %args }); + mkdir("t/var") unless -d "t/var"; - return @connect_info; + return ("dbi:SQLite:${db_file}", '', '', { + AutoCommit => 1, + + # this is executed on every connect, and thus installs a disconnect/DESTROY + # guard for every new $dbh + on_connect_do => sub { + my $storage = shift; + my $dbh = $storage->_get_dbh; + + # no fsync on commit + $dbh->do ('PRAGMA synchronous = OFF'); + + # set a *DBI* disconnect callback, to make sure the physical SQLite + # file is still there (i.e. the test does not attempt to delete + # an open database, which fails on Win32) + if (-e $db_file and my $orig_inode = (stat($db_file))[1] ) { + + my $failed_once; + my $connected = 1; + my $cb = sub { + return if $failed_once; + + my $event = shift; + if ($event eq 'connect') { + # this is necessary in case we are disconnected and connected again, all within the same $dbh object + $connected = 1; + return; + } + elsif ($event eq 'disconnect') { + $connected = 0; + } + elsif ($event eq 'DESTROY' and ! $connected ) { + return; + } + + my $fail_reason; + if (! -e $db_file) { + $fail_reason = 'is missing'; + } + else { + my $cur_inode = (stat($db_file))[1]; + + $fail_reason ||= sprintf 'was recreated (inode %s vs %s)', ($orig_inode, $cur_inode) + if $orig_inode != $cur_inode; + } + + if ($fail_reason) { + $failed_once++; + + require Test::Builder; + my $t = Test::Builder->new; + local $Test::Builder::Level = $Test::Builder::Level + 1; + + $t->ok (0, + "$db_file $fail_reason before $event of DBI handle - a strong indicator that " + . 'the SQLite file was tampered with while still being open. This action would ' + . 'fail massively if running under Win32, hence DBICTest makes sure it fails ' + . 'on any OS :)' + ); + } + + return; # this empty return is a DBI requirement + }; + $dbh->{Callbacks} = { + connect => sub { $cb->('connect') }, + disconnect => sub { $cb->('disconnect') }, + DESTROY => sub { $cb->('DESTROY') }, + }; + } + }, + %args, + }); } sub init_schema { @@ -93,14 +171,15 @@ sub init_schema { } else { $schema = DBICTest::Schema->compose_namespace('DBICTest'); } + if( $args{storage_type}) { $schema->storage_type($args{storage_type}); } + if ( !$args{no_connect} ) { $schema = $schema->connect($self->_database(%args)); - $schema->storage->on_connect_do(['PRAGMA synchronous = OFF']) - unless $self->has_custom_dsn; } + if ( !$args{no_deploy} ) { __PACKAGE__->deploy_schema( $schema, $args{deploy_args} ); __PACKAGE__->populate_schema( $schema )