X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Flib%2FDBICTest.pm;h=c69d229f6c8a809c6dd32add26c5b67f37fb0fe8;hb=def17c59d7cf96fccfb7b89ee150f14f38153f24;hp=8252eccaa7cc8a56c30b3f33e0620185961fe159;hpb=8871d4ad1ce3afa80338d355a21ba28d9b4a46ca;p=dbsrgits%2FDBIx-Class.git diff --git a/t/lib/DBICTest.pm b/t/lib/DBICTest.pm old mode 100755 new mode 100644 index 8252ecc..c69d229 --- a/t/lib/DBICTest.pm +++ b/t/lib/DBICTest.pm @@ -3,6 +3,7 @@ package # hide from PAUSE use strict; use warnings; +use DBICTest::AuthorCheck; use DBICTest::Schema; =head1 NAME @@ -51,12 +52,20 @@ sub has_custom_dsn { } sub _sqlite_dbfilename { - return "t/var/DBIxClass.db"; + return "t/var/DBIxClass.db"; +} + +sub _sqlite_dbname { + my $self = shift; + my %args = @_; + return $self->_sqlite_dbfilename if $args{sqlite_use_file} or $ENV{"DBICTEST_SQLITE_USE_FILE"}; + return ":memory:"; } sub _database { my $self = shift; - my $db_file = $self->_sqlite_dbfilename; + 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"; @@ -66,7 +75,7 @@ sub _database { my $dbuser = $ENV{"DBICTEST_DBUSER"} || ''; my $dbpass = $ENV{"DBICTEST_DBPASS"} || ''; - my @connect_info = ($dsn, $dbuser, $dbpass, { AutoCommit => 1 }); + my @connect_info = ($dsn, $dbuser, $dbpass, { AutoCommit => 1, %args }); return @connect_info; } @@ -76,10 +85,10 @@ sub init_schema { my %args = @_; my $schema; - + if ($args{compose_connection}) { $schema = DBICTest::Schema->compose_connection( - 'DBICTest', $self->_database + 'DBICTest', $self->_database(%args) ); } else { $schema = DBICTest::Schema->compose_namespace('DBICTest'); @@ -88,7 +97,7 @@ sub init_schema { $schema->storage_type($args{storage_type}); } if ( !$args{no_connect} ) { - $schema = $schema->connect($self->_database); + $schema = $schema->connect($self->_database(%args)); $schema->storage->on_connect_do(['PRAGMA synchronous = OFF']) unless $self->has_custom_dsn; } @@ -124,7 +133,11 @@ sub deploy_schema { my $sql; { local $/ = undef; $sql = ; } close IN; - ($schema->storage->dbh->do($_) || print "Error on SQL: $_\n") for split(/;\n/, $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($chunk) or print "Error on SQL: $chunk\n"; + } + } } return; } @@ -229,7 +242,7 @@ sub populate_schema { ]); $schema->populate('TreeLike', [ - [ qw/id parent_fk name/ ], + [ qw/id parent name/ ], [ 1, undef, 'root' ], [ 2, 1, 'foo' ], [ 3, 2, 'bar' ], @@ -259,8 +272,8 @@ sub populate_schema { ]); $schema->populate('Event', [ - [ qw/id starts_at created_on/ ], - [ 1, '2006-04-25 22:24:33', '2006-06-22 21:00:05'], + [ qw/id starts_at created_on varchar_date varchar_datetime skip_inflation/ ], + [ 1, '2006-04-25 22:24:33', '2006-06-22 21:00:05', '2006-07-23', '2006-05-22 19:05:07', '2006-04-21 18:04:06'], ]); $schema->populate('Link', [ @@ -297,16 +310,16 @@ sub populate_schema { ]); $schema->populate('Owners', [ - [ qw/ownerid name/ ], + [ qw/id name/ ], [ 1, "Newton" ], [ 2, "Waltham" ], ]); $schema->populate('BooksInLibrary', [ - [ qw/id owner title source/ ], - [ 1, 1, "Programming Perl", "Library" ], - [ 2, 1, "Dynamical Systems", "Library" ], - [ 3, 2, "Best Recipe Cookbook", "Library" ], + [ qw/id owner title source price/ ], + [ 1, 1, "Programming Perl", "Library", 23 ], + [ 2, 1, "Dynamical Systems", "Library", 37 ], + [ 3, 2, "Best Recipe Cookbook", "Library", 65 ], ]); }