/
02ddl.t
131 lines (99 loc) · 3.53 KB
/
02ddl.t
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
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
use strict;
use warnings;
use Test::More;
use Test::Exception;
use Test::Warn;
BEGIN {
require DBIx::Class;
plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for('admin')
unless DBIx::Class::Optional::Dependencies->req_ok_for('admin');
plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for('deploy')
unless DBIx::Class::Optional::Dependencies->req_ok_for('deploy');
}
use lib qw(t/lib);
use DBICTest;
use Path::Class;
use_ok 'DBIx::Class::Admin';
my $sql_dir = dir(qw/t var/);
my @connect_info = DBICTest->_database(
no_deploy=>1,
no_populate=>1,
sqlite_use_file => 1,
);
{ # create the schema
# make sure we are clean
clean_dir($sql_dir);
my $admin = DBIx::Class::Admin->new(
schema_class=> "DBICTest::Schema",
sql_dir=> $sql_dir,
connect_info => \@connect_info,
);
isa_ok ($admin, 'DBIx::Class::Admin', 'create the admin object');
lives_ok { $admin->create('MySQL'); } 'Can create MySQL sql';
lives_ok { $admin->create('SQLite'); } 'Can Create SQLite sql';
lives_ok {
$SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /no such table.+DROP TABLE/s };
$admin->deploy()
} 'Can Deploy schema';
}
{ # upgrade schema
clean_dir($sql_dir);
require DBICVersion_v1;
my $admin = DBIx::Class::Admin->new(
schema_class => 'DBICVersion::Schema',
sql_dir => $sql_dir,
connect_info => \@connect_info,
);
my $schema = $admin->schema();
lives_ok { $admin->create($schema->storage->sqlt_type(), {add_drop_table=>0}); } 'Can create DBICVersionOrig sql in ' . $schema->storage->sqlt_type;
lives_ok { $admin->deploy( ) } 'Can Deploy schema';
# connect to now deployed schema
lives_ok { $schema = DBICVersion::Schema->connect(@{$schema->storage->connect_info()}); } 'Connect to deployed Database';
is($schema->get_db_version, $DBICVersion::Schema::VERSION, 'Schema deployed and versions match');
require DBICVersion_v2;
DBICVersion::Schema->upgrade_directory (undef); # so that we can test use of $sql_dir
$admin = DBIx::Class::Admin->new(
schema_class => 'DBICVersion::Schema',
sql_dir => $sql_dir,
connect_info => \@connect_info
);
lives_ok { $admin->create($schema->storage->sqlt_type(), {}, "1.0" ); } 'Can create diff for ' . $schema->storage->sqlt_type;
{
local $SIG{__WARN__} = sub { warn $_[0] unless $_[0] =~ /DB version .+? is lower than the schema version/ };
lives_ok {$admin->upgrade();} 'upgrade the schema';
dies_ok {$admin->deploy} 'cannot deploy installed schema, should upgrade instead';
}
is($schema->get_db_version, $DBICVersion::Schema::VERSION, 'Schema and db versions match');
}
{ # install
clean_dir($sql_dir);
my $admin = DBIx::Class::Admin->new(
schema_class => 'DBICVersion::Schema',
sql_dir => $sql_dir,
_confirm => 1,
connect_info => \@connect_info,
);
$admin->version("3.0");
lives_ok { $admin->install(); } 'install schema version 3.0';
is($admin->schema->get_db_version, "3.0", 'db thinks its version 3.0');
dies_ok { $admin->install("4.0"); } 'cannot install to allready existing version';
$admin->force(1);
warnings_exist ( sub {
lives_ok { $admin->install("4.0") } 'can force install to allready existing version'
}, qr/Forcing install may not be a good idea/, 'Force warning emitted' );
is($admin->schema->get_db_version, "4.0", 'db thinks its version 4.0');
#clean_dir($sql_dir);
}
sub clean_dir {
my ($dir) = @_;
$dir = $dir->resolve;
if ( ! -d $dir ) {
$dir->mkpath();
}
foreach my $file ($dir->children) {
# skip any hidden files
next if ($file =~ /^\./);
unlink $file;
}
}
done_testing;