X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Flib%2FDBICTest.pm;h=e4768a07b33fa040c06aeeba35aa0f217f3d07e5;hb=64d48e1989b06ff4cdb33eb7b16846d511168c64;hp=762abacdb79fa836d7b92dd84d988f964ea54569;hpb=08a8d8f1b8a69ea29bcceb9f399214943a34905c;p=dbsrgits%2FDBIx-Class-Historic.git diff --git a/t/lib/DBICTest.pm b/t/lib/DBICTest.pm index 762abac..e4768a0 100644 --- a/t/lib/DBICTest.pm +++ b/t/lib/DBICTest.pm @@ -27,14 +27,13 @@ BEGIN { use DBICTest::Util qw( - local_umask tmpdir await_flock + local_umask slurp_bytes tmpdir await_flock dbg DEBUG_TEST_CONCURRENCY_LOCKS PEEPEENESS ); use DBICTest::Util::LeakTracer qw/populate_weakregistry assert_empty_weakregistry/; use DBICTest::Schema; -use DBIx::Class::_Util qw( detected_reinvoked_destructor scope_guard ); +use DBIx::Class::_Util qw( detected_reinvoked_destructor scope_guard modver_gt_or_eq ); use Carp; -use Path::Class::File (); use Fcntl qw/:DEFAULT :flock/; use Config; @@ -152,36 +151,21 @@ sub import { } END { - # referencing here delays destruction even more - if ($global_lock_fh) { - DEBUG_TEST_CONCURRENCY_LOCKS > 1 - and dbg "Release @{[ $global_exclusive_lock ? 'EXCLUSIVE' : 'SHARED' ]} global lock (END)"; - 1; - } -} - -{ - my $dir = Path::Class::File->new(__FILE__)->dir->parent->subdir('var'); - $dir->mkpath unless -d "$dir"; - $dir = "$dir"; + # referencing here delays destruction even more + if ($global_lock_fh) { + DEBUG_TEST_CONCURRENCY_LOCKS > 1 + and dbg "Release @{[ $global_exclusive_lock ? 'EXCLUSIVE' : 'SHARED' ]} global lock (END)"; + 1; + } - sub _sqlite_dbfilename { - my $holder = $ENV{DBICTEST_LOCK_HOLDER} || $$; - $holder = $$ if $holder == -1; + _cleanup_dbfile(); +} - # useful for missing cleanup debugging - #if ( $holder == $$) { - # my $x = $0; - # $x =~ s/\//#/g; - # $holder .= "-$x"; - #} +sub _sqlite_dbfilename { + my $holder = $ENV{DBICTEST_LOCK_HOLDER} || $$; + $holder = $$ if $holder == -1; - return "$dir/DBIxClass-$holder.db"; - } - - END { - _cleanup_dbfile(); - } + return "t/var/DBIxClass-$holder.db"; } $SIG{INT} = sub { _cleanup_dbfile(); exit 1 }; @@ -390,8 +374,19 @@ sub init_schema { if ( !$args{no_connect} ) { $schema->connection(@dsn); - $schema->storage->connect_replicants(\@dsn) - if $ENV{DBICTEST_VIA_REPLICATED}; + if( $ENV{DBICTEST_VIA_REPLICATED} ) { + + # add explicit ReadOnly=1 if we can support it + $dsn[0] =~ /^dbi:SQLite:/i + and + require DBD::SQLite + and + modver_gt_or_eq('DBD::SQLite', '1.49_05') + and + $dsn[0] =~ s/^dbi:SQLite:/dbi:SQLite(ReadOnly=1):/i; + + $schema->storage->connect_replicants(\@dsn); + } } if ( !$args{no_deploy} ) { @@ -439,9 +434,7 @@ sub deploy_schema { if ($ENV{"DBICTEST_SQLT_DEPLOY"}) { $schema->deploy($args); } else { - my $filename = Path::Class::File->new(__FILE__)->dir - ->file('sqlite.sql')->stringify; - my $sql = do { local (@ARGV, $/) = $filename ; <> }; + my $sql = slurp_bytes( 't/lib/sqlite.sql' ); for my $chunk ( split (/;\s*\n+/, $sql) ) { if ( $chunk =~ / ^ (?! --\s* ) \S /xm ) { # there is some real sql in the chunk - a non-space at the start of the string which is not a comment $schema->storage->dbh_do(sub { $_[1]->do($chunk) }) or print "Error on SQL: $chunk\n";