1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
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 = <IN>; }
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;
|
