1package # hide from PAUSE 2 DBICTest; 3 4use strict; 5use warnings; 6use DBICTest::AuthorCheck; 7use DBICTest::Schema; 8 9=head1 NAME 10 11DBICTest - Library to be used by DBIx::Class test scripts. 12 13=head1 SYNOPSIS 14 15 use lib qw(t/lib); 16 use DBICTest; 17 use Test::More; 18 19 my $schema = DBICTest->init_schema(); 20 21=head1 DESCRIPTION 22 23This module provides the basic utilities to write tests against 24DBIx::Class. 25 26=head1 METHODS 27 28=head2 init_schema 29 30 my $schema = DBICTest->init_schema( 31 no_deploy=>1, 32 no_populate=>1, 33 storage_type=>'::DBI::Replicated', 34 storage_type_args=>{ 35 balancer_type=>'DBIx::Class::Storage::DBI::Replicated::Balancer::Random' 36 }, 37 ); 38 39This method removes the test SQLite database in t/var/DBIxClass.db 40and then creates a new, empty database. 41 42This method will call deploy_schema() by default, unless the 43no_deploy flag is set. 44 45Also, by default, this method will call populate_schema() by 46default, unless the no_deploy or no_populate flags are set. 47 48=cut 49 50sub has_custom_dsn { 51 return $ENV{"DBICTEST_DSN"} ? 1:0; 52} 53 54sub _sqlite_dbfilename { 55 return "t/var/DBIxClass.db"; 56} 57 58sub _sqlite_dbname { 59 my $self = shift; 60 my %args = @_; 61 return $self->_sqlite_dbfilename if $args{sqlite_use_file} or $ENV{"DBICTEST_SQLITE_USE_FILE"}; 62 return ":memory:"; 63} 64 65sub _database { 66 my $self = shift; 67 my %args = @_; 68 my $db_file = $self->_sqlite_dbname(%args); 69 70 unlink($db_file) if -e $db_file; 71 unlink($db_file . "-journal") if -e $db_file . "-journal"; 72 mkdir("t/var") unless -d "t/var"; 73 74 my $dsn = $ENV{"DBICTEST_DSN"} || "dbi:SQLite:${db_file}"; 75 my $dbuser = $ENV{"DBICTEST_DBUSER"} || ''; 76 my $dbpass = $ENV{"DBICTEST_DBPASS"} || ''; 77 78 my @connect_info = ($dsn, $dbuser, $dbpass, { AutoCommit => 1, %args }); 79 80 return @connect_info; 81} 82 83sub init_schema { 84 my $self = shift; 85 my %args = @_; 86 87 my $schema; 88 89 if ($args{compose_connection}) { 90 $schema = DBICTest::Schema->compose_connection( 91 'DBICTest', $self->_database(%args) 92 ); 93 } else { 94 $schema = DBICTest::Schema->compose_namespace('DBICTest'); 95 } 96 if( $args{storage_type}) { 97 $schema->storage_type($args{storage_type}); 98 } 99 if ( !$args{no_connect} ) { 100 $schema = $schema->connect($self->_database(%args)); 101 $schema->storage->on_connect_do(['PRAGMA synchronous = OFF']) 102 unless $self->has_custom_dsn; 103 } 104 if ( !$args{no_deploy} ) { 105 __PACKAGE__->deploy_schema( $schema, $args{deploy_args} ); 106 __PACKAGE__->populate_schema( $schema ) 107 if( !$args{no_populate} ); 108 } 109 return $schema; 110} 111 112=head2 deploy_schema 113 114 DBICTest->deploy_schema( $schema ); 115 116This method does one of two things to the schema. It can either call 117the experimental $schema->deploy() if the DBICTEST_SQLT_DEPLOY environment 118variable is set, otherwise the default is to read in the t/lib/sqlite.sql 119file and execute the SQL within. Either way you end up with a fresh set 120of tables for testing. 121 122=cut 123 124sub deploy_schema { 125 my $self = shift; 126 my $schema = shift; 127 my $args = shift || {}; 128 129 if ($ENV{"DBICTEST_SQLT_DEPLOY"}) { 130 $schema->deploy($args); 131 } else { 132 open IN, "t/lib/sqlite.sql"; 133 my $sql; 134 { local $/ = undef; $sql = <IN>; } 135 close IN; 136 for my $chunk ( split (/;\s*\n+/, $sql) ) { 137 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 138 $schema->storage->dbh_do(sub { $_[1]->do($chunk) }) or print "Error on SQL: $chunk\n"; 139 } 140 } 141 } 142 return; 143} 144 145=head2 populate_schema 146 147 DBICTest->populate_schema( $schema ); 148 149After you deploy your schema you can use this method to populate 150the tables with test data. 151 152=cut 153 154sub populate_schema { 155 my $self = shift; 156 my $schema = shift; 157 158 $schema->populate('Genre', [ 159 [qw/genreid name/], 160 [qw/1 emo /], 161 ]); 162 163 $schema->populate('Artist', [ 164 [ qw/artistid name/ ], 165 [ 1, 'Caterwauler McCrae' ], 166 [ 2, 'Random Boy Band' ], 167 [ 3, 'We Are Goth' ], 168 ]); 169 170 $schema->populate('CD', [ 171 [ qw/cdid artist title year genreid/ ], 172 [ 1, 1, "Spoonful of bees", 1999, 1 ], 173 [ 2, 1, "Forkful of bees", 2001 ], 174 [ 3, 1, "Caterwaulin' Blues", 1997 ], 175 [ 4, 2, "Generic Manufactured Singles", 2001 ], 176 [ 5, 3, "Come Be Depressed With Us", 1998 ], 177 ]); 178 179 $schema->populate('LinerNotes', [ 180 [ qw/liner_id notes/ ], 181 [ 2, "Buy Whiskey!" ], 182 [ 4, "Buy Merch!" ], 183 [ 5, "Kill Yourself!" ], 184 ]); 185 186 $schema->populate('Tag', [ 187 [ qw/tagid cd tag/ ], 188 [ 1, 1, "Blue" ], 189 [ 2, 2, "Blue" ], 190 [ 3, 3, "Blue" ], 191 [ 4, 5, "Blue" ], 192 [ 5, 2, "Cheesy" ], 193 [ 6, 4, "Cheesy" ], 194 [ 7, 5, "Cheesy" ], 195 [ 8, 2, "Shiny" ], 196 [ 9, 4, "Shiny" ], 197 ]); 198 199 $schema->populate('TwoKeys', [ 200 [ qw/artist cd/ ], 201 [ 1, 1 ], 202 [ 1, 2 ], 203 [ 2, 2 ], 204 ]); 205 206 $schema->populate('FourKeys', [ 207 [ qw/foo bar hello goodbye sensors/ ], 208 [ 1, 2, 3, 4, 'online' ], 209 [ 5, 4, 3, 6, 'offline' ], 210 ]); 211 212 $schema->populate('OneKey', [ 213 [ qw/id artist cd/ ], 214 [ 1, 1, 1 ], 215 [ 2, 1, 2 ], 216 [ 3, 2, 2 ], 217 ]); 218 219 $schema->populate('SelfRef', [ 220 [ qw/id name/ ], 221 [ 1, 'First' ], 222 [ 2, 'Second' ], 223 ]); 224 225 $schema->populate('SelfRefAlias', [ 226 [ qw/self_ref alias/ ], 227 [ 1, 2 ] 228 ]); 229 230 $schema->populate('ArtistUndirectedMap', [ 231 [ qw/id1 id2/ ], 232 [ 1, 2 ] 233 ]); 234 235 $schema->populate('Producer', [ 236 [ qw/producerid name/ ], 237 [ 1, 'Matt S Trout' ], 238 [ 2, 'Bob The Builder' ], 239 [ 3, 'Fred The Phenotype' ], 240 ]); 241 242 $schema->populate('CD_to_Producer', [ 243 [ qw/cd producer/ ], 244 [ 1, 1 ], 245 [ 1, 2 ], 246 [ 1, 3 ], 247 ]); 248 249 $schema->populate('TreeLike', [ 250 [ qw/id parent name/ ], 251 [ 1, undef, 'root' ], 252 [ 2, 1, 'foo' ], 253 [ 3, 2, 'bar' ], 254 [ 6, 2, 'blop' ], 255 [ 4, 3, 'baz' ], 256 [ 5, 4, 'quux' ], 257 [ 7, 3, 'fong' ], 258 ]); 259 260 $schema->populate('Track', [ 261 [ qw/trackid cd position title/ ], 262 [ 4, 2, 1, "Stung with Success"], 263 [ 5, 2, 2, "Stripy"], 264 [ 6, 2, 3, "Sticky Honey"], 265 [ 7, 3, 1, "Yowlin"], 266 [ 8, 3, 2, "Howlin"], 267 [ 9, 3, 3, "Fowlin"], 268 [ 10, 4, 1, "Boring Name"], 269 [ 11, 4, 2, "Boring Song"], 270 [ 12, 4, 3, "No More Ideas"], 271 [ 13, 5, 1, "Sad"], 272 [ 14, 5, 2, "Under The Weather"], 273 [ 15, 5, 3, "Suicidal"], 274 [ 16, 1, 1, "The Bees Knees"], 275 [ 17, 1, 2, "Apiary"], 276 [ 18, 1, 3, "Beehind You"], 277 ]); 278 279 $schema->populate('Event', [ 280 [ qw/id starts_at created_on varchar_date varchar_datetime skip_inflation/ ], 281 [ 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'], 282 ]); 283 284 $schema->populate('Link', [ 285 [ qw/id url title/ ], 286 [ 1, '', 'aaa' ] 287 ]); 288 289 $schema->populate('Bookmark', [ 290 [ qw/id link/ ], 291 [ 1, 1 ] 292 ]); 293 294 $schema->populate('Collection', [ 295 [ qw/collectionid name/ ], 296 [ 1, "Tools" ], 297 [ 2, "Body Parts" ], 298 ]); 299 300 $schema->populate('TypedObject', [ 301 [ qw/objectid type value/ ], 302 [ 1, "pointy", "Awl" ], 303 [ 2, "round", "Bearing" ], 304 [ 3, "pointy", "Knife" ], 305 [ 4, "pointy", "Tooth" ], 306 [ 5, "round", "Head" ], 307 ]); 308 $schema->populate('CollectionObject', [ 309 [ qw/collection object/ ], 310 [ 1, 1 ], 311 [ 1, 2 ], 312 [ 1, 3 ], 313 [ 2, 4 ], 314 [ 2, 5 ], 315 ]); 316 317 $schema->populate('Owners', [ 318 [ qw/id name/ ], 319 [ 1, "Newton" ], 320 [ 2, "Waltham" ], 321 ]); 322 323 $schema->populate('BooksInLibrary', [ 324 [ qw/id owner title source price/ ], 325 [ 1, 1, "Programming Perl", "Library", 23 ], 326 [ 2, 1, "Dynamical Systems", "Library", 37 ], 327 [ 3, 2, "Best Recipe Cookbook", "Library", 65 ], 328 ]); 329} 330 3311; 332