package # DBIC::Test; use strict; use warnings; BEGIN { # little trick by Ovid to pretend to subclass+exporter Test::More use base qw/Test::Builder::Module Class::Accessor::Grouped/; use Test::More; use File::Spec::Functions qw/catfile catdir/; @DBIC::Test::EXPORT = @Test::More::EXPORT; __PACKAGE__->mk_group_accessors('inherited', qw/db_dir db_file/); }; __PACKAGE__->db_dir(catdir('t', 'var')); __PACKAGE__->db_file('test.db'); sub init_schema { my ( $self, %args ) = @_; my $db_dir = $args{'db_dir'} || $self->db_dir; my $db_file = $args{'db_file'} || $self->db_file; my $namespace = $args{'namespace'} || 'DBIC::TestSchema'; my $db = catfile($db_dir, $db_file); eval 'use DBD::SQLite'; if ( $@ ) { BAIL_OUT('DBD::SQLite not installed'); return; } eval 'use DBIC::Test::Schema'; if ( $@ ) { BAIL_OUT("Could not load test schema DBIC::Test::Schema: $@"); return; } unlink($db) if -e $db; unlink($db . '-journal') if -e $db . '-journal'; mkdir($db_dir) unless -d $db_dir; my $dsn = 'dbi:SQLite:' . $db; my $schema = DBIC::Test::Schema ->compose_namespace($namespace)->connect($dsn); $schema->storage->on_connect_do([ 'PRAGMA synchronous = OFF', 'PRAGMA temp_store = MEMORY' ]); __PACKAGE__->deploy_schema($schema, %args); __PACKAGE__->populate_schema($schema, %args) unless $args{'no_populate'}; return $schema; } sub deploy_schema { my ( $self, $schema, %options ) = @_; my $eval = $options{'eval_deploy'}; eval 'use SQL::Translator'; if ( !$@ && !$options{'no_deploy'} ) { eval { $schema->deploy(); }; if ( $@ && !$eval ) { die $@; } } else { unless ( open(IN, catfile('t', 'sql', 'test.sqlite.sql') ) ) { BAIL_OUT("Can't load schema, sorry: $!"); return; } my $sql; { local $/ = undef; $sql = ; } close IN; eval { ($schema->storage->dbh->do($_) || print "Error on SQL: $_\n") for split(/;\n/, $sql); }; if ( $@ && !$eval ) { die $@; } } } sub clear_schema { my ( $self, $schema, %options ) = @_; foreach my $source ( $schema->sources ) { $schema->resultset($source)->delete_all; } } sub populate_schema { my ( $self, $schema, %options ) = @_; if ( $options{'clear'} ) { $self->clear_schema($schema, %options); } # We don't need any data, but if we did, put it here. } 1;