X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Flib%2FDBICTest.pm;h=80069617d230eaf90ee4fad4c926a0be17aad326;hb=a705b1758c359438b683daa2c2b1e8cb5a3377da;hp=78f788a260eca2169896746c40581a834c3f1855;hpb=17e7d7f08a370188a661355e54a0673b816dc376;p=dbsrgits%2FDBIx-Class.git diff --git a/t/lib/DBICTest.pm b/t/lib/DBICTest.pm old mode 100755 new mode 100644 index 78f788a..8006961 --- 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 @@ -29,6 +30,10 @@ DBIx::Class. my $schema = DBICTest->init_schema( no_deploy=>1, no_populate=>1, + storage_type=>'::DBI::Replicated', + storage_type_args=>{ + balancer_type=>'DBIx::Class::Storage::DBI::Replicated::Balancer::Random' + }, ); This method removes the test SQLite database in t/var/DBIxClass.db @@ -42,10 +47,25 @@ default, unless the no_deploy or no_populate flags are set. =cut -sub init_schema { +sub has_custom_dsn { + return $ENV{"DBICTEST_DSN"} ? 1:0; +} + +sub _sqlite_dbfilename { + return "t/var/DBIxClass.db"; +} + +sub _sqlite_dbname { my $self = shift; my %args = @_; - my $db_file = "t/var/DBIxClass.db"; + return $self->_sqlite_dbfilename if $args{sqlite_use_file} or $ENV{"DBICTEST_SQLITE_USE_FILE"}; + return ":memory:"; +} + +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"; @@ -55,10 +75,36 @@ sub init_schema { my $dbuser = $ENV{"DBICTEST_DBUSER"} || ''; my $dbpass = $ENV{"DBICTEST_DBPASS"} || ''; - my $schema = DBICTest::Schema->compose_connection('DBICTest' => $dsn, $dbuser, $dbpass); + my @connect_info = ($dsn, $dbuser, $dbpass, { AutoCommit => 1, %args }); + + return @connect_info; +} + +sub init_schema { + my $self = shift; + my %args = @_; + + my $schema; + + if ($args{compose_connection}) { + $schema = DBICTest::Schema->compose_connection( + 'DBICTest', $self->_database(%args) + ); + } 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 ); - __PACKAGE__->populate_schema( $schema ) if( !$args{no_populate} ); + __PACKAGE__->deploy_schema( $schema, $args{deploy_args} ); + __PACKAGE__->populate_schema( $schema ) + if( !$args{no_populate} ); } return $schema; } @@ -78,16 +124,22 @@ of tables for testing. sub deploy_schema { my $self = shift; my $schema = shift; + my $args = shift || {}; - if ($ENV{"DBICTEST_SQLT_DEPLOY"}) { - return $schema->deploy(); + if ($ENV{"DBICTEST_SQLT_DEPLOY"}) { + $schema->deploy($args); } else { open IN, "t/lib/sqlite.sql"; my $sql; { local $/ = undef; $sql = ; } close IN; - $schema->storage->dbh->do($_) 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(sub { $_[1]->do($chunk) }) or print "Error on SQL: $chunk\n"; + } + } } + return; } =head2 populate_schema @@ -103,7 +155,10 @@ sub populate_schema { my $self = shift; my $schema = shift; - $schema->storage->dbh->do("PRAGMA synchronous = OFF"); + $schema->populate('Genre', [ + [qw/genreid name/], + [qw/1 emo /], + ]); $schema->populate('Artist', [ [ qw/artistid name/ ], @@ -113,8 +168,8 @@ sub populate_schema { ]); $schema->populate('CD', [ - [ qw/cdid artist title year/ ], - [ 1, 1, "Spoonful of bees", 1999 ], + [ qw/cdid artist title year genreid/ ], + [ 1, 1, "Spoonful of bees", 1999, 1 ], [ 2, 1, "Forkful of bees", 2001 ], [ 3, 1, "Caterwaulin' Blues", 1997 ], [ 4, 2, "Generic Manufactured Singles", 2001 ], @@ -149,9 +204,9 @@ sub populate_schema { ]); $schema->populate('FourKeys', [ - [ qw/foo bar hello goodbye/ ], - [ 1, 2, 3, 4 ], - [ 5, 4, 3, 6 ], + [ qw/foo bar hello goodbye sensors/ ], + [ 1, 2, 3, 4, 'online' ], + [ 5, 4, 3, 6, 'offline' ], ]); $schema->populate('OneKey', [ @@ -190,13 +245,16 @@ sub populate_schema { [ 1, 2 ], [ 1, 3 ], ]); - + $schema->populate('TreeLike', [ [ qw/id parent name/ ], - [ 1, 0, 'foo' ], - [ 2, 1, 'bar' ], - [ 3, 2, 'baz' ], - [ 4, 3, 'quux' ], + [ 1, undef, 'root' ], + [ 2, 1, 'foo' ], + [ 3, 2, 'bar' ], + [ 6, 2, 'blop' ], + [ 4, 3, 'baz' ], + [ 5, 4, 'quux' ], + [ 7, 3, 'fong' ], ]); $schema->populate('Track', [ @@ -218,15 +276,56 @@ sub populate_schema { [ 18, 1, 3, "Beehind You"], ]); + $schema->populate('Event', [ + [ 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', [ - [ qw/id title/ ], - [ 1, 'aaa' ] + [ qw/id url title/ ], + [ 1, '', 'aaa' ] ]); $schema->populate('Bookmark', [ [ qw/id link/ ], [ 1, 1 ] ]); + + $schema->populate('Collection', [ + [ qw/collectionid name/ ], + [ 1, "Tools" ], + [ 2, "Body Parts" ], + ]); + + $schema->populate('TypedObject', [ + [ qw/objectid type value/ ], + [ 1, "pointy", "Awl" ], + [ 2, "round", "Bearing" ], + [ 3, "pointy", "Knife" ], + [ 4, "pointy", "Tooth" ], + [ 5, "round", "Head" ], + ]); + $schema->populate('CollectionObject', [ + [ qw/collection object/ ], + [ 1, 1 ], + [ 1, 2 ], + [ 1, 3 ], + [ 2, 4 ], + [ 2, 5 ], + ]); + + $schema->populate('Owners', [ + [ qw/id name/ ], + [ 1, "Newton" ], + [ 2, "Waltham" ], + ]); + + $schema->populate('BooksInLibrary', [ + [ 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 ], + ]); } 1;